X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/7c3bae74a11efeefafa38ea599409a69e2af5c4f..ad303446f43c0029e989a8a3d17c4936965d2c43:/src/class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index 91dc0bf..1b69f69 100644
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- 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
@@ -26,6 +26,36 @@
 (cl:in-package #:sod)
 
 ;;;--------------------------------------------------------------------------
+;;; Walking the layout tree.
+
+(defmethod hook-output progn ((class sod-class) reason sequencer)
+  (with-slots ((ilayout %ilayout) vtables methods effective-methods) class
+    (hook-output ilayout reason sequencer)
+    (dolist (method methods) (hook-output method reason sequencer))
+    (dolist (method effective-methods) (hook-output method reason sequencer))
+    (dolist (vtable vtables) (hook-output vtable reason sequencer))))
+
+(defmethod hook-output progn ((ilayout ilayout) reason sequencer)
+  (with-slots (ichains) ilayout
+    (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)))
+
+(defmethod hook-output progn ((islots islots) reason sequencer)
+  (dolist (slot (islots-slots islots))
+    (hook-output slot reason sequencer)))
+
+(defmethod hook-output progn ((vtable vtable) reason sequencer)
+  (with-slots (body) vtable
+    (dolist (item body) (hook-output item reason sequencer))))
+
+(defmethod hook-output progn ((vtmsgs vtmsgs) reason sequencer)
+  (with-slots (entries) vtmsgs
+    (dolist (entry entries) (hook-output entry reason sequencer))))
+
+;;;--------------------------------------------------------------------------
 ;;; Classes.
 
 (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
@@ -160,16 +190,7 @@
 	 (terpri stream)))))
 
   ;; Generate vtmsgs structure for all superclasses.
-  (hook-output (car (sod-class-vtables class))
-		    'vtmsgs
-		    sequencer))
-
-(defmethod hook-output progn ((class sod-class) reason sequencer)
-  (with-slots ((ilayout %ilayout) vtables methods effective-methods) class
-    (hook-output ilayout reason sequencer)
-    (dolist (method methods) (hook-output method reason sequencer))
-    (dolist (method effective-methods) (hook-output method reason sequencer))
-    (dolist (vtable vtables) (hook-output vtable reason sequencer))))
+  (hook-output (car (sod-class-vtables class)) 'vtmsgs sequencer))
 
 ;;;--------------------------------------------------------------------------
 ;;; Instance structure.
@@ -183,14 +204,6 @@
        (pprint-c-type (sod-slot-type slot) stream (sod-slot-name slot)))
      (terpri stream))))
 
-(defmethod hook-output progn ((ilayout ilayout) reason sequencer)
-  (with-slots (ichains) ilayout
-    (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)))
-
 (defmethod hook-output progn ((ilayout ilayout) (reason (eql :h)) sequencer)
   (with-slots ((class %class) ichains) ilayout
     (sequence-output (stream sequencer)
@@ -251,10 +264,6 @@
        (format stream "  const struct ~A *_vt;~%"
 	       (vtable-struct-tag chain-tail chain-head))))))
 
-(defmethod hook-output progn ((islots islots) reason sequencer)
-  (dolist (slot (islots-slots islots))
-    (hook-output slot reason sequencer)))
-
 (defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
   (with-slots ((class %class) subclass slots) islots
     (sequence-output (stream sequencer)
@@ -266,10 +275,6 @@
 ;;;--------------------------------------------------------------------------
 ;;; Vtable structure.
 
-(defmethod hook-output progn ((vtable vtable) reason sequencer)
-  (with-slots (body) vtable
-    (dolist (item body) (hook-output item reason sequencer))))
-
 (defmethod hook-output progn ((method sod-method)
 			      (reason (eql :h))
 			      sequencer)
@@ -342,10 +347,6 @@
 	((subclass :vtmsgs class :end)
 	 (format stream "};~2%"))))))
 
-(defmethod hook-output progn ((vtmsgs vtmsgs) reason sequencer)
-  (with-slots (entries) vtmsgs
-    (dolist (entry entries) (hook-output entry reason sequencer))))
-
 (defmethod hook-output progn ((entry method-entry)
 			      (reason (eql 'vtmsgs))
 			      sequencer)
@@ -390,6 +391,7 @@
 ;;;--------------------------------------------------------------------------
 ;;; Implementation output.
 
+(export '*instance-class*)
 (defvar *instance-class*)
 
 (defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)
@@ -418,8 +420,7 @@ const struct ~A ~A__classobj = {~%"
 
   (let ((*instance-class* class))
     (hook-output (sod-class-ilayout (sod-class-metaclass class))
-		      'class
-		      sequencer)))
+		 'class sequencer)))
 
 ;;;--------------------------------------------------------------------------
 ;;; Direct and effective methods.