src/c-types-proto.lisp: Fix docstring.

[sod] / src / class-utilities.lisp

diff --git a/src/class-utilities.lisp b/src/class-utilities.lisp
index 62f27d82b0a3256148f7848db7e04cc5128796a3..0aec35a0e5f501a653fa2464dda059aa1d766f66 100644 (file)
--- a/src/class-utilities.lisp
+++ b/src/class-utilities.lisp
@@ -100,7 +100,7 @@ (defun find-root-superclass (class)
 
    The root superclass is the superclass which itself has no direct
    superclasses.  In universes not based on the provided builtin module, the
 
    The root superclass is the superclass which itself has no direct
    superclasses.  In universes not based on the provided builtin module, the

-   root class may not be our beloved SodObject; however, there must be one
+   root class may not be our beloved `SodObject'; however, there must be one

    (otherwise the class graph is cyclic, which should be forbidden), and we
    insist that it be unique."
 
    (otherwise the class graph is cyclic, which should be forbidden), and we
    insist that it be unique."
 


@@ -160,7 +160,8 @@ (defun argument-lists-compatible-p (message-args method-args)
   (and (= (length message-args) (length method-args))
        (every (lambda (message-arg method-arg)
                (if (eq message-arg :ellipsis)
   (and (= (length message-args) (length method-args))
        (every (lambda (message-arg method-arg)
                (if (eq message-arg :ellipsis)

-                   (eq method-arg (c-type va-list))
+                   (c-type-equal-p (argument-type method-arg)
+                                   (c-type va-list))

                    (c-type-equal-p (argument-type message-arg)
                                    (argument-type method-arg))))
              message-args method-args)))
                    (c-type-equal-p (argument-type message-arg)
                                    (argument-type method-arg))))
              message-args method-args)))


@@ -188,6 +189,10 @@ (export 'vtmsgs-struct-tag)
 (defun vtmsgs-struct-tag (class super)
   (format nil "~A__vtmsgs_~A" class (sod-class-nickname super)))
 
 (defun vtmsgs-struct-tag (class super)
   (format nil "~A__vtmsgs_~A" class (sod-class-nickname super)))
 

+(export 'vtable-union-tag)
+(defun vtable-union-tag (class chain-head)
+  (format nil "~A__vtu_~A" class (sod-class-nickname chain-head)))
+

 (export 'vtable-struct-tag)
 (defun vtable-struct-tag (class chain-head)
   (format nil "~A__vt_~A" class (sod-class-nickname chain-head)))
 (export 'vtable-struct-tag)
 (defun vtable-struct-tag (class chain-head)
   (format nil "~A__vt_~A" class (sod-class-nickname chain-head)))


@@ -196,4 +201,8 @@ (export 'vtable-name)
 (defun vtable-name (class chain-head)
   (format nil "~A__vtable_~A" class (sod-class-nickname chain-head)))
 
 (defun vtable-name (class chain-head)
   (format nil "~A__vtable_~A" class (sod-class-nickname chain-head)))
 

+(export 'message-macro-name)
+(defun message-macro-name (class entry)
+  (format nil "~A_~A" class (method-entry-slot-name entry)))
+

 ;;;----- That's all, folks --------------------------------------------------
 ;;;----- That's all, folks --------------------------------------------------