STYLE: Explain how to indent lambda-lists.

[sod] / src / class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index abe5132..dec1e4e 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -94,10 +94,17 @@
           (metaroot (find-root-metaclass class)))
        (format stream "/* The class object. */~@
                       extern const struct ~A ~A__classobj;~@
-                      #define ~:*~A__class (&~:*~A__classobj.~A.~A)~2%"
+                      #define ~:*~A__class (&~:*~A__classobj.~A.~A)~%"
               (ilayout-struct-tag metaclass) class
               (sod-class-nickname (sod-class-chain-head metaroot))
-              (sod-class-nickname metaroot)))))
+              (sod-class-nickname metaroot))
+       (dolist (chain (sod-class-chains metaclass))
+        (let ((tail (car chain)))
+          (unless (eq tail metaroot)
+            (format stream "#define ~A__cls_~A (&~2:*~A__classobj.~A.~A)~%"
+                    class (sod-class-nickname (sod-class-chain-head tail))
+                    (sod-class-nickname tail)))))
+       (terpri stream))))
 
   ;; Maybe generate an islots structure.
   (when (sod-class-slots class)
@@ -185,7 +192,7 @@
             (when varargsp
               (format stream "#ifdef SOD__HAVE_VARARGS_MACROS~%"))
             (format stream "#define ~A(~{~A~^, ~}) ~
-                                  ~A->_vt->~A.~A(~{~A~^, ~})~%"
+                                  (~A)->_vt->~A.~A(~{~A~^, ~})~%"
                     (message-macro-name class entry)
                     (nreverse in-names)
                     me
@@ -299,7 +306,7 @@
                         (c-function-keywords type))))
         (when keys
           (format stream "struct ~A {~%~
-                          ~{  unsigned ~A : 1;~%~}~
+                          ~{  unsigned ~A: 1;~%~}~
                           };~2%"
                   (direct-method-suppliedp-struct-tag method)
                   (mapcar #'argument-name keys))))))))
@@ -511,7 +518,7 @@ const struct ~A ~A__classobj = {~%"
                                  class)
           (format stream "~&struct ~A {~%"
                   (effective-method-keyword-struct-tag method))
-          (format stream "~{  unsigned ~A__suppliedp : 1;~%~}"
+          (format stream "~{  unsigned ~A__suppliedp: 1;~%~}"
                   (mapcar #'argument-name keys))
           (dolist (key keys)
             (write-string "  " stream)
@@ -654,15 +661,6 @@ const struct ~A ~A__classobj = {~%"
               (vtable-name class chain-head)
               (sod-class-nickname chain-tail))))))
 
-(defgeneric find-class-initializer (slot class)
-  (:method ((slot effective-slot) (class sod-class))
-    (let ((dslot (effective-slot-direct-slot slot)))
-      (or (some (lambda (super)
-                 (find dslot (sod-class-class-initializers super)
-                       :test #'sod-initializer-slot))
-               (sod-class-precedence-list class))
-         (effective-slot-initializer slot)))))
-
 (defgeneric output-class-initializer (slot instance stream)
   (:method ((slot sod-class-effective-slot) (instance sod-class) stream)
     (let ((func (effective-slot-initializer-function slot))
@@ -675,13 +673,9 @@ const struct ~A ~A__classobj = {~%"
   (:method ((slot effective-slot) (instance sod-class) stream)
     (let ((init (find-class-initializer slot instance))
          (direct-slot (effective-slot-direct-slot slot)))
-      (ecase (sod-initializer-value-kind init)
-       (:simple (format stream "        /* ~15@A = */ ~A,~%"
-                        (sod-slot-name direct-slot)
-                        (sod-initializer-value-form init)))
-       (:compound (format stream "        /* ~15@A = */ ~@<{ ~;~A~; },~:>~%"
-                          (sod-slot-name direct-slot)
-                          (sod-initializer-value-form init)))))))
+      (format stream "        /* ~15@A = */ ~A,~%"
+             (sod-slot-name direct-slot)
+             (sod-initializer-value init)))))
 
 (defmethod hook-output progn
     ((slot sod-class-effective-slot) (reason (eql 'class)) sequencer)