doc/sod.sty: Hack underscores in the labels generated by `describe'.

[sod] / src / class-utilities.lisp

diff --git a/src/class-utilities.lisp b/src/class-utilities.lisp
index bf02aa6..0aec35a 100644 (file)
--- a/src/class-utilities.lisp
+++ b/src/class-utilities.lisp
@@ -51,13 +51,13 @@
 
   (defun find-instance-slot-by-name (class super-nick slot-name)
     (let ((super (find-superclass-by-nick class super-nick)))
 
   (defun find-instance-slot-by-name (class super-nick slot-name)
     (let ((super (find-superclass-by-nick class super-nick)))

-      (find-thing-by-name "slot" super (sod-class-slots super)
+      (find-thing-by-name "instance slot" super (sod-class-slots super)

                          slot-name #'sod-slot-name)))
 
   (defun find-class-slot-by-name (class super-nick slot-name)
     (let* ((meta (sod-class-metaclass class))
           (super (find-superclass-by-nick meta super-nick)))
                          slot-name #'sod-slot-name)))
 
   (defun find-class-slot-by-name (class super-nick slot-name)
     (let* ((meta (sod-class-metaclass class))
           (super (find-superclass-by-nick meta super-nick)))

-      (find-thing-by-name "slot" super (sod-class-slots super)
+      (find-thing-by-name "class slot" super (sod-class-slots super)

                          slot-name #'sod-slot-name)))
 
   (defun find-message-by-name (class super-nick message-name)
                          slot-name #'sod-slot-name)))
 
   (defun find-message-by-name (class super-nick message-name)


@@ -100,7 +100,7 @@
 
    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."
 


@@ -110,7 +110,7 @@
   ;;
   ;; Note!  This function gets called from `check-sod-class' before the
   ;; class's chains have been computed.  Therefore we iterate over the direct
   ;;
   ;; Note!  This function gets called from `check-sod-class' before the
   ;; class's chains have been computed.  Therefore we iterate over the direct

-  ;; superclass's chains rather than the class's own.  This misses a chain
+  ;; superclasses' chains rather than the class's own.  This misses a chain

   ;; only in the case where the class is its own chain head.  There are two
   ;; subcases: if there are no direct superclasses at all, then the class is
   ;; its own root; otherwise, it clearly can't be the root and the omission
   ;; only in the case where the class is its own chain head.  There are two
   ;; subcases: if there are no direct superclasses at all, then the class is
   ;; its own root; otherwise, it clearly can't be the root and the omission


@@ -160,7 +160,8 @@
   (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 @@
 (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 @@
 (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 --------------------------------------------------