src/class-output.lisp, src/output-impl.lisp: Warn about unused items.

[sod] / src / class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index f47bc7e..b47f6ba 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -40,12 +40,10 @@
     (dolist (ichain ichains) (hook-output ichain reason sequencer))))
 
 (defmethod hook-output progn ((ichain ichain) reason sequencer)
-  (dolist (item (ichain-body ichain))
-    (hook-output item reason sequencer)))
+  (dolist (item (ichain-body ichain)) (hook-output item reason sequencer)))
 
 (defmethod hook-output progn ((islots islots) reason sequencer)
-  (dolist (slot (islots-slots islots))
-    (hook-output slot reason sequencer)))
+  (dolist (slot (islots-slots islots)) (hook-output slot reason sequencer)))
 
 (defmethod hook-output progn ((vtable vtable) reason sequencer)
   (with-slots (body) vtable
@@ -195,9 +193,8 @@
 ;;;--------------------------------------------------------------------------
 ;;; Instance structure.
 
-(defmethod hook-output progn ((slot sod-slot)
-                             (reason (eql 'islots))
-                             sequencer)
+(defmethod hook-output progn
+    ((slot sod-slot) (reason (eql 'islots)) sequencer)
   (sequence-output (stream sequencer)
     (((sod-slot-class slot) :islots :slots)
      (pprint-logical-block (stream nil :prefix "  " :suffix ";")
@@ -245,9 +242,8 @@
                                 (sod-class-nickname super)))
                         (sod-class-chain chain-tail))))))))
 
-(defmethod hook-output progn ((ichain ichain)
-                             (reason (eql 'ilayout))
-                             sequencer)
+(defmethod hook-output progn
+    ((ichain ichain) (reason (eql 'ilayout)) sequencer)
   (with-slots ((class %class) chain-head chain-tail) ichain
     (sequence-output (stream sequencer)
       ((class :ilayout :slots)
@@ -259,25 +255,27 @@
                              (reason (eql :h))
                              sequencer)
   (with-slots ((class %class) chain-head chain-tail) vtptr
-    (sequence-output (stream sequencer)
-      ((class :ichain chain-head :slots)
-       (format stream "  const struct ~A *_vt;~%"
-              (vtable-struct-tag chain-tail chain-head))))))
+    (when (eq class chain-tail)
+      (sequence-output (stream sequencer)
+       ((class :ichain chain-head :slots)
+        (format stream "  const struct ~A *_vt;~%"
+                (vtable-struct-tag chain-tail chain-head)))))))
 
 (defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
   (with-slots ((class %class) subclass slots) islots
-    (sequence-output (stream sequencer)
-      ((subclass :ichain (sod-class-chain-head class) :slots)
-       (format stream "  struct ~A ~A;~%"
-              (islots-struct-tag class)
-              (sod-class-nickname class))))))
+    (let ((head (sod-class-chain-head class)))
+      (when (eq head (sod-class-chain-head subclass))
+       (sequence-output (stream sequencer)
+         ((subclass :ichain (sod-class-chain-head class) :slots)
+          (format stream "  struct ~A ~A;~%"
+                  (islots-struct-tag class)
+                  (sod-class-nickname class))))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Vtable structure.
 
-(defmethod hook-output progn ((method sod-method)
-                             (reason (eql :h))
-                             sequencer)
+(defmethod hook-output progn
+    ((method sod-method) (reason (eql :h)) sequencer)
   (with-slots ((class %class)) method
     (sequence-output (stream sequencer)
       ((class :methods)
@@ -322,15 +320,15 @@
 
 (defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h)) sequencer)
   (with-slots ((class %class) subclass chain-head chain-tail) vtmsgs
-    (sequence-output (stream sequencer)
-      ((subclass :vtable chain-head :slots)
-       (format stream "  struct ~A ~A;~%"
-              (vtmsgs-struct-tag subclass class)
-              (sod-class-nickname class))))))
+    (when (eq subclass chain-tail)
+      (sequence-output (stream sequencer)
+       ((subclass :vtable chain-head :slots)
+        (format stream "  struct ~A ~A;~%"
+                (vtmsgs-struct-tag subclass class)
+                (sod-class-nickname class)))))))
 
-(defmethod hook-output progn ((vtmsgs vtmsgs)
-                             (reason (eql 'vtmsgs))
-                             sequencer)
+(defmethod hook-output progn
+    ((vtmsgs vtmsgs) (reason (eql 'vtmsgs)) sequencer)
   (when (vtmsgs-entries vtmsgs)
     (with-slots ((class %class) subclass) vtmsgs
       (sequence-output (stream sequencer)
@@ -347,9 +345,8 @@
        ((subclass :vtmsgs class :end)
         (format stream "};~2%"))))))
 
-(defmethod hook-output progn ((entry method-entry)
-                             (reason (eql 'vtmsgs))
-                             sequencer)
+(defmethod hook-output progn
+    ((entry method-entry) (reason (eql 'vtmsgs)) sequencer)
   (let* ((method (method-entry-effective-method entry))
         (message (effective-method-message method))
         (class (effective-method-class method))
@@ -362,31 +359,32 @@
         (pprint-c-type pointer-type stream (method-entry-slot-name entry)))
        (terpri stream)))))
 
-(defmethod hook-output progn ((cptr class-pointer)
-                             (reason (eql :h))
-                             sequencer)
+(defmethod hook-output progn
+    ((cptr class-pointer) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr
-    (sequence-output (stream sequencer)
-      ((class :vtable chain-head :slots)
-       (format stream "  const ~A *~:[_class~;~:*_cls_~A~];~%"
-              metaclass
-              (and (sod-class-direct-superclasses meta-chain-head)
-                   (sod-class-nickname meta-chain-head)))))))
+    (when (eq chain-head (sod-class-chain-head class))
+      (sequence-output (stream sequencer)
+       ((class :vtable chain-head :slots)
+        (format stream "  const ~A *~:[_class~;~:*_cls_~A~];~%"
+                metaclass
+                (and (sod-class-direct-superclasses meta-chain-head)
+                     (sod-class-nickname meta-chain-head))))))))
 
 (defmethod hook-output progn ((boff base-offset) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head) boff
-    (sequence-output (stream sequencer)
-      ((class :vtable chain-head :slots)
-       (write-line "  size_t _base;" stream)))))
+    (when (eq chain-head (sod-class-chain-head class))
+      (sequence-output (stream sequencer)
+       ((class :vtable chain-head :slots)
+        (write-line "  size_t _base;" stream))))))
 
-(defmethod hook-output progn ((choff chain-offset)
-                             (reason (eql :h))
-                             sequencer)
+(defmethod hook-output progn
+    ((choff chain-offset) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head target-head) choff
-    (sequence-output (stream sequencer)
-      ((class :vtable chain-head :slots)
-       (format stream "  ptrdiff_t _off_~A;~%"
-              (sod-class-nickname target-head))))))
+    (when (eq chain-head (sod-class-chain-head class))
+      (sequence-output (stream sequencer)
+       ((class :vtable chain-head :slots)
+        (format stream "  ptrdiff_t _off_~A;~%"
+                (sod-class-nickname target-head)))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Implementation output.
@@ -433,9 +431,8 @@ const struct ~A ~A__classobj = {~%"
 ;;;--------------------------------------------------------------------------
 ;;; Direct and effective methods.
 
-(defmethod hook-output progn ((method delegating-direct-method)
-                             (reason (eql :c))
-                             sequencer)
+(defmethod hook-output progn
+    ((method delegating-direct-method) (reason (eql :c)) sequencer)
   (with-slots ((class %class) body) method
     (unless body
       (return-from hook-output))
@@ -448,9 +445,8 @@ const struct ~A ~A__classobj = {~%"
       ((class :direct-method method :end)
        (format stream "#undef CALL_NEXT_METHOD~%")))))
 
-(defmethod hook-output progn ((method sod-method)
-                             (reason (eql :c))
-                             sequencer)
+(defmethod hook-output progn
+    ((method sod-method) (reason (eql :c)) sequencer)
   (with-slots ((class %class) body) method
     (unless body
       (return-from hook-output))
@@ -470,9 +466,8 @@ const struct ~A ~A__classobj = {~%"
       ((class :direct-method method :end)
        (terpri stream)))))
 
-(defmethod hook-output progn ((method basic-effective-method)
-                             (reason (eql :c))
-                             sequencer)
+(defmethod hook-output progn
+    ((method basic-effective-method) (reason (eql :c)) sequencer)
   (with-slots ((class %class) functions) method
     (sequence-output (stream sequencer)
       ((class :effective-methods)
@@ -498,9 +493,8 @@ const struct ~A ~A__classobj = {~%"
       ((class :vtable chain-head :end)
        (format stream "} };~2%")))))
 
-(defmethod hook-output progn ((cptr class-pointer)
-                             (reason (eql :c))
-                             sequencer)
+(defmethod hook-output progn
+    ((cptr class-pointer) (reason (eql :c)) sequencer)
   (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr
     (sequence-output (stream sequencer)
       :constraint ((class :vtable chain-head :start)
@@ -528,9 +522,8 @@ const struct ~A ~A__classobj = {~%"
               (ilayout-struct-tag class)
               (sod-class-nickname chain-head))))))
 
-(defmethod hook-output progn ((choff chain-offset)
-                             (reason (eql :c))
-                             sequencer)
+(defmethod hook-output progn
+    ((choff chain-offset) (reason (eql :c)) sequencer)
   (with-slots ((class %class) chain-head target-head) choff
     (sequence-output (stream sequencer)
       :constraint ((class :vtable chain-head :start)
@@ -557,9 +550,8 @@ const struct ~A ~A__classobj = {~%"
       ((subclass :vtable chain-head :vtmsgs class :end)
        (format stream "  },~%")))))
 
-(defmethod hook-output progn ((entry method-entry)
-                             (reason (eql :c))
-                             sequencer)
+(defmethod hook-output progn
+    ((entry method-entry) (reason (eql :c)) sequencer)
   (with-slots ((method %method) chain-head chain-tail role) entry
     (let* ((message (effective-method-message method))
           (class (effective-method-class method))
@@ -573,9 +565,8 @@ const struct ~A ~A__classobj = {~%"
 ;;;--------------------------------------------------------------------------
 ;;; Filling in the class object.
 
-(defmethod hook-output progn ((ichain ichain)
-                             (reason (eql 'class))
-                             sequencer)
+(defmethod hook-output progn
+    ((ichain ichain) (reason (eql 'class)) sequencer)
   (with-slots ((class %class) chain-head) ichain
     (sequence-output (stream sequencer)
       :constraint ((*instance-class* :object :start)
@@ -588,9 +579,8 @@ const struct ~A ~A__classobj = {~%"
       ((*instance-class* :object chain-head :ichain :end)
        (format stream "  } },~%")))))
 
-(defmethod hook-output progn ((islots islots)
-                             (reason (eql 'class))
-                             sequencer)
+(defmethod hook-output progn
+    ((islots islots) (reason (eql 'class)) sequencer)
   (with-slots ((class %class)) islots
     (let ((chain-head (sod-class-chain-head class)))
       (sequence-output (stream sequencer)
@@ -604,9 +594,8 @@ const struct ~A ~A__classobj = {~%"
        ((*instance-class* :object class :slots :end)
         (format stream "      },~%"))))))
 
-(defmethod hook-output progn ((vtptr vtable-pointer)
-                             (reason (eql 'class))
-                             sequencer)
+(defmethod hook-output progn
+    ((vtptr vtable-pointer) (reason (eql 'class)) sequencer)
   (with-slots ((class %class) chain-head chain-tail) vtptr
     (sequence-output (stream sequencer)
       :constraint ((*instance-class* :object chain-head :ichain :start)
@@ -647,9 +636,8 @@ const struct ~A ~A__classobj = {~%"
                           (sod-slot-name direct-slot)
                           (sod-initializer-value-form init)))))))
 
-(defmethod hook-output progn ((slot sod-class-effective-slot)
-                             (reason (eql 'class))
-                             sequencer)
+(defmethod hook-output progn
+    ((slot sod-class-effective-slot) (reason (eql 'class)) sequencer)
   (let ((instance *instance-class*)
        (func (effective-slot-prepare-function slot)))
     (when func
@@ -657,9 +645,8 @@ const struct ~A ~A__classobj = {~%"
        ((instance :object :prepare)
         (funcall func instance stream))))))
 
-(defmethod hook-output progn ((slot effective-slot)
-                             (reason (eql 'class))
-                             sequencer)
+(defmethod hook-output progn
+    ((slot effective-slot) (reason (eql 'class)) sequencer)
   (with-slots ((class %class) (dslot slot)) slot
     (let ((instance *instance-class*)
          (super (sod-slot-class dslot)))