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 a975ebe7cce09c0b6e188bb9a86c0a48dea96bf5..b47f6ba2d6b1e34247ebf635da6e922aa8d27041 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -255,18 +255,21 @@ (defmethod hook-output progn ((vtptr vtable-pointer)
                              (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.
@@ -317,11 +320,12 @@ (defmethod hook-output progn ((vtable vtable) (reason (eql :h)) sequencer)
 
 (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)
@@ -358,26 +362,29 @@ (defmethod hook-output progn
 (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)
   (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.