From 6e2d4b5250ecf9cf82fcb7c5c76bdebca230150b Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Tue, 22 Sep 2015 11:27:11 +0100
Subject: [PATCH] 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.
---
 src/class-output.lisp | 65 ++++++++++++++++++++++++++-------------------------
 1 file changed, 33 insertions(+), 32 deletions(-)

diff --git a/src/class-output.lisp b/src/class-output.lisp
index 91dc0bf..31f3214 100644
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -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.
-- 
2.11.0