src/class-output.lisp: Reformat and reorder.

The major improvement is to gather together the methods which walk the
layout hierarchy, independently of the output reason.

diff --git a/src/class-output.lisp b/src/class-output.lisp
index 91dc0bfdd1185ee855a4569ab2a780b899318449..31f32147723d96d6f0f01edb768c42fca96d9820 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -25,6 +25,36 @@
 
 (cl:in-package #:sod)
 
 
 (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.
 
 ;;;--------------------------------------------------------------------------
 ;;; Classes.
 


@@ -160,16 +190,7 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
         (terpri stream)))))
 
   ;; Generate vtmsgs structure for all superclasses.
         (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.
 
 ;;;--------------------------------------------------------------------------
 ;;; Instance structure.


@@ -183,14 +204,6 @@ (defmethod hook-output progn ((slot sod-slot)
        (pprint-c-type (sod-slot-type slot) stream (sod-slot-name slot)))
      (terpri stream))))
 
        (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)
 (defmethod hook-output progn ((ilayout ilayout) (reason (eql :h)) sequencer)
   (with-slots ((class %class) ichains) ilayout
     (sequence-output (stream sequencer)


@@ -251,10 +264,6 @@ (defmethod hook-output progn ((vtptr vtable-pointer)
        (format stream "  const struct ~A *_vt;~%"
               (vtable-struct-tag chain-tail chain-head))))))
 
        (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)
 (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 @@ (defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
 ;;;--------------------------------------------------------------------------
 ;;; Vtable structure.
 
 ;;;--------------------------------------------------------------------------
 ;;; 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)
 (defmethod hook-output progn ((method sod-method)
                              (reason (eql :h))
                              sequencer)


@@ -342,10 +347,6 @@ (defmethod hook-output progn ((vtmsgs vtmsgs)
        ((subclass :vtmsgs class :end)
         (format stream "};~2%"))))))
 
        ((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)
 (defmethod hook-output progn ((entry method-entry)
                              (reason (eql 'vtmsgs))
                              sequencer)


@@ -390,6 +391,7 @@ (defmethod hook-output progn ((choff chain-offset)
 ;;;--------------------------------------------------------------------------
 ;;; Implementation output.
 
 ;;;--------------------------------------------------------------------------
 ;;; Implementation output.
 

+(export '*instance-class*)

 (defvar *instance-class*)
 
 (defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)
 (defvar *instance-class*)
 
 (defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)


@@ -418,8 +420,7 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)
 
   (let ((*instance-class* class))
     (hook-output (sod-class-ilayout (sod-class-metaclass class))
 
   (let ((*instance-class* class))
     (hook-output (sod-class-ilayout (sod-class-metaclass class))

-                     'class
-                     sequencer)))
+                'class sequencer)))

 
 ;;;--------------------------------------------------------------------------
 ;;; Direct and effective methods.
 
 ;;;--------------------------------------------------------------------------
 ;;; Direct and effective methods.