doc/syntax.tex: Delete (wrong) duplicate rule for <argument-declarator>.

[sod] / src / class-utilities.lisp

diff --git a/src/class-utilities.lisp b/src/class-utilities.lisp
index 62f27d82b0a3256148f7848db7e04cc5128796a3..573c6779b65500356df891a2947102b562812137 100644 (file)
--- a/src/class-utilities.lisp
+++ b/src/class-utilities.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;

-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.

 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by


@@ -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 --------------------------------------------------