From 1f1d88f5234188f70548a04fd117ac6e251fe8de Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Wed, 14 Oct 2009 01:17:21 +0100
Subject: [PATCH] Very ragged work-in-progress.

Most parts are in place.  Much rearrangement is needed.
---
 .gitignore              |   5 +
 c-types.lisp            | 529 ++++++++++++++-------------
 class-builder.lisp      | 417 ++++++++++++++++++---
 class-defs.lisp         | 580 +++++++++++------------------
 class-finalize.lisp     | 274 ++++++++++++++
 class-layout.lisp       | 639 ++++++++++++++++++++++++++++++++
 class-output.lisp       | 314 ++++++++++++++++
 codegen.lisp            | 470 ++++++++++++++++++++++++
 combination.lisp        | 131 +++++++
 cpl.lisp                |   7 +-
 cutting-room-floor.lisp | 104 +++++-
 examples.lisp           |  60 +++
 layout.lisp             |  84 -----
 lex.lisp                |  79 +++-
 methods.lisp            | 721 ++++++++++++++++++++++++++++++++++++
 module.lisp             |   2 +-
 output.lisp             | 133 ++++++-
 parse-c-types.lisp      |  18 +-
 posn-stream.lisp        |  12 +-
 pset.lisp               |  36 +-
 sod-tut.tex             | 228 ++++++++++++
 sod.asd                 |  16 +-
 sod.h                   | 152 ++++++++
 sod.tex                 | 942 ++++++++++++++++++++++++++++++++++++++++++++++++
 utilities.lisp          |  51 ++-
 25 files changed, 5185 insertions(+), 819 deletions(-)
 create mode 100644 class-finalize.lisp
 create mode 100644 class-layout.lisp
 create mode 100644 class-output.lisp
 create mode 100644 codegen.lisp
 create mode 100644 combination.lisp
 create mode 100644 examples.lisp
 delete mode 100644 layout.lisp
 create mode 100644 methods.lisp
 create mode 100644 sod-tut.tex
 create mode 100644 sod.h
 create mode 100644 sod.tex

diff --git a/.gitignore b/.gitignore
index 3d894d7..9fa0c7e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,7 @@
 *~
 *.fasl
+*.pdf
+*.out
+*.log
+*.dvi
+*.aux
diff --git a/c-types.lisp b/c-types.lisp
index acf2db8..fe56ecd 100644
--- a/c-types.lisp
+++ b/c-types.lisp
@@ -37,13 +37,6 @@
 
 ;; Important protocol.
 
-(defgeneric c-declaration (type decl)
-  (:documentation
-   "Computes a declaration for a C type.
-
-   Returns two strings, a type and a declarator, suitable for declaring an
-   object with the inner declarator DECL."))
-
 (defgeneric c-type-subtype (type)
   (:documentation
    "For compound types, return the base type."))
@@ -55,14 +48,25 @@
   (:method and (type-a type-b)
     (eql (class-of type-a) (class-of type-b))))
 
-(defgeneric c-declarator-priority (type)
+(defgeneric pprint-c-type (type stream kernel)
   (:documentation
-   "Returns the priority for the declarator of TYPE.
-
-   Used to decide when to insert parentheses into the C representation.")
-
-  (:method ((type c-type))
-    0))
+   "Pretty-printer for C types.
+
+   Print TYPE to STREAM.  In the middle of the declarator, call the function
+   KERNEL with one argument: whether it needs a leading space.")
+  (:method :around (type stream kernel)
+    (typecase kernel
+      (function (call-next-method))
+      (null (pprint-c-type type stream
+			   (lambda (stream prio spacep)
+			     (declare (ignore stream prio spacep))
+			     nil)))
+      (t (pprint-c-type type stream
+			(lambda (stream prio spacep)
+			  (declare (ignore prio))
+			  (when spacep
+			    (c-type-space stream))
+			  (princ kernel stream)))))))
 
 (defgeneric print-c-type (stream type &optional colon atsign)
   (:documentation
@@ -71,30 +75,37 @@
 (defmethod print-object ((object c-type) stream)
   (if *print-escape*
       (format stream "~:@<C-TYPE ~/sod::print-c-type/~:>" object)
-      (multiple-value-bind (base decl) (c-declaration object "")
-	(format stream "~A~:[~; ~A~]" base (plusp (length decl)) decl))))
+      (pprint-c-type object stream nil)))
 
-;; Utility functions.
+;; Utility functions and macros.
 
-(defun maybe-parenthesize (decl me him)
-  "Wrap parens around DECL, maybe, according to priorities of ME and HIM.
+(defun c-type-space (stream)
+  "Print a space and a miser-mode newline to STREAM.
 
-   If the declarator for HIM has a higher priority than that of ME (as C
-   types) then return DECL with parens wrapped around it; otherwise just
-   return DECL."
-  (if (<= (c-declarator-priority him)
-	  (c-declarator-priority me))
-      decl
-      (format nil "(~A)" decl)))
+   This is the right function to call in a PPRINT-C-TYPE kernel function when
+   the SPACEP argument is true."
+  (pprint-indent :block 2 stream)
+  (write-char #\space stream)
+  (pprint-newline :miser stream))
 
-(defun compound-type-declaration (type format-control &rest format-args)
-  "Convenience function for implementating compound types.
+(defun maybe-in-parens* (stream condition thunk)
+  "Helper function for the MAYBE-IN-PARENS macro."
+  (pprint-logical-block
+      (stream nil
+	      :prefix (if condition "(" "")
+	      :suffix (if condition ")" ""))
+    (funcall thunk stream)))
 
-   The declaration is formed from the type's subtype and by processing the
-   given format string."
-  (let ((subty (c-type-subtype type))
-	(subdecl (format nil "~?" format-control format-args)))
-    (c-declaration subty (maybe-parenthesize subdecl type subty))))
+(defmacro maybe-in-parens ((stream condition) &body body)
+  "Evaluate BODY; if CONDITION, write parens to STREAM around it.
+
+   This macro is useful for implementing the PPRINT-C-TYPE method on compound
+   types.  The BODY is evaluated in the context of a logical block printing
+   to STREAM.  If CONDITION is non-nil, then the block will have open/close
+   parens as its prefix and suffix; otherwise they will be empty.
+
+   The STREAM is passed to PPRINT-LOGICAL-BLOCK, so it must be a symbol."
+  `(maybe-in-parens* ,stream ,condition (lambda (,stream) ,@body)))
 
 ;; S-expression syntax machinery.
 
@@ -117,34 +128,21 @@
 			      (error "Bad character in C name ~S." name))))))
     (t name)))
 
-(defun expand-c-type (spec)
-  "Parse SPEC as a C type and return the result.
-
-   The SPEC can be one of the following.
-
-     * A C-TYPE object, which is returned immediately.
-
-     * A list, (OPERATOR . ARGUMENTS), where OPERATOR is a symbol: a parser
-       function associated with the OPERATOR symbol by DEFINE-C-TYPE-SYNTAX
-       or some other means is invoked on the ARGUMENTS, and the result is
-       returned.
-
-     * A symbol, which is treated the same way as a singleton list would be."
-
-  (flet ((interp (sym)
-	   (or (get sym 'c-type)
-	       (error "Unknown C type operator ~S." sym))))
-    (etypecase spec
-      (c-type spec)
-      (symbol (funcall (interp spec)))
-      (list (apply (interp (car spec)) (cdr spec))))))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defgeneric expand-c-type-spec (spec)
+    (:documentation
+     "Expand SPEC into Lisp code to construct a C type.")
+    (:method ((spec list))
+      (expand-c-type-form (car spec) (cdr spec))))
+  (defgeneric expand-c-type-form (head tail)
+    (:documentation
+     "Expand a C type list beginning with HEAD.")
+    (:method ((name (eql 'lisp)) tail)
+      `(progn ,@tail))))
 
 (defmacro c-type (spec)
-  "Evaluates to the type that EXPAND-C-TYPE would return.
-
-   Currently this just quotes SPEC and calls EXPAND-C-TYPE at runtime.  Maybe
-   later it will do something more clever."
-  `(expand-c-type ',spec))
+  "Expands to code to construct a C type, using EXPAND-C-TYPE-SPEC."
+  (expand-c-type-spec spec))
 
 (defmacro define-c-type-syntax (name bvl &rest body)
   "Define a C-type syntax function.
@@ -152,16 +150,23 @@
    A function defined by BODY and with lambda-list BVL is associated with the
    NAME.  When EXPAND-C-TYPE sees a list (NAME . STUFF), it will call this
    function with the argument list STUFF."
-  `(progn
-     (setf (get ',name 'c-type) (lambda ,bvl ,@body))
-     ',name))
+  (let ((headvar (gensym "HEAD"))
+	(tailvar (gensym "TAIL")))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       (defmethod expand-c-type-form ((,headvar (eql ',name)) ,tailvar)
+	 (destructuring-bind ,bvl ,tailvar
+	   ,@body)))))
 
 (defmacro c-type-alias (original &rest aliases)
   "Make ALIASES behave the same way as the ORIGINAL type."
-  (let ((i (gensym)) (orig (gensym)))
-    `(let ((,orig (get ',original 'c-type)))
-       (dolist (,i ',aliases)
-	 (setf (get ,i 'c-type) ,orig)))))
+  (let ((headvar (gensym "HEAD"))
+	(tailvar (gensym "TAIL")))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       ,@(mapcar (lambda (alias)
+		   `(defmethod expand-c-type-form
+			((,headvar (eql ',alias)) ,tailvar)
+		      (expand-c-type-form ',original ,tailvar)))
+		 aliases))))
 
 (defmacro defctype (names value)
   "Define NAMES all to describe the C-type VALUE.
@@ -169,13 +174,16 @@
    NAMES can be a symbol (treated as a singleton list), or a list of symbols.
    The VALUE is a C type S-expression, acceptable to EXPAND-C-TYPE.  It will
    be expanded once at run-time."
-  (unless (listp names)
-    (setf names (list names)))
-  (let ((ty (gensym)))
-    `(let ((,ty (expand-c-type ',value)))
-       (setf (get ',(car names) 'c-type) (lambda () ,ty))
-       ,@(and (cdr names)
-	      `((c-type-alias ,(car names) ,@(cdr names)))))))
+  (let* ((names (if (listp names) names (list names)))
+	 (namevar (gensym "NAME"))
+	 (typevar (symbolicate 'c-type- (car names))))
+    `(progn
+       (defparameter ,typevar ,(expand-c-type-spec value))
+       (eval-when (:compile-toplevel :load-toplevel :execute)
+	 ,@(mapcar (lambda (name)
+		     `(defmethod expand-c-type-spec ((,namevar (eql ',name)))
+			',typevar))
+		   names)))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Types which can accept qualifiers.
@@ -200,15 +208,6 @@
 	   (sort (copy-list (c-type-qualifiers type)) #'string<)))
     (equal (fix type-a) (fix type-b))))
 
-(defmethod print-c-type :around
-    (stream (type qualifiable-c-type) &optional colon atsign)
-  (if (c-type-qualifiers type)
-      (pprint-logical-block (stream nil :prefix "(" :suffix ")")
-	(format stream "QUALIFIER~{ ~:_~:I~A~} ~:_"
-		(c-type-qualifiers type))
-	(call-next-method stream type colon atsign))
-      (call-next-method)))
-
 ;; A handy utility.
 
 (let ((cache (make-hash-table :test #'equal)))
@@ -226,43 +225,6 @@
 	      (setf (gethash key cache)
 		    (copy-instance c-type :qualifiers qualifiers)))))))
 
-;; S-expression machinery.  Qualifiers have hairy syntax and need to be
-;; implemented by hand.
-
-(defun qualifier (qual &rest args)
-  "Parse a qualified C type.
-
-   The ARGS consist of a number of qualifiers and exactly one C-type
-   S-expression.  The result is a qualified version of this type, with the
-   given qualifiers attached."
-  (if (null args)
-      qual
-      (let* ((things (mapcar #'expand-c-type args))
-	     (quals (delete-duplicates
-		     (sort (cons qual (remove-if-not #'keywordp things))
-			   #'string<)))
-	     (types (remove-if-not (lambda (thing) (typep thing 'c-type))
-				   things)))
-	(when (or (null types)
-		  (not (null (cdr types))))
-	  (error "Only one proper type expected in ~S." args))
-	(qualify-type (car types) quals))))
-(setf (get 'qualifier 'c-type) #'qualifier)
-
-(defun declare-qualifier (qual)
-  "Defines QUAL as being a type qualifier.
-
-   When used as a C-type operator, it applies that qualifier to the type that
-   is its argument."
-  (let ((kw (intern (string qual) :keyword)))
-    (setf (get qual 'c-type)
-	  (lambda (&rest args)
-	    (apply #'qualifier kw args)))))
-
-;; Define some initial qualifiers.
-(dolist (qual '(const volatile restrict))
-  (declare-qualifier qual))
-
 ;;;--------------------------------------------------------------------------
 ;;; Simple C types (e.g., built-in arithmetic types).
 
@@ -279,17 +241,19 @@
    "C types with simple forms."))
 
 (let ((cache (make-hash-table :test #'equal)))
-  (defun make-simple-type (name)
+  (defun make-simple-type (name &optional qualifiers)
     "Make a distinguished object for the simple type called NAME."
-    (or (gethash name cache)
-	(setf (gethash name cache)
-	      (make-instance 'simple-c-type :name name)))))
-
-(defmethod c-declaration ((type simple-c-type) decl)
-  (values (concatenate 'string
-		       (format-qualifiers (c-type-qualifiers type))
-		       (c-type-name type))
-	  decl))
+    (qualify-type (or (gethash name cache)
+		      (setf (gethash name cache)
+			    (make-instance 'simple-c-type :name name)))
+		  qualifiers)))
+
+(defmethod pprint-c-type ((type simple-c-type) stream kernel)
+  (pprint-logical-block (stream nil)
+    (format stream "~{~(~A~) ~@_~}~A"
+	    (c-type-qualifiers type)
+	    (c-type-name type))
+    (funcall kernel stream 0 t)))
 
 (defmethod c-type-equal-p and ((type-a simple-c-type)
 			       (type-b simple-c-type))
@@ -299,22 +263,25 @@
   (declare (ignore colon atsign))
   (let* ((name (c-type-name type))
 	 (symbol (gethash name *simple-type-map*)))
-    (if symbol
-	(princ symbol stream)
-	(format stream "~:@<SIMPLE-C-TYPE ~@_~S~:>" name))))
+    (format stream "~:[~S~;~:@<~S~0@*~{ ~_~S~}~:>~]"
+	    (c-type-qualifiers type) (or symbol name))))
 
 ;; S-expression syntax.
 
-(define-c-type-syntax simple-c-type (name)
-  "Constructs a simple C type called NAME (a string or symbol)."
-  (make-simple-type (c-name-case name)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defmethod expand-c-type-spec ((spec string))
+    `(make-simple-type ,spec))
+  (defmethod expand-c-type-form ((head string) tail)
+    `(make-simple-type ,head ,@tail)))
 
 (defmacro define-simple-c-type (names type)
   "Define each of NAMES to be a simple type called TYPE."
-  `(progn
-     (setf (gethash ,type *simple-type-map*)
-	   ',(if (listp names) (car names) names))
-     (defctype ,names (simple-c-type ,type))))
+  (let ((names (if (listp names) names (list names))))
+    `(progn
+       (setf (gethash ,type *simple-type-map*) ',(car names))
+       (defctype ,names ,type)
+       (define-c-type-syntax ,(car names) (&rest quals)
+	 `(make-simple-type ,',type (list ,@quals))))))
 
 (define-simple-c-type void "void")
 
@@ -366,46 +333,34 @@
    "Return the kind of tagged type that TYPE is, as a keyword."))
 
 (macrolet ((define-tagged-type (kind what)
-	     (let ((type (intern (format nil "C-~A-TYPE" (string kind))))
-		   (constructor (intern (format nil "MAKE-~A-TYPE"
-						(string kind)))))
+	     (let ((type (symbolicate 'c- kind '-type))
+		   (constructor (symbolicate 'make- kind '-type)))
 	       `(progn
 		  (defclass ,type (tagged-c-type) ()
 		    (:documentation ,(format nil "C ~a types." what)))
 		  (defmethod c-tagged-type-kind ((type ,type))
-		    ,kind)
+		    ',kind)
 		  (let ((cache (make-hash-table :test #'equal)))
-		    (defun ,constructor (tag)
-		      (or (gethash tag cache)
-			  (setf (gethash tag cache)
-				(make-instance ',type :tag tag)))))
-		    (define-c-type-syntax ,(intern (string kind)) (tag)
-		      ,(format nil "Construct ~A type named TAG" what)
-		      (,constructor tag))))))
-  (define-tagged-type :enum "enumerated")
-  (define-tagged-type :struct "structure")
-  (define-tagged-type :union "union"))
-
-(defclass c-enum-type (tagged-c-type)
-  ()
-  (:documentation
-   "C enumeration types."))
-(defclass c-struct-type (tagged-c-type)
-  ()
-  (:documentation
-   "C structure types."))
-(defclass c-union-type (tagged-c-type)
-  ()
-  (:documentation
-   "C union types."))
-
-(defmethod c-declaration ((type tagged-c-type) decl)
-  (values (concatenate 'string
-		       (format-qualifiers (c-type-qualifiers type))
-		       (string-downcase (c-tagged-type-kind type))
-		       " "
-		       (c-type-tag type))
-	  decl))
+		    (defun ,constructor (tag &optional qualifiers)
+		      (qualify-type (or (gethash tag cache)
+					(setf (gethash tag cache)
+					      (make-instance ',type
+							     :tag tag)))
+				    qualifiers)))
+		  (define-c-type-syntax ,kind (tag &rest quals)
+		    ,(format nil "Construct ~A type named TAG" what)
+		    `(,',constructor ,tag (list ,@quals)))))))
+  (define-tagged-type enum "enumerated")
+  (define-tagged-type struct "structure")
+  (define-tagged-type union "union"))
+
+(defmethod pprint-c-type ((type tagged-c-type) stream kernel)
+  (pprint-logical-block (stream nil)
+    (format stream "~{~(~A~) ~@_~}~(~A~) ~A"
+	    (c-type-qualifiers type)
+	    (c-tagged-type-kind type)
+	    (c-type-tag type))
+    (funcall kernel stream 0 t)))
 
 (defmethod c-type-equal-p and ((type-a tagged-c-type)
 			       (type-b tagged-c-type))
@@ -413,21 +368,10 @@
 
 (defmethod print-c-type (stream (type tagged-c-type) &optional colon atsign)
   (declare (ignore colon atsign))
-  (format stream "~:@<~A ~A~:>"
+  (format stream "~:@<~S ~@_~S~{ ~_~S~}~:>"
 	  (c-tagged-type-kind type)
-	  (c-type-tag type)))
-
-;; S-expression syntax.
-
-(define-c-type-syntax enum (tag)
-  "Construct an enumeration type named TAG."
-  (make-instance 'c-enum-type :tag (c-name-case tag)))
-(define-c-type-syntax struct (tag)
-  "Construct a structure type named TAG."
-  (make-instance 'c-struct-type :tag (c-name-case tag)))
-(define-c-type-syntax union (tag)
-  "Construct a union type named TAG."
-  (make-instance 'c-union-type :tag (c-name-case tag)))
+	  (c-type-tag type)
+	  (c-type-qualifiers type)))
 
 ;;;--------------------------------------------------------------------------
 ;;; Pointer types.
@@ -441,13 +385,21 @@
   (:documentation
    "C pointer types."))
 
-(defmethod c-declarator-priority ((type c-pointer-type)) 1)
-
-(defmethod c-declaration ((type c-pointer-type) decl)
-  (compound-type-declaration type
-			     "*~A~A"
-			     (format-qualifiers (c-type-qualifiers type))
-			     decl))
+(let ((cache (make-hash-table :test #'eql)))
+  (defun make-pointer-type (subtype &optional qualifiers)
+    "Return a (maybe distinguished) pointer type."
+    (qualify-type (or (gethash subtype cache)
+		      (make-instance 'c-pointer-type :subtype subtype))
+		  qualifiers)))
+
+(defmethod pprint-c-type ((type c-pointer-type) stream kernel)
+  (pprint-c-type (c-type-subtype type) stream
+		 (lambda (stream prio spacep)
+		   (when spacep (c-type-space stream))
+		   (maybe-in-parens (stream (> prio 1))
+		     (format stream "*~{~(~A~)~^ ~@_~}"
+			     (c-type-qualifiers type))
+		     (funcall kernel stream 1 (c-type-qualifiers type))))))
 
 (defmethod c-type-equal-p and ((type-a c-pointer-type)
 			       (type-b c-pointer-type))
@@ -456,17 +408,19 @@
 
 (defmethod print-c-type (stream (type c-pointer-type) &optional colon atsign)
   (declare (ignore colon atsign))
-  (format stream "~:@<* ~@_~/sod::print-c-type/~:>"
-	  (c-type-subtype type)))
+  (format stream "~:@<* ~@_~/sod::print-c-type/~{ ~_~S~}~:>"
+	  (c-type-subtype type)
+	  (c-type-qualifiers type)))
 
 ;; S-expression syntax.
 
-(define-c-type-syntax pointer (sub)
+(define-c-type-syntax * (sub &rest quals)
   "Return the type of pointer-to-SUB."
-  (make-instance 'c-pointer-type :subtype (expand-c-type sub)))
-(c-type-alias pointer * ptr)
+  `(make-pointer-type ,(expand-c-type-spec sub) (list ,@quals)))
+(c-type-alias * pointer ptr)
 
 (defctype string (* char))
+(defctype const-string (* (char :const)))
 
 ;;;--------------------------------------------------------------------------
 ;;; Array types.
@@ -483,13 +437,18 @@
   (:documentation
    "C array types."))
 
-(defmethod c-declarator-priority ((type c-array-type)) 2)
+(defun make-array-type (subtype dimensions)
+  "Return a new array of SUBTYPE with given DIMENSIONS."
+  (make-instance 'c-array-type :subtype subtype
+		 :dimensions (or dimensions '(nil))))
 
-(defmethod c-declaration ((type c-array-type) decl)
-  (compound-type-declaration type
-			     "~A~{[~@[~A~]]~}"
-			     decl
-			     (c-array-dimensions type)))
+(defmethod pprint-c-type ((type c-array-type) stream kernel)
+  (pprint-c-type (c-type-subtype type) stream
+		 (lambda (stream prio spacep)
+		   (maybe-in-parens (stream (> prio 2))
+		     (funcall kernel stream 2 spacep)
+		     (format stream "~@<~{[~@[~A~]]~^~_~}~:>"
+			     (c-array-dimensions type))))))
 
 (defmethod c-type-equal-p and ((type-a c-array-type)
 			       (type-b c-array-type))
@@ -500,63 +459,35 @@
 
 (defmethod print-c-type (stream (type c-array-type) &optional colon atsign)
   (declare (ignore colon atsign))
-  (format stream "~:@<[] ~@_~:I~/sod::print-c-type/~{ ~_~A~}~:>"
+  (format stream "~:@<[] ~@_~:I~/sod::print-c-type/~{ ~_~S~}~:>"
 	  (c-type-subtype type)
 	  (c-array-dimensions type)))
 
 ;; S-expression syntax.
 
-(define-c-type-syntax array (sub &rest dims)
+(define-c-type-syntax [] (sub &rest dims)
   "Return the type of arrays of SUB with the dimensions DIMS.
 
    If the DIMS are omitted, a single unknown-length dimension is added."
-  (make-instance 'c-array-type
-		 :subtype (expand-c-type sub)
-		 :dimensions (or dims '(nil))))
-(c-type-alias array [] vec)
+  `(make-array-type ,(expand-c-type-spec sub)
+		    (list ,@(or dims '(nil)))))
+(c-type-alias [] array vec)
 
 ;;;--------------------------------------------------------------------------
 ;;; Function types.
 
-;; Definitions.
-
-(defclass c-function-type (c-type)
-  ((subtype :initarg :subtype
-	    :type c-type
-	    :reader c-type-subtype)
-   (arguments :initarg :arguments
-	      :type list
-	      :reader c-function-arguments))
-  (:documentation
-   "C function types.  The subtype is the return type, as implied by the C
-    syntax for function declarations."))
-
-(defmethod c-declarator-priority ((type c-function-type)) 2)
+;; Arguments.
 
 (defstruct (argument (:constructor make-argument (name type)) (:type list))
   "Simple list structure representing a function argument."
   name
   type)
 
-(defmethod c-declaration ((type c-function-type) decl)
-  (compound-type-declaration type
-			     "~A(~:[void~;~:*~{~A~^, ~}~])"
-			     decl
-			     (mapcar (lambda (arg)
-				       (if (eq arg :ellipsis)
-					   "..."
-					   (multiple-value-bind
-					       (typestr declstr)
-					       (c-declaration
-						(argument-type arg)
-						(or (argument-name arg) ""))
-					     (format nil "~A~:[~; ~A~]"
-						     typestr
-						     (plusp (length declstr))
-						     declstr))))
-				     (c-function-arguments type))))
-
 (defun arguments-lists-equal-p (list-a list-b)
+  "Return whether LIST-A and LIST-B match.
+
+   They must have the same number of arguments, and each argument must have
+   the same type, or be :ELLIPSIS.  The argument names are not inspected."
   (and (= (length list-a) (length list-b))
        (every (lambda (arg-a arg-b)
 		(if (eq arg-a :ellipsis)
@@ -565,6 +496,52 @@
 				    (argument-type arg-b))))
 	      list-a list-b)))
 
+(defgeneric commentify-argument-name (name)
+  (:documentation
+   "Produce a `commentified' version of the argument.
+
+   The default behaviour is that temporary argument names are simply omitted
+   (NIL is returned); otherwise, `/*...*/' markers are wrapped around the
+   printable representation of the argument.")
+  (:method ((name null)) nil)
+  (:method ((name t)) (format nil "/*~A*/" name)))
+
+(defun commentify-argument-names (arguments)
+  "Return an argument list with the arguments commentified.
+
+   That is, with each argument name passed through COMMENTIFY-ARGUMENT-NAME."
+  (mapcar (lambda (arg)
+	    (if (eq arg :ellipsis)
+		arg
+		(make-argument (commentify-argument-name (argument-name arg))
+			       (argument-type arg))))
+	  arguments))
+
+(defun commentify-function-type (type)
+  "Return a type like TYPE, but with arguments commentified.
+
+   This doesn't recurse into the return type or argument types."
+  (make-function-type (c-type-subtype type)
+		      (commentify-argument-names
+		       (c-function-arguments type))))
+
+;; Definitions.
+
+(defclass c-function-type (c-type)
+  ((subtype :initarg :subtype
+	    :type c-type
+	    :reader c-type-subtype)
+   (arguments :initarg :arguments
+	      :type list
+	      :reader c-function-arguments))
+  (:documentation
+   "C function types.  The subtype is the return type, as implied by the C
+    syntax for function declarations."))
+
+(defun make-function-type (subtype arguments)
+  "Return a new function type, returning SUBTYPE and accepting ARGUMENTS."
+  (make-instance 'c-function-type :subtype subtype :arguments arguments))
+
 (defmethod c-type-equal-p and ((type-a c-function-type)
 			       (type-b c-function-type))
   (and (c-type-equal-p (c-type-subtype type-a)
@@ -579,25 +556,65 @@
 	  #.(concatenate 'string
 			 "~:@<"
 			 "FUN ~@_~:I~/sod::print-c-type/"
-			 "~{ ~_~:<~A ~@_~/sod::print-c-type/~:>~}"
+			 "~{ ~_~:<~S ~@_~/sod::print-c-type/~:>~}"
 			 "~:>")
 	  (c-type-subtype type)
 	  (c-function-arguments type)))
 
+(defmethod pprint-c-type ((type c-function-type) stream kernel)
+  (pprint-c-type (c-type-subtype type) stream
+		 (lambda (stream prio spacep)
+		   (maybe-in-parens (stream (> prio 2))
+		     (when spacep (c-type-space stream))
+		     (funcall kernel stream 2 nil)
+		     (pprint-indent :block 4 stream)
+		     ;;(pprint-newline :miser stream)
+		     (pprint-logical-block
+			 (stream nil :prefix "(" :suffix ")")
+		       (let ((firstp t))
+			 (dolist (arg (c-function-arguments type))
+			   (if firstp
+			       (setf firstp nil)
+			       (format stream ", ~_"))
+			   (if (eq arg :ellipsis)
+			       (write-string "..." stream)
+			       (pprint-c-type (argument-type arg)
+					      stream
+					      (argument-name arg))))))))))
+
 ;; S-expression syntax.
 
-(define-c-type-syntax function (ret &rest args)
+(define-c-type-syntax fun (ret &rest args)
   "Return the type of functions which returns RET and has arguments ARGS.
 
-   The ARGS are a list (NAME TYPE).  The NAME can be NIL to indicate that no
-   name was given."
-  (make-instance 'c-function-type
-		 :subtype (expand-c-type ret)
-		 :arguments (mapcar (lambda (arg)
-				      (make-argument (car arg)
-						     (expand-c-type
-						      (cadr arg))))
-				    args)))
-(c-type-alias function () func fun fn)
+   The ARGS are a list of arguments of the form (NAME TYPE).  The NAME can be
+   NIL to indicate that no name was given.
+
+   If an entry isn't a list, it's assumed to be the start of a Lisp
+   expression to compute the tail of the list; similarly, if the list is
+   improper, then it's considered to be a complete expression.  The upshot of
+   this apparently bizarre rule is that you can say
+
+     (c-type (fun int (\"foo\" int) . arg-tail))
+
+   where ARG-TAIL is (almost) any old Lisp expression and have it tack the
+   arguments onto the end.  Of course, there don't have to be any explicit
+   arguments at all.  The only restriction is that the head of the Lisp form
+   can't be a list -- so ((lambda (...) ...) ...) is out, but you probably
+   wouldn't type that anyway."
+
+  `(make-function-type ,(expand-c-type-spec ret)
+		       ,(do ((args args (cdr args))
+			     (list nil
+				   (cons `(make-argument ,(caar args)
+							 ,(expand-c-type-spec
+							   (cadar args)))
+					 list)))
+			    ((or (atom args) (atom (car args)))
+			     (cond ((and (null args) (null list)) `nil)
+				   ((null args) `(list ,@(nreverse list)))
+				   ((null list) `,args)
+				   (t `(list* ,@(nreverse list) ,args)))))))
+(c-type-alias fun function () func fn)
 
 ;;;----- That's all, folks --------------------------------------------------
diff --git a/class-builder.lisp b/class-builder.lisp
index 8c945ab..4e05a64 100644
--- a/class-builder.lisp
+++ b/class-builder.lisp
@@ -30,16 +30,21 @@
 
 (defun find-superclass-by-nick (class nick)
   "Returns the superclass of CLASS with nickname NICK, or signals an error."
-  (or (find nick (sod-class-precedence-list class)
-	    :key #'sod-class-nickname
-	    :test #'string=)
-      (error "No superclass of `~A' with nickname `~A'"
-	     (sod-class-name class) nick)))
+
+  ;; Slightly tricky.  The class almost certainly hasn't been finalized, so
+  ;; trundle through its superclasses and hope for the best.
+  (if (string= nick (sod-class-nickname class))
+      class
+      (or (some (lambda (super)
+		  (find nick (sod-class-precedence-list super)
+			:key #'sod-class-nickname
+			:test #'string=))
+		(sod-class-direct-superclasses class))
+	  (error "No superclass of `~A' with nickname `~A'" class nick))))
 
 (flet ((find-item-by-name (what class list name key)
 	 (or (find name list :key key :test #'string=)
-	     (error "No ~A in class `~A' with name `~A'"
-		    what (sod-class-name class) name))))
+	     (error "No ~A in class `~A' with name `~A'" what class name))))
 
   (defun find-instance-slot-by-name (class super-nick slot-name)
     (let ((super (find-superclass-by-nick class super-nick)))
@@ -103,7 +108,7 @@
 			 ((sod-subclass-p meta candidate) meta)
 			 ((sod-subclass-p candidate meta) candidate)
 			 (t (error "Unable to choose metaclass for `~A'"
-				   (sod-class-name class)))))))
+				   class))))))
       ((endp supers) meta)))
 
 (defmethod shared-initialize :after ((class sod-class) slot-names &key pset)
@@ -119,30 +124,26 @@
        (the class's name, forced to lowercase) will be chosen in
        FINALIZE-SOD-CLASS.
 
-     * :CHAIN names the chained superclass.  If unspecified, this class will
+     * :LINK names the chained superclass.  If unspecified, this class will
        be left at the head of its chain."
 
-  (macrolet ((default-slot (slot value)
-	       `(unless (slot-boundp class ',slot)
-		  (setf (slot-value class ',slot) ,value))))
-
-    ;; If no nickname, copy the class name.  It won't be pretty, though.
-    (default-slot nickname
-      (get-property pset :nick :id (slot-value class 'name)))
+  ;; If no nickname, copy the class name.  It won't be pretty, though.
+  (default-slot (class 'nickname)
+    (get-property pset :nick :id (slot-value class 'name)))
 
-    ;; If no metaclass, guess one in a (Lisp) class-specific way.
-    (default-slot metaclass
-      (multiple-value-bind (name floc) (get-property pset :metaclass :id)
-	(if floc
-	    (find-sod-class name floc)
-	    (guess-metaclass class))))
+  ;; If no metaclass, guess one in a (Lisp) class-specific way.
+  (default-slot (class 'metaclass)
+    (multiple-value-bind (name floc) (get-property pset :metaclass :id)
+      (if floc
+	  (find-sod-class name floc)
+	  (guess-metaclass class))))
 
-    ;; If no chained-superclass, then start a new chain here.
-    (default-slot chained-superclass
-      (multiple-value-bind (name floc) (get-property pset :chain :id)
-	(if floc
-	    (find-sod-class name floc)
-	    nil)))))
+  ;; If no chain-link, then start a new chain here.
+  (default-slot (class 'chain-link)
+    (multiple-value-bind (name floc) (get-property pset :link :id)
+      (if floc
+	  (find-sod-class name floc)
+	  nil))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Slot construction.
@@ -306,15 +307,15 @@
 (defmethod make-sod-message
     ((class sod-class) name type pset &optional location)
   (with-default-error-location (location)
-    (let ((slot (make-instance (get-property pset :lisp-class :symbol
-					     'sod-slot)
+    (let ((message (make-instance (get-property pset :lisp-class :symbol
+						'standard-message)
 			       :class class
 			       :name name
 			       :type type
 			       :location (file-location location)
 			       :pset pset)))
-      (with-slots (slots) class
-	(setf slots (append slots (list slot))))
+      (with-slots (messages) class
+	(setf messages (append messages (list message))))
       (check-unused-properties pset))))
 
 (defmethod check-message-type ((message sod-message) (type c-function-type))
@@ -354,7 +355,7 @@
 
    This is a generic function so that it can be specialized according to both
    a class and -- more particularly -- a message.  The default method uses
-   the :LISP-CLASS property (defaulting to calling CHOOSE-SOD-METHOD-CLASS)
+   the :LISP-CLASS property (defaulting to calling SOD-MESSAGE-METHOD-CLASS)
    to choose a (CLOS) class to instantiate.  The method is then constructed
    by MAKE-INSTANCE passing the arguments as initargs; further behaviour is
    left to the standard CLOS instance construction protocol; for example,
@@ -414,7 +415,7 @@
     ((method sod-method) (message sod-message) (type c-type))
   (error "Methods must have function type, not ~A" type))
 
-(defun arguments-lists-compatible-p (message-args method-args)
+(defun argument-lists-compatible-p (message-args method-args)
   "Compare argument lists for compatibility.
 
    Return true if METHOD-ARGS is a suitable method argument list
@@ -436,50 +437,352 @@
 
 (defmethod check-method-type
     ((method sod-method) (message sod-message) (type c-function-type))
-
-  ;; Check compatibility.
   (with-slots ((msgtype type)) message
-    (unless (c-type-equal-p type msgtype)
-      (error "Method type ~A doesn't match message type ~A" type msgtype)))
+    (unless (c-type-equal-p (c-type-subtype msgtype)
+			    (c-type-subtype type))
+      (error "Method return type ~A doesn't match message ~A"
+	      (c-type-subtype msgtype) (c-type-subtype type)))
+    (unless (argument-lists-compatible-p (c-function-arguments msgtype)
+					 (c-function-arguments type))
+      (error "Method arguments ~A don't match message ~A" type msgtype))))
+
+(defmethod shared-initialize :after
+    ((method sod-method) slot-names &key pset)
+  (declare (ignore slot-names pset))
 
   ;; Check that the arguments are named if we have a method body.
-  (with-slots (body) method
+  (with-slots (body type) method
     (unless (or (not body)
 		(every #'argument-name (c-function-arguments type)))
-      (error "Abstract declarators not permitted in method definitions"))))
+      (error "Abstract declarators not permitted in method definitions")))
 
-(defmethod shared-initialize :after
-    ((method sod-method) slot-names &key pset)
-  (declare (ignore slot-names pset))
+  ;; Check the method type.
   (with-slots (message type) method
     (check-method-type method message type)))
 
 ;;;--------------------------------------------------------------------------
 ;;; Bootstrapping the class graph.
+;;;
+;;; FIXME: This is a daft place for this function.  It's also accumulating
+;;; all of the magic associated with initializing class instances.
+
+(defun output-imprint-function (class stream)
+  (let ((ilayout (sod-class-ilayout class)))
+    (format stream "~&~:
+static void *~A__imprint(void *p)
+{
+  struct ~A *sod__obj = p;
+
+  ~:{sod__obj.~A._vt = &~A;~:^~%  ~}
+  return (p);
+}~2%"
+	    class
+	    (ilayout-struct-tag class)
+	    (mapcar (lambda (ichain)
+		      (list (sod-class-nickname (ichain-head ichain))
+			    (vtable-name class (ichain-head ichain))))
+		    (ilayout-ichains ilayout)))))
+
+(defun output-init-function (class stream)
+  ;; FIXME this needs a metaobject protocol
+  (let ((ilayout (sod-class-ilayout class)))
+    (format stream "~&~:
+static void *~A__init(void *p)
+{
+  struct ~A *sod__obj = ~0@*~A__imprint(p);~2%"
+	    class
+	    (ilayout-struct-tag class))
+    (dolist (ichain (ilayout-ichains ilayout))
+      (let ((ich (format nil "sod__obj.~A"
+			 (sod-class-nickname (ichain-head ichain)))))
+	(dolist (item (ichain-body ichain))
+	  (etypecase item
+	    (vtable-pointer
+	     (format stream "  ~A._vt = &~A;~%"
+		     ich (vtable-name class (ichain-head ichain))))
+	    (islots
+	     (let ((isl (format nil "~A.~A"
+				ich
+				(sod-class-nickname (islots-class item)))))
+	       (dolist (slot (islots-slots item))
+		 (let ((dslot (effective-slot-direct-slot slot))
+		       (init (effective-slot-initializer slot)))
+		   (when init
+		     (ecase (sod-initializer-value-kind init)
+		       (:single
+			(format stream "  ~A = ~A;~%"
+				isl (sod-initializer-value-form slot)))
+		       (:compound
+			(format stream "  ~A = (~A)~A;~%"
+				isl (sod-slot-type dslot)
+				(sod-initializer-value-form slot)))))))))))))
+    (format stream "~&~:
+  return (p);
+}~2%")))
+
+(defun output-supers-vector (class stream)
+  (let ((supers (sod-class-direct-superclasses class)))
+    (when supers
+      (format stream "~&~:
+static const SodClass *const ~A__supers[] = {
+  ~{~A__class~^,~%  ~}
+};~2%"
+	      class supers))))
+
+(defun output-cpl-vector (class stream)
+  (format stream "~&~:
+static const SodClass *const ~A__cpl[] = {
+  ~{~A__class~^,~%  ~}
+};~2%"
+	  class (sod-class-precedence-list class)))
+
+(defun output-chains-vector (class stream)
+  (let ((chains (sod-class-chains class)))
+    (format stream "~&~:
+~1@*~:{static const SodClass *const ~A__chain_~A[] = {
+~{  ~A__class~^,~%~}
+};~:^~2%~}
+
+~0@*static const struct sod_chain ~A__chains[] = {
+~:{  { ~3@*~A,
+    ~0@*&~A__chain_~A,
+    ~4@*offsetof(struct ~A, ~A),
+    (const struct sod_vtable *)&~A,
+    sizeof(struct ~A) }~:^,~%~}
+};~2%"
+	    class			;0
+	    (mapcar (lambda (chain)	;1
+		      (let* ((head (sod-class-chain-head (car chain)))
+			     (chain-nick (sod-class-nickname head)))
+			(list class chain-nick			    ;0 1
+			      (reverse chain)			    ;2
+			      (length chain)			    ;3
+			      (ilayout-struct-tag class) chain-nick ;4 5
+			      (vtable-name class head)		    ;6
+			      (ichain-struct-tag class head))))	    ;7
+		    chains))))
+
+(defparameter *sod-class-slots*
+  `(
+
+    ;; Basic informtion.
+    ("name" ,(c-type const-string)
+	    :initializer-function
+	    ,(lambda (class)
+	       (prin1-to-string (sod-class-name class))))
+    ("nick" ,(c-type const-string)
+	    :initializer-function
+	    ,(lambda (class)
+	       (prin1-to-string (sod-class-nickname class))))
+
+    ;; Instance allocation and initialization.
+    ("instsz" ,(c-type size-t)
+	      :initializer-function
+	      ,(lambda (class)
+		 (format nil "sizeof(struct ~A)"
+			 (ilayout-struct-tag class))))
+    ("imprint" ,(c-type (* (fun (* void) ("p" (* void)))))
+	       :prepare-function 'output-imprint-function
+	       :initializer-function
+	       ,(lambda (class)
+		  (format nil "~A__imprint" class)))
+    ("init" ,(c-type (* (fun (* void) ("p" (* void)))))
+	    :prepare-function 'output-init-function
+	    :initializer-function
+	    ,(lambda (class)
+	       (format nil "~A__init" class)))
+
+    ;; Superclass structure.
+    ("n_supers" ,(c-type size-t)
+		:initializer-function
+		,(lambda (class)
+		   (length (sod-class-direct-superclasses class))))
+    ("supers" ,(c-type (* (* (class "SodClass" :const) :const)))
+	      :prepare-function 'output-supers-vector
+	      :initializer-function
+	      ,(lambda (class)
+		 (if (sod-class-direct-superclasses class)
+		     (format nil "~A__supers" class)
+		     0)))
+    ("n_cpl" ,(c-type size-t)
+	     :initializer-function
+		,(lambda (class)
+		   (length (sod-class-precedence-list class))))
+    ("cpl" ,(c-type (* (* (class "SodClass" :const) :const)))
+	   :prepare-function 'output-cpl-vector
+	   :initializer-function
+	   ,(lambda (class)
+	      (format nil "~A__cpl" class)))
+
+    ;; Chain structure.
+    ("link" ,(c-type (* (class "SodClass" :const)))
+	    :initializer-function
+	    ,(lambda (class)
+	       (let ((link (sod-class-chain-link class)))
+		 (if link
+		     (format nil "~A__class" link)
+		     0))))
+    ("head" ,(c-type (* (class "SodClass" :const)))
+	    :initializer-function
+	    ,(lambda (class)
+	       (format nil "~A__class" (sod-class-chain-head class))))
+    ("level" ,(c-type size-t)
+	     :initializer-function
+	     ,(lambda (class)
+		(position class (reverse (sod-class-chain class)))))
+    ("n_chains" ,(c-type size-t)
+		:initializer-function
+		,(lambda (class)
+		   (length (sod-class-chains class))))
+    ("chains" ,(c-type (* (struct "sod_chain" :const)))
+	      :prepare-function 'output-chains-vector
+	      :initializer-function
+	      ,(lambda (class)
+		 (format nil "~A__chains" class)))
+
+    ;; Class-specific layout.
+    ("off_islots" ,(c-type size-t)
+		  :initializer-function
+		  ,(lambda (class)
+		     (format nil "offsetof(struct ~A, ~A)"
+			     (ichain-struct-tag class
+						(sod-class-chain-head class))
+			     (sod-class-nickname class))))
+    ("islotsz" ,(c-type size-t)
+	       :initializer-function
+	       ,(lambda (class)
+		  (format nil "sizeof(struct ~A)"
+			  (islots-struct-tag class))))))
+
+(defclass sod-class-slot (sod-slot)
+  ((initializer-function :initarg :initializer-function
+			 :type (or symbol function)
+			 :reader sod-slot-initializer-function)
+   (prepare-function :initarg :prepare-function
+		     :type (or symbol function)
+		     :reader sod-slot-prepare-function))
+  (:documentation
+   "Special class for slots defined on sod_object.
+
+   These slots need class-specific initialization.  It's easier to keep all
+   of the information (name, type, and how to initialize them) about these
+   slots in one place, so that's what we do here."))
+
+(defmethod shared-initialize :after
+    ((slot sod-class-slot) slot-names &key pset)
+  (declare (ignore slot-names))
+  (default-slot (slot 'initializer-function)
+    (get-property pset :initializer-function t nil))
+  (default-slot (slot 'prepare-function)
+    (get-property pset :prepare-function t nil)))
+
+(defclass sod-class-effective-slot (effective-slot)
+  ((initializer-function :initarg :initializer-function
+			 :type (or symbol function)
+			 :reader effective-slot-initializer-function)
+   (prepare-function :initarg :prepare-function
+			 :type (or symbol function)
+			 :reader effective-slot-prepare-function))
+  (:documentation
+   "Special class for slots defined on slot_object.
+
+   This class ignores any explicit initializers and computes initializer
+   values using the slot's INIT-FUNC slot and a magical protocol during
+   metaclass instance construction."))
+
+(defmethod compute-effective-slot ((class sod-class) (slot sod-class-slot))
+  (make-instance 'sod-class-effective-slot
+		 :slot slot
+		 :initializer-function (sod-slot-initializer-function slot)
+		 :prepare-function (sod-slot-prepare-function slot)
+		 :initializer (find-slot-initializer class slot)))
 
 (defun bootstrap-classes ()
-  (let* ((sod-object (make-sod-class "sod_object" nil
+  (let* ((sod-object (make-sod-class "SodObject" nil
 				     (make-property-set :nick 'obj)))
-	 (sod-class (make-sod-class "sod_class" (list sod-object)
+	 (sod-class (make-sod-class "SodClass" (list sod-object)
 				    (make-property-set :nick 'cls)))
 	 (classes (list sod-object sod-class)))
-    (setf (slot-value sod-class 'chained-superclass) sod-object)
+
+    ;; Sort out the recursion.
+    (setf (slot-value sod-class 'chain-link) sod-object)
     (dolist (class classes)
       (setf (slot-value class 'metaclass) sod-class))
+
+    ;; Predeclare the class types.
+    (dolist (class classes)
+      (make-class-type (sod-class-name class)))
+
+    ;; Attach the class slots.
+    (loop for (name type . plist) in *sod-class-slots*
+	  do (make-sod-slot sod-class name type
+			    (apply #'make-property-set
+				   :lisp-class 'sod-class-slot
+				   plist)))
+
+    ;; These classes are too closely intertwined.  We must partially finalize
+    ;; them together by hand.  This is cloned from FINALIZE-SOD-CLASS.
+    (dolist (class classes)
+      (with-slots (class-precedence-list chain-head chain chains) class
+	(setf class-precedence-list (compute-cpl class))
+	(setf (values chain-head chain chains) (compute-chains class))))
+
+    ;; Done.
     (dolist (class classes)
       (finalize-sod-class class)
       (record-sod-class class))))
 
-#|
- (defmacro define-sod-class (name superclasses &body body-and-options)
-  "FIXME.  This probably needs the docstring from hell."
-
-  (let ((class-var (gensym "CLASS"))
-	(slots-var (gensym "SLOTS"))
-	(inst-inits-var (gensym "INST-INITS"))
-	(class-inits-var (gensym "CLASS-INITS"))
-	(messages-var (gensym "MESSAGES"))
-	(methods-var (gensym "METHODS")))
-|#
+;;;--------------------------------------------------------------------------
+;;; Builder macro.
+
+(defmacro define-sod-class (name (&rest superclasses) &body body)
+  (let ((plist nil)
+	(classvar (gensym "CLASS")))
+    (loop
+      (when (or (null body)
+		(not (keywordp (car body))))
+	(return))
+      (push (pop body) plist)
+      (push (pop body) plist))
+    `(let ((,classvar (make-sod-class ,name
+				      (mapcar #'find-sod-class
+					      (list ,@superclasses))
+				      (make-property-set
+				       ,@(nreverse plist)))))
+       (macrolet ((message (name type &rest plist)
+		    `(make-sod-message ,',classvar ,name (c-type ,type)
+				       (make-property-set ,@plist)))
+		  (method (nick name type body &rest plist)
+		    `(make-sod-method ,',classvar ,nick ,name (c-type ,type)
+				      ,body (make-property-set ,@plist)))
+		  (slot (name type &rest plist)
+		    `(make-sod-slot ,',classvar ,name (c-type ,type)
+				    (make-property-set ,@plist)))
+		  (instance-initializer
+		      (nick name value-kind value-form &rest plist)
+		    `(make-sod-instance-initializer ,',classvar ,nick ,name
+						    ,value-kind ,value-form
+						    (make-property-set
+						     ,@plist)))
+		  (class-initializer
+		      (nick name value-kind value-form &rest plist)
+		    `(make-sod-class-initializer ,',classvar ,nick ,name
+						 ,value-kind ,value-form
+						 (make-property-set
+						  ,@plist))))
+	 ,@body
+	 (finalize-sod-class ,classvar)
+	 (record-sod-class ,classvar)))))
+
+#+test
+(define-sod-class "AbstractStack" ("SodObject")
+  :nick 'abstk
+  (message "emptyp" (fun int))
+  (message "push" (fun void ("item" (* void))))
+  (message "pop" (fun (* void)))
+  (method "abstk" "pop" (fun void) #{
+     assert(!me->_vt.emptyp());
+   }
+   :role :before))
 
 ;;;----- That's all, folks --------------------------------------------------
diff --git a/class-defs.lisp b/class-defs.lisp
index 570322b..279af8c 100644
--- a/class-defs.lisp
+++ b/class-defs.lisp
@@ -26,7 +26,7 @@
 (cl:in-package #:sod)
 
 ;;;--------------------------------------------------------------------------
-;;; Class definitions.
+;;; Classes.
 
 (defclass sod-class ()
   ((name :initarg :name
@@ -42,9 +42,9 @@
    (direct-superclasses :initarg :superclasses
 			:type list
 			:reader sod-class-direct-superclasses)
-   (chained-superclass :initarg :chain-to
-		       :type (or sod-class null)
-		       :reader sod-class-chained-superclass)
+   (chain-link :initarg :link
+	       :type (or sod-class null)
+	       :reader sod-class-chain-link)
    (metaclass :initarg :metaclass
 	      :type sod-class
 	      :reader sod-class-metaclass)
@@ -75,13 +75,17 @@
    (chain :type list :accessor sod-class-chain)
    (chains :type list :accessor sod-class-chains)
 
+   (ilayout :type ilayout :accessor sod-class-ilayout)
+   (effective-methods :type list :accessor sod-class-effective-methods)
+   (vtables :type list :accessor sod-class-vtables)
+
    (state :initform nil
 	  :type (member nil :finalized broken)
 	  :accessor sod-class-state))
   (:documentation
    "Classes describe the layout and behaviour of objects.
 
-   The NAME, LOCATION, NICKNAME, DIRECT-SUPERCLASSES, CHAINED-SUPERCLASS and
+   The NAME, LOCATION, NICKNAME, DIRECT-SUPERCLASSES, CHAIN-LINK and
    METACLASS slots are intended to be initialized when the class object is
    constructed:
 
@@ -112,23 +116,22 @@
        precedence list is computed from the DIRECT-SUPERCLASSES lists of all
        of the superclasses involved.
 
-     * The CHAINED-SUPERCLASS is either NIL or one of the
-       DIRECT-SUPERCLASSES.  Class chains are a means for recovering most of
-       the benefits of simple hierarchy lost by the introduction of multiple
-       inheritance.  A class's superclasses (including itself) are
-       partitioned into chains, consisting of a class, its CHAINED-
-       SUPERCLASS, that class's CHAINED-SUPERCLASS, and so on.  It is an
-       error if two direct subclasses of any class appear in the same
-       chain (a global property which requires global knowledge of an entire
-       program's class hierarchy in order to determine sensibly).  Slots of
-       superclasses in the same chain can be accessed efficiently; there is
-       an indirection needed to access slots of superclasses in other chains.
-       Furthermore, an indirection is required to perform a cross-chain
-       conversion (i.e., converting a pointer to an instance of some class
-       into a pointer to an instance of one of its superclasses in a
-       different chain), an operation which occurs implicitly in effective
-       methods in order to call direct methods defined on cross-chain
-       superclasses.
+     * The CHAIN-LINK is either NIL or one of the DIRECT-SUPERCLASSES.  Class
+       chains are a means for recovering most of the benefits of simple
+       hierarchy lost by the introduction of multiple inheritance.  A class's
+       superclasses (including itself) are partitioned into chains,
+       consisting of a class, its CHAIN-LINK superclass, that class's
+       CHAIN-LINK, and so on.  It is an error if two direct subclasses of any
+       class appear in the same chain (a global property which requires
+       global knowledge of an entire program's class hierarchy in order to
+       determine sensibly).  Slots of superclasses in the same chain can be
+       accessed efficiently; there is an indirection needed to access slots
+       of superclasses in other chains.  Furthermore, an indirection is
+       required to perform a cross-chain conversion (i.e., converting a
+       pointer to an instance of some class into a pointer to an instance of
+       one of its superclasses in a different chain), an operation which
+       occurs implicitly in effective methods in order to call direct methods
+       defined on cross-chain superclasses.
 
      * The METACLASS is the class of the class object.  Classes are objects
        in their own right, and therefore must be instances of some class;
@@ -162,11 +165,173 @@
    Other slots are computed from these in order to describe the class's
    layout and effective methods; this is done by FINALIZE-SOD-CLASS.
 
-   FIXME: Add the necessary slots and describe them."))
+     * The CLASS-PRECEDENCE-LIST is a list of superclasses in a linear order.
+       It is computed by the generic function COMPUTE-CLASS-PRECEDENCE-LIST,
+       whose default implementation ensures that the order of superclasses is
+       such that (a) subclasses appear before their superclasses; (b) the
+       direct superclasses of a given class appear in the order in which they
+       were declared by the programmer; and (c) classes always appear in the
+       same relative order in all class precedence lists in the same
+       superclass graph.
+
+     * The CHAIN-HEAD is the least-specific class in the class's chain.  If
+       there is no link class then the CHAIN-HEAD is the class itself.  This
+       slot, like the next two, is computed by the generic function
+       COMPUTE-CHAINS.
+
+     * The CHAIN is the list of classes on the complete primary chain,
+       starting from this class and ending with the CHAIN-HEAD.
+
+     * The CHAINS are the complete collection of chains (most-to-least
+       specific) for the class and all of its superclasses.
+
+     * The ILAYOUT describes the layout for an instance of the class.  It's
+       quite complicated; see the documentation of the ILAYOUT class for
+       detais.
+
+     * The EFFECTIVE-METHODS are a list of effective methods, specialized for
+       the class.
+
+     * The VTABLES are a list of descriptions of vtables for the class.  The
+       individual elements are VTABLE objects, which are even more
+       complicated than ILAYOUT structures.  See the class documentation for
+       details."))
 
 (defmethod print-object ((class sod-class) stream)
-  (print-unreadable-object (class stream :type t)
-    (prin1 (sod-class-name class) stream)))
+  (maybe-print-unreadable-object (class stream :type t)
+    (princ (sod-class-name class) stream)))
+
+;;;--------------------------------------------------------------------------
+;;; Slots and initializers.
+
+(defclass sod-slot ()
+  ((name :initarg :name
+	 :type string
+	 :reader sod-slot-name)
+   (location :initarg :location
+	     :initform (file-location nil)
+	     :type file-location
+	     :reader file-location)
+   (class :initarg :class
+	  :type sod-class
+	  :reader sod-slot-class)
+   (type :initarg :type
+	 :type c-type
+	 :reader sod-slot-type))
+  (:documentation
+   "Slots are units of information storage in instances.
+
+   Each class defines a number of slots, which function similarly to (data)
+   members in structures.  An instance contains all of the slots defined in
+   its class and all of its superclasses.
+
+   A slot carries the following information.
+
+     * A NAME, which distinguishes it from other slots defined by the same
+       class.  Unlike most (all?) other object systems, slots defined in
+       different classes are in distinct namespaces.  There are no special
+       restrictions on slot names.
+
+     * A LOCATION, which states where in the user's source the slot was
+       defined.  This gets used in error messages.
+
+     * A CLASS, which states which class defined the slot.  The slot is
+       available in instances of this class and all of its descendents.
+
+     * A TYPE, which is the C type of the slot.  This must be an object type
+       (certainly not a function type, and it must be a complete type by the
+       time that the user header code has been scanned)."))
+
+(defmethod print-object ((slot sod-slot) stream)
+  (maybe-print-unreadable-object (slot stream :type t)
+    (pprint-c-type (sod-slot-type slot) stream
+		   (format nil "~A.~A"
+			   (sod-class-nickname (sod-slot-class slot))
+			   (sod-slot-name slot)))))
+
+(defclass sod-initializer ()
+  ((slot :initarg :slot
+	 :type sod-slot
+	 :reader sod-initializer-slot)
+   (location :initarg :location
+	     :initform (file-location nil)
+	     :type file-location
+	     :reader file-location)
+   (class :initarg :class
+	  :type sod-class
+	  :reader sod-initializer-clas)
+   (value-kind :initarg :value-kind
+	       :type keyword
+	       :reader sod-initializer-value-kind)
+   (value-form :initarg :value-form
+	       :type c-fragment
+	       :reader sod-initializer-value-form))
+  (:documentation
+   "Provides an initial value for a slot.
+
+   The slots of an initializer are as follows.
+
+     * The SLOT specifies which slot this initializer is meant to initialize.
+
+     * The LOCATION states the position in the user's source file where the
+       initializer was found.  This gets used in error messages.  (Depending
+       on the source layout style, this might differ from the location in the
+       VALUE-FORM C fragment.)
+
+     * The CLASS states which class defined this initializer.  For instance
+       slot initializers (SOD-INSTANCE-INITIALIZER), this will be the same as
+       the SLOT's class, or be one of its descendants.  For class slot
+       initializers (SOD-CLASS-INITIALIZER), this will be an instance of the
+       SLOT's class, or an instance of one of its descendants.
+
+     * The VALUE-KIND states what manner of initializer we have.  It can be
+       either :SINGLE, indicating a standalone expression, or :COMPOUND,
+       indicating a compound initializer which must be surrounded by braces
+       on output.
+
+     * The VALUE-FORM gives the text of the initializer, as a C fragment.
+
+   Typically you'll see instances of subclasses of this class in the wild
+   rather than instances of this class directly.  See SOD-CLASS-INITIALIZER
+   and SOD-INSTANCE-INITIALIZER."))
+
+(defmethod print-object ((initializer sod-initializer) stream)
+  (if *print-escape*
+      (print-unreadable-object (initializer stream :type t)
+	(format stream "~A = ~A"
+		(sod-initializer-slot initializer)
+		initializer))
+      (format stream "~:[{~A}~;~A~]"
+	      (eq (sod-initializer-value-kind initializer) :single)
+	      (sod-initializer-value-form initializer))))
+
+(defclass sod-class-initializer (sod-initializer)
+  ()
+  (:documentation
+   "Provides an initial value for a class slot.
+
+   A class slot initializer provides an initial value for a slot in the class
+   object (i.e., one of the slots defined by the class's metaclass).  Its
+   VALUE-FORM must have the syntax of an initializer, and its consituent
+   expressions must be constant expressions.
+
+   See SOD-INITIALIZER for more details."))
+
+(defclass sod-instance-initializer (sod-initializer)
+  ()
+  (:documentation
+   "Provides an initial value for a slot in all instances.
+
+   An instance slot initializer provides an initial value for a slot in
+   instances of the class.  Its VALUE-FORM must have the syntax of an
+   initializer.  Furthermore, if the slot has aggregate type, then you'd
+   better be sure that your compiler supports compound literals (6.5.2.5)
+   because that's what the initializer gets turned into.
+
+   See SOD-INITIALIZER for more details."))
+
+;;;--------------------------------------------------------------------------
+;;; Messages and methods.
 
 (defclass sod-message ()
   ((name :initarg :name
@@ -219,6 +384,13 @@
 
    Subclasses can (and probably will) define additional slots."))
 
+(defmethod print-object ((message sod-message) stream)
+  (maybe-print-unreadable-object (message stream :type t)
+    (pprint-c-type (sod-message-type message) stream
+		   (format nil "~A.~A"
+			   (sod-class-nickname (sod-message-class message))
+			   (sod-message-name message)))))
+
 (defclass sod-method ()
   ((message :initarg :message
 	    :type sod-message
@@ -294,114 +466,11 @@
    subclasses of SOD-METHOD in order to carry the additional metadata they
    need to keep track of."))
 
-(defclass sod-slot ()
-  ((name :initarg :name
-	 :type string
-	 :reader sod-slot-name)
-   (location :initarg :location
-	     :initform (file-location nil)
-	     :type file-location
-	     :reader file-location)
-   (class :initarg :class
-	  :type sod-class
-	  :reader sod-slot-class)
-   (type :initarg :type
-	 :type c-type
-	 :reader sod-slot-type))
-  (:documentation
-   "Slots are units of information storage in instances.
-
-   Each class defines a number of slots, which function similarly to (data)
-   members in structures.  An instance contains all of the slots defined in
-   its class and all of its superclasses.
-
-   A slot carries the following information.
-
-     * A NAME, which distinguishes it from other slots defined by the same
-       class.  Unlike most (all?) other object systems, slots defined in
-       different classes are in distinct namespaces.  There are no special
-       restrictions on slot names.
-
-     * A LOCATION, which states where in the user's source the slot was
-       defined.  This gets used in error messages.
-
-     * A CLASS, which states which class defined the slot.  The slot is
-       available in instances of this class and all of its descendents.
-
-     * A TYPE, which is the C type of the slot.  This must be an object type
-       (certainly not a function type, and it must be a complete type by the
-       time that the user header code has been scanned)."))
-
-(defclass sod-initializer ()
-  ((slot :initarg :slot
-	 :type sod-slot
-	 :reader sod-initializer-slot)
-   (location :initarg :location
-	     :initform (file-location nil)
-	     :type file-location
-	     :reader file-location)
-   (class :initarg :class
-	  :type sod-class
-	  :reader sod-initializer-clas)
-   (value-kind :initarg :value-kind
-	       :type keyword
-	       :reader sod-initializer-value-kind)
-   (value-form :initarg :value-form
-	       :type c-fragment
-	       :reader sod-initializer-value-form))
-  (:documentation
-   "Provides an initial value for a slot.
-
-   The slots of an initializer are as follows.
-
-     * The SLOT specifies which slot this initializer is meant to initialize.
-
-     * The LOCATION states the position in the user's source file where the
-       initializer was found.  This gets used in error messages.  (Depending
-       on the source layout style, this might differ from the location in the
-       VALUE-FORM C fragment.)
-
-     * The CLASS states which class defined this initializer.  For instance
-       slot initializers (SOD-INSTANCE-INITIALIZER), this will be the same as
-       the SLOT's class, or be one of its descendants.  For class slot
-       initializers (SOD-CLASS-INITIALIZER), this will be an instance of the
-       SLOT's class, or an instance of one of its descendants.
-
-     * The VALUE-KIND states what manner of initializer we have.  It can be
-       either :SINGLE, indicating a standalone expression, or :COMPOUND,
-       indicating a compound initializer which must be surrounded by braces
-       on output.
-
-     * The VALUE-FORM gives the text of the initializer, as a C fragment.
-
-   Typically you'll see instances of subclasses of this class in the wild
-   rather than instances of this class directly.  See SOD-CLASS-INITIALIZER
-   and SOD-INSTANCE-INITIALIZER."))
-
-(defclass sod-class-initializer (sod-initializer)
-  ()
-  (:documentation
-   "Provides an initial value for a class slot.
-
-   A class slot initializer provides an initial value for a slot in the class
-   object (i.e., one of the slots defined by the class's metaclass).  Its
-   VALUE-FORM must have the syntax of an initializer, and its consituent
-   expressions must be constant expressions.
-
-   See SOD-INITIALIZER for more details."))
-
-(defclass sod-instance-initializer (sod-initializer)
-  ()
-  (:documentation
-   "Provides an initial value for a slot in all instances.
-
-   An instance slot initializer provides an initial value for a slot in
-   instances of the class.  Its VALUE-FORM must have the syntax of an
-   initializer.  Furthermore, if the slot has aggregate type, then you'd
-   better be sure that your compiler supports compound literals (6.5.2.5)
-   because that's what the initializer gets turned into.
-
-   See SOD-INITIALIZER for more details."))
+(defmethod print-object ((method sod-method) stream)
+  (maybe-print-unreadable-object (method stream :type t)
+    (format stream "~A ~@_~A"
+	    (sod-method-message method)
+	    (sod-method-class method))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Classes as C types.
@@ -431,7 +500,9 @@
 
 (defmethod print-c-type (stream (type c-class-type) &optional colon atsign)
   (declare (ignore colon atsign))
-  (format stream "~:@<CLASS ~@_~S~:>" (c-type-name type)))
+  (format stream "~:@<CLASS ~@_~S~{ ~_~S~}~:>"
+	  (c-type-name type)
+	  (c-type-qualifiers type)))
 
 (defun find-class-type (name &optional floc)
   "Look up NAME and return the corresponding C-CLASS-TYPE.
@@ -455,18 +526,19 @@
   "Return a class type for NAME, creating it if necessary.
 
    FLOC is the location to use in error reports."
-  (multiple-value-bind (type winp) (find-class-type name floc)
-    (cond ((not winp) nil)
-	  (type type)
-	  (t (setf (gethash name *type-map*)
-		   (make-instance 'c-class-type :name name :class nil))))))
+  (let ((name (etypecase name
+		(sod-class (sod-class-name name))
+		(string name))))
+    (or (find-class-type name floc)
+	(setf (gethash name *type-map*)
+	      (make-instance 'c-class-type :name name :class nil)))))
 
 (defun find-sod-class (name &optional floc)
   "Return the SOD-CLASS object with the given NAME.
 
    FLOC is the location to use in error reports."
   (with-default-error-location (floc)
-    (multiple-value-bind (type winp) (find-class-type name floc)
+    (let ((type (find-class-type name floc)))
       (cond ((not type) (error "Type `~A' not known" name))
 	    (t (let ((class (c-type-class type)))
 		 (unless class
@@ -487,226 +559,14 @@
 	    (t
 	     (setf (c-type-class type) class))))))
 
-(define-c-type-syntax class (name)
-  "Returns a type object for the named class."
-  (make-class-type (c-name-case name)))
-
-;;;--------------------------------------------------------------------------
-;;; Class finalization.
-
-;; Protocol.
-
-(defgeneric compute-chains (class)
-  (:documentation
-   "Compute the layout chains for CLASS.
-
-   Fills in
+(defun sod-class-type (class)
+  "Returns the C type corresponding to CLASS."
+  (find-class-type (sod-class-name class)))
 
-     * the head of the class's primary chain;
-
-     * the class's primary chain as a list, most- to least-specific; and
-
-     * the complete collection of chains, as a list of lists, each most- to
-       least-specific, with the primary chain first.
-
-   If the chains are ill-formed (i.e., not distinct) then an error is
-   reported and the function returns nil; otherwise it returns a true
-   value."))
-
-(defgeneric check-sod-class (class)
-  (:documentation
-   "Check the CLASS for validity.
-
-   This is done as part of class finalization.  The checks performed are as
-   follows.
-
-     * The class name and nickname, and the names of messages, obey the
-       rules (see VALID-NAME-P).
-
-     * The messages and slots have distinct names.
-
-     * The classes in the class-precedence-list have distinct nicknames.
-
-     * The chained-superclass is actually one of the direct superclasses.
-
-     * The chosen metaclass is actually a subclass of all of the
-       superclasses' metaclasses.
-
-   Returns true if all is well; false (and signals errors) if anything was
-   wrong."))
-
-(defgeneric finalize-sod-class (class)
-  (:documentation
-   "Computes all of the gory details about a class.
-
-   Once one has stopped inserting methods and slots and so on into a class,
-   one needs to finalize it to determine the layout structure and the class
-   precedence list and so on.  More precisely that gets done is this:
-
-     * Related classes (i.e., direct superclasses and the metaclass) are
-       finalized if they haven't been already.
-
-     * If you've been naughty and failed to store a list of slots or
-       whatever, then an empty list is inserted.
-
-     * The class precedence list is computed and stored.
-
-     * The class is checked for compiance with the well-formedness rules.
-
-     * The layout chains are computed.
-
-   Other stuff will need to happen later, but it's not been done yet.  In
-   particular:
-
-     * Actually computing the layout of the instance and the virtual tables.
-
-     * Combining the applicable methods into effective methods.
-
-   FIXME this needs doing."))
-
-;; Implementation.
-
-(defmethod compute-chains ((class sod-class))
-  (with-default-error-location (class)
-    (let* ((head (with-slots (chained-superclass) class
-		   (if chained-superclass
-		       (sod-class-chain-head chained-superclass)
-		       class)))
-	   (chain (with-slots (chained-superclass) class
-		    (cons class (and chained-superclass
-				     (sod-class-chain chained-superclass)))))
-	   (chains (list chain)))
-
-      ;; Compute the chains.  This is (unsurprisingly) the hard bit.  The
-      ;; chain of this class must either be a new chain or the same as one of
-      ;; its superclasses.  Therefore, the chains are well-formed if the
-      ;; chains of the superclasses are distinct.  We can therefore scan the
-      ;; direct superclasses from left to right as follows.
-      (with-slots (direct-superclasses) class
-	(let ((table (make-hash-table)))
-	  (dolist (super direct-superclasses)
-	    (let* ((head (sod-class-chain-head super))
-		   (tail (gethash head table)))
-	      (cond ((not tail)
-		     (setf (gethash head table) super))
-		    ((not (sod-subclass-p super tail))
-		     (error "Conflicting chains (~A and ~A) in class ~A"
-			    (sod-class-name tail)
-			    (sod-class-name super)
-			    (sod-class-name class)))
-		    (t
-		     (let ((ch (sod-class-chain super)))
-		       (unless (eq ch chain)
-			 (push ch chains)))))))))
-
-      ;; Done.
-      (values head chain (nreverse chains)))))
-
-(defmethod check-sod-class ((class sod-class))
-  (with-default-error-location (class)
-
-    ;; Check the names of things are valid.
-    (with-slots (name nickname messages) class
-      (unless (valid-name-p name)
-	(error "Invalid class name `~A'" name))
-      (unless (valid-name-p nickname)
-	(error "Invalid class nickname `~A' on class `~A'" nickname name))
-      (dolist (message messages)
-	(unless (valid-name-p (sod-message-name message))
-	  (error "Invalid message name `~A' on class `~A'"
-		 (sod-message-name message) name))))
-
-      ;; Check that the slots and messages have distinct names.
-    (with-slots (name slots messages class-precedence-list) class
-      (flet ((check-list (list what namefunc)
-	       (let ((table (make-hash-table :test #'equal)))
-		 (dolist (item list)
-		   (let ((itemname (funcall namefunc item)))
-		     (if (gethash itemname table)
-			 (error "Duplicate ~A name `~A' on class `~A'"
-				what itemname name)
-			 (setf (gethash itemname table) item)))))))
-	(check-list slots "slot" #'sod-slot-name)
-	(check-list messages "message" #'sod-message-name)
-	(check-list class-precedence-list "nickname" #'sod-class-name)))
-
-    ;; Check that the CHAIN-TO class is actually a superclass.
-    (with-slots (name direct-superclasses chained-superclass) class
-      (unless (or (not chained-superclass)
-		  (member chained-superclass direct-superclasses))
-	(error "In `~A~, chain-to class `~A' is not a direct superclass"
-	       name (sod-class-name chained-superclass))))
-
-    ;; Check that the metaclass is a subclass of each of the
-    ;; superclasses' metaclasses.
-    (with-slots (name metaclass direct-superclasses) class
-      (dolist (super direct-superclasses)
-	(unless (sod-subclass-p metaclass (sod-class-metaclass super))
-	  (error "Incompatible metaclass for `~A': ~
-		  `~A' isn't subclass of `~A' (of `~A')"
-	   name
-	   (sod-class-name metaclass)
-	   (sod-class-name (sod-class-metaclass super))
-	   (sod-class-name super)))))))
-
-(defmethod finalize-sod-class ((class sod-class))
-  (with-default-error-location (class)
-    (ecase (sod-class-state class)
-      ((nil)
-
-       ;; If this fails, mark the class as a loss.
-       (setf (sod-class-state class) :broken)
-
-       ;; Finalize all of the superclasses.  There's some special pleading
-       ;; here to make bootstrapping work: we don't try to finalize the
-       ;; metaclass if we're a root class (no direct superclasses -- because
-       ;; in that case the metaclass will have to be a subclass of us!), or
-       ;; if it's equal to us.  This is enough to tie the knot at the top of
-       ;; the class graph.
-       (with-slots (name direct-superclasses metaclass) class
-	 (dolist (super direct-superclasses)
-	   (finalize-sod-class super))
-	 (unless (or (null direct-superclasses)
-		     (eq class metaclass))
-	   (finalize-sod-class metaclass)))
-
-       ;; Clobber the lists of items if they've not been set.
-       (dolist (slot '(slots instance-initializers class-initializers
-		       messages methods))
-	 (unless (slot-boundp class slot)
-	   (setf (slot-value class slot) nil)))
-
-       ;; If the CPL hasn't been done yet, compute it.
-       (with-slots (class-precedence-list) class
-	 (unless (slot-boundp class 'class-precedence-list)
-	   (setf class-precedence-list (compute-cpl class))))
-
-       ;; If no metaclass has been established, then choose one.
-       (with-slots (metaclass) class
-	 (unless (and (slot-boundp class 'metaclass) metaclass)
-	   (setf metaclass (guess-metaclass class))))
-
-       ;; If no nickname has been set, choose a default.  This might cause
-       ;; conflicts, but, well, the user should have chosen an explicit
-       ;; nickname.
-       (with-slots (name nickname) class
-	 (unless (and (slot-boundp class 'nickname) nickname)
-	   (setf nickname (string-downcase name))))
-
-       ;; Check that the class is fairly sane.
-       (check-sod-class class)
-
-       ;; Determine the class's layout.
-       (compute-chains class)
-
-       ;; Done.
-       (setf (sod-class-state class) :finalized)
-       t)
-
-      (:broken
-       nil)
-
-      (:finalized
-       t))))
+(define-c-type-syntax class (name &rest quals)
+  "Returns a type object for the named class."
+  (if quals
+      `(qualify-type (make-class-type ,name) (list ,@quals))
+      `(make-class-type ,name)))
 
 ;;;----- That's all, folks --------------------------------------------------
diff --git a/class-finalize.lisp b/class-finalize.lisp
new file mode 100644
index 0000000..cf1ff73
--- /dev/null
+++ b/class-finalize.lisp
@@ -0,0 +1,274 @@
+;;; -*-lisp-*-
+;;;
+;;; Class finalization
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Simple Object Definition system.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Class finalization.
+
+;; Protocol.
+
+(defgeneric compute-chains (class)
+  (:documentation
+   "Compute the layout chains for CLASS.
+
+   Returns the following three values.
+
+     * the head of the class's primary chain;
+
+     * the class's primary chain as a list, most- to least-specific; and
+
+     * the complete collection of chains, as a list of lists, each most- to
+       least-specific, with the primary chain first.
+
+   These values will be stored in the CHAIN-HEAD, CHAIN and CHAINS slots.
+
+   If the chains are ill-formed (i.e., not distinct) then an error is
+   signalled."))
+
+(defgeneric check-sod-class (class)
+  (:documentation
+   "Check the CLASS for validity.
+
+   This is done as part of class finalization.  The checks performed are as
+   follows.
+
+     * The class name and nickname, and the names of messages, obey the
+       rules (see VALID-NAME-P).
+
+     * The messages and slots have distinct names.
+
+     * The classes in the class-precedence-list have distinct nicknames.
+
+     * The chain-link is actually a proper (though not necessarily direct)
+       superclass.
+
+     * The chosen metaclass is actually a subclass of all of the
+       superclasses' metaclasses.
+
+   Returns true if all is well; false (and signals errors) if anything was
+   wrong."))
+
+(defgeneric finalize-sod-class (class)
+  (:documentation
+   "Computes all of the gory details about a class.
+
+   Once one has stopped inserting methods and slots and so on into a class,
+   one needs to finalize it to determine the layout structure and the class
+   precedence list and so on.  More precisely that gets done is this:
+
+     * Related classes (i.e., direct superclasses and the metaclass) are
+       finalized if they haven't been already.
+
+     * If you've been naughty and failed to store a list of slots or
+       whatever, then an empty list is inserted.
+
+     * The class precedence list is computed and stored.
+
+     * The class is checked for compiance with the well-formedness rules.
+
+     * The layout chains are computed.
+
+   Other stuff will need to happen later, but it's not been done yet.  In
+   particular:
+
+     * Actually computing the layout of the instance and the virtual tables.
+
+     * Combining the applicable methods into effective methods.
+
+   FIXME this needs doing."))
+
+;; Implementation.
+
+(defun sod-subclass-p (class-a class-b)
+  "Return whether CLASS-A is a descendent of CLASS-B."
+  (member class-b (sod-class-precedence-list class-a)))
+
+(defun valid-name-p (name)
+  "Checks whether NAME is a valid name.
+
+   The rules are:
+
+     * the name must be a string
+     * which is nonempty
+     * whose first character is alphabetic
+     * all of whose characters are alphanumeric or underscores
+     * and which doesn't contain two consecutive underscores."
+
+  (and (stringp name)
+       (plusp (length name))
+       (alpha-char-p (char name 0))
+       (every (lambda (ch) (or (alphanumericp ch) (char= ch #\_))) name)
+       (not (search "__" name))))
+
+(defmethod compute-chains ((class sod-class))
+  (with-default-error-location (class)
+    (with-slots (chain-link class-precedence-list) class
+      (let* ((head (if chain-link
+		       (sod-class-chain-head chain-link)
+		       class))
+	     (chain (cons class (and chain-link
+				     (sod-class-chain chain-link))))
+	     (table (make-hash-table)))
+
+	;; Check the chains.  We work through each superclass, maintaining a
+	;; hash table keyed by class.  If we encounter a class C which links
+	;; to L, then we store C as L's value; if L already has a value then
+	;; we've found an error.  By the end of all of this, the classes
+	;; which don't have an entry are the chain tails.
+	(dolist (super class-precedence-list)
+	  (let ((link (sod-class-chain-link super)))
+	    (when link
+	      (when (gethash link table)
+		(error "Conflicting chains in class ~A: ~
+			(~A and ~A both link to ~A)"
+		       class super (gethash link table) link))
+	      (setf (gethash link table) super))))
+
+	;; Done.
+	(values head chain
+		(cons chain
+		      (mapcar #'sod-class-chain
+			      (remove-if (lambda (super)
+					   (gethash super table))
+					 (cdr class-precedence-list)))))))))
+
+(defmethod check-sod-class ((class sod-class))
+  (with-default-error-location (class)
+
+    ;; Check the names of things are valid.
+    (with-slots (name nickname messages) class
+      (unless (valid-name-p name)
+	(error "Invalid class name `~A'" class))
+      (unless (valid-name-p nickname)
+	(error "Invalid class nickname `~A' on class `~A'" nickname class))
+      (dolist (message messages)
+	(unless (valid-name-p (sod-message-name message))
+	  (error "Invalid message name `~A' on class `~A'"
+		 (sod-message-name message) class))))
+
+      ;; Check that the slots and messages have distinct names.
+    (with-slots (slots messages class-precedence-list) class
+      (flet ((check-list (list what namefunc)
+	       (let ((table (make-hash-table :test #'equal)))
+		 (dolist (item list)
+		   (let ((name (funcall namefunc item)))
+		     (if (gethash name table)
+			 (error "Duplicate ~A name `~A' on class `~A'"
+				what name class)
+			 (setf (gethash name table) item)))))))
+	(check-list slots "slot" #'sod-slot-name)
+	(check-list messages "message" #'sod-message-name)
+	(check-list class-precedence-list "nickname" #'sod-class-name)))
+
+    ;; Check that the CHAIN-TO class is actually a proper superclass.  (This
+    ;; eliminates hairy things like a class being its own link.)
+    (with-slots (class-precedence-list chain-link) class
+      (unless (or (not chain-link)
+		  (member chain-link (cdr class-precedence-list)))
+	(error "In `~A~, chain-to class `~A' is not a proper superclass"
+	       class chain-link)))
+
+    ;; Check that the metaclass is a subclass of each direct superclass's
+    ;; metaclass.
+    (with-slots (metaclass direct-superclasses) class
+      (dolist (super direct-superclasses)
+	(unless (sod-subclass-p metaclass (sod-class-metaclass super))
+	  (error "Incompatible metaclass for `~A': ~
+		  `~A' isn't a subclass of `~A' (of `~A')"
+		 class metaclass (sod-class-metaclass super) super))))))
+
+(defmethod finalize-sod-class ((class sod-class))
+
+  ;; CLONE-AND-HACK WARNING: Note that BOOTSTRAP-CLASSES has a (very brief)
+  ;; clone of the CPL and chain establishment code.  If the interface changes
+  ;; then BOOTSTRAP-CLASSES will need to be changed too.
+
+  (with-default-error-location (class)
+    (ecase (sod-class-state class)
+      ((nil)
+
+       ;; If this fails, mark the class as a loss.
+       (setf (sod-class-state class) :broken)
+
+       ;; Finalize all of the superclasses.  There's some special pleading
+       ;; here to make bootstrapping work: we don't try to finalize the
+       ;; metaclass if we're a root class (no direct superclasses -- because
+       ;; in that case the metaclass will have to be a subclass of us!), or
+       ;; if it's equal to us.  This is enough to tie the knot at the top of
+       ;; the class graph.
+       (with-slots (name direct-superclasses metaclass) class
+	 (dolist (super direct-superclasses)
+	   (finalize-sod-class super))
+	 (unless (or (null direct-superclasses)
+		     (eq class metaclass))
+	   (finalize-sod-class metaclass)))
+
+       ;; Clobber the lists of items if they've not been set.
+       (dolist (slot '(slots instance-initializers class-initializers
+		       messages methods))
+	 (unless (slot-boundp class slot)
+	   (setf (slot-value class slot) nil)))
+
+       ;; If the CPL hasn't been done yet, compute it.
+       (with-slots (class-precedence-list) class
+	 (unless (slot-boundp class 'class-precedence-list)
+	   (setf class-precedence-list (compute-cpl class))))
+
+       ;; If no metaclass has been established, then choose one.
+       (with-slots (metaclass) class
+	 (unless (and (slot-boundp class 'metaclass) metaclass)
+	   (setf metaclass (guess-metaclass class))))
+
+       ;; If no nickname has been set, choose a default.  This might cause
+       ;; conflicts, but, well, the user should have chosen an explicit
+       ;; nickname.
+       (with-slots (name nickname) class
+	 (unless (and (slot-boundp class 'nickname) nickname)
+	   (setf nickname (string-downcase name))))
+
+       ;; Check that the class is fairly sane.
+       (check-sod-class class)
+
+       ;; Determine the class's layout.
+       (with-slots (chain-head chain chains) class
+	 (setf (values chain-head chain chains) (compute-chains class)))
+
+       (with-slots (ilayout effective-methods vtables) class
+	 (setf ilayout (compute-ilayout class))
+	 (setf effective-methods (compute-effective-methods class))
+	 (setf vtables (compute-vtables class)))
+
+       ;; Done.
+       (setf (sod-class-state class) :finalized)
+       t)
+
+      (:broken
+       nil)
+
+      (:finalized
+       t))))
+
+;;;----- That's all, folks --------------------------------------------------
diff --git a/class-layout.lisp b/class-layout.lisp
new file mode 100644
index 0000000..d342e5e
--- /dev/null
+++ b/class-layout.lisp
@@ -0,0 +1,639 @@
+;;; -*-lisp-*-
+;;;
+;;; Layout for instances and vtables
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Simple Object Definition system.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Effective slot objects.
+
+(defclass effective-slot ()
+  ((class :initarg :class :type sod-slot :reader effective-slot-class)
+   (slot :initarg :slot :type sod-slot :reader effective-slot-direct-slot)
+   (initializer :initarg :initializer
+		:type (or sod-initializer null)
+		:reader effective-slot-initializer))
+  (:documentation
+   "Describes a slot and how it's meant to be initialized.
+
+   Effective slot objects are usually attached to layouts."))
+
+(defgeneric find-slot-initializer (class slot)
+  (:documentation
+   "Return the most specific initializer for SLOT, starting from CLASS."))
+
+(defgeneric compute-effective-slot (class slot)
+  (:documentation
+   "Construct an effective slot from the supplied direct slot.
+
+   SLOT is a direct slot defined on CLASS or one of its superclasses.
+   (Metaclass initializers are handled using a different mechanism.)"))
+
+(defmethod print-object ((slot effective-slot) stream)
+  (maybe-print-unreadable-object (slot stream :type t)
+    (format stream "~A~@[ = ~@_~A~]"
+	    (effective-slot-direct-slot slot)
+	    (effective-slot-initializer slot))))
+
+(defmethod find-slot-initializer ((class sod-class) (slot sod-slot))
+  (some (lambda (super)
+	  (find slot
+		(sod-class-instance-initializers super)
+		:key #'sod-initializer-slot))
+	(sod-class-precedence-list class)))
+
+(defmethod compute-effective-slot ((class sod-class) (slot sod-slot))
+  (make-instance 'effective-slot
+		 :slot slot
+		 :class class
+		 :initializer (find-slot-initializer class slot)))
+
+;;;--------------------------------------------------------------------------
+;;; Instance layout objects.
+
+;;; islots
+
+(defclass islots ()
+  ((class :initarg :class :type sod-class :reader islots-class)
+   (subclass :initarg :subclass :type sod-class :reader islots-subclass)
+   (slots :initarg :slots :type list :reader islots-slots))
+  (:documentation
+   "The collection of effective SLOTS defined by an instance of CLASS."))
+
+(defmethod print-object ((islots islots) stream)
+  (print-unreadable-object (islots stream :type t)
+    (format stream "~A <= ~A ~_~:<~@{~S~^ ~_~}~:>"
+	    (islots-subclass islots)
+	    (islots-class islots)
+	    (islots-slots islots))))
+
+(defgeneric compute-islots (class subclass)
+  (:documentation
+   "Return ISLOTS containing EFFECTIVE-SLOTs for a particular CLASS.
+
+   Initializers for the slots should be taken from the most specific
+   superclass of SUBCLASS."))
+
+;;; vtable-pointer
+
+(defclass vtable-pointer ()
+  ((class :initarg :class :type sod-class :reader vtable-pointer-class)
+   (chain-head :initarg :chain-head
+	       :type sod-class
+	       :reader vtable-pointer-chain-head))
+  (:documentation
+   "A pointer to the vtable for CLASS corresponding to a particular CHAIN."))
+
+(defmethod print-object ((vtp vtable-pointer) stream)
+  (print-unreadable-object (vtp stream :type t)
+    (format stream "~A:~A"
+	    (vtable-pointer-class vtp)
+	    (sod-class-nickname (vtable-pointer-chain-head vtp)))))
+
+;;; ichain
+
+(defclass ichain ()
+  ((class :initarg :class :type sod-class :reader ichain-class)
+   (chain-head :initarg :chain-head :type sod-class :reader ichain-head)
+   (body :initarg :body :type list :reader ichain-body))
+  (:documentation
+   "All of the instance layout for CLASS corresponding to a particular CHAIN.
+
+   The BODY is a list of things to include in the finished structure.  By
+   default, it contains a VTABLE-POINTER and ISLOTS for each class in the
+   chain."))
+
+(defmethod print-object ((ichain ichain) stream)
+  (print-unreadable-object (ichain stream :type t)
+    (format stream "~A:~A ~_~:<~@{~S~^ ~_~}~:>"
+	    (ichain-class ichain)
+	    (sod-class-nickname (ichain-head ichain))
+	    (ichain-body ichain))))
+
+(defgeneric compute-ichain (class chain)
+  (:documentation
+   "Return an ICHAIN for a particular CHAIN of CLASS's superclasses.
+
+   The CHAIN is a list of classes, with the least specific first -- so the
+   chain head is the first element."))
+
+;;; ilayout
+
+(defclass ilayout ()
+  ((class :initarg :class :type sod-class :reader ilayout-class)
+   (ichains :initarg :ichains :type list :reader ilayout-ichains))
+  (:documentation
+   "All of the instance layout for a CLASS.
+
+   Consists of an ICHAIN for each distinct chain."))
+
+(defmethod print-object ((ilayout ilayout) stream)
+  (print-unreadable-object (ilayout stream :type t)
+    (format stream "~A ~_~:<~@{~S~^ ~_~}~:>"
+	    (ilayout-class ilayout)
+	    (ilayout-ichains ilayout))))
+
+(defgeneric compute-ilayout (class)
+  (:documentation
+   "Compute and return an instance layout for CLASS."))
+
+;;; Standard implementation.
+
+(defmethod compute-islots ((class sod-class) (subclass sod-class))
+  (make-instance 'islots
+		 :class class
+		 :subclass subclass
+		 :slots (mapcar (lambda (slot)
+				  (compute-effective-slot subclass slot))
+				(sod-class-slots class))))
+
+(defmethod compute-ichain ((class sod-class) chain)
+  (let* ((head (car chain))
+	 (vtable-pointer (make-instance 'vtable-pointer
+					:class class
+					:chain-head head))
+	 (islots (remove-if-not #'islots-slots
+				(mapcar (lambda (super)
+					  (compute-islots super class))
+					chain))))
+    (make-instance 'ichain
+		   :class class
+		   :chain-head head
+		   :body (cons vtable-pointer islots))))
+
+(defmethod compute-ilayout ((class sod-class))
+  (make-instance 'ilayout
+		 :class class
+		 :ichains (mapcar (lambda (chain)
+				    (compute-ichain class
+						    (reverse chain)))
+				  (sod-class-chains class))))
+
+;;;--------------------------------------------------------------------------
+;;; Effective methods.
+
+(defclass effective-method ()
+  ((message :initarg :message
+	    :type sod-message
+	    :reader effective-method-message)
+   (class :initarg :class
+	  :type sod-class
+	  :reader effective-method-class))
+  (:documentation
+   "The effective method invoked by sending MESSAGE to an instance of CLASS.
+
+   This is not a useful class by itself.  Message classes are expected to
+   define their own effective-method classes.
+
+   An effective method class must accept a :DIRECT-METHODS initarg, which
+   will be a list of applicable methods sorted in most-to-least specific
+   order."))
+
+(defmethod print-object ((method effective-method) stream)
+  (maybe-print-unreadable-object (method stream :type t)
+    (format stream "~A ~A"
+	    (effective-method-message method)
+	    (effective-method-class method))))
+
+(defgeneric message-effective-method-class (message)
+  (:documentation
+   "Return the effective method class for the given MESSAGE."))
+
+(defgeneric compute-sod-effective-method (message class)
+  (:documentation
+   "Return the effective method when a CLASS instance receives MESSAGE.
+
+   The default method constructs an instance of the message's chosen
+   MESSAGE-EFFECTIVE-METHOD-CLASS, passing the MESSAGE, the CLASS and the
+   list of applicable methods as initargs to MAKE-INSTANCE."))
+
+(defmethod compute-sod-effective-method
+    ((message sod-message) (class sod-class))
+  (let ((direct-methods (mapcan (lambda (super)
+				  (let ((method
+					 (find message
+					       (sod-class-methods super)
+					       :key #'sod-method-message)))
+				    (and method (list method))))
+				(sod-class-precedence-list class))))
+    (make-instance (message-effective-method-class message)
+		   :message message
+		   :class class
+		   :direct-methods direct-methods)))
+
+;;;--------------------------------------------------------------------------
+;;; Vtable layout.
+
+;;; method-entry
+
+(defclass method-entry ()
+  ((method :initarg :method
+	   :type effective-method
+	   :reader method-entry-effective-method)
+   (chain-head :initarg :chain-head
+	       :type sod-class
+	       :reader method-entry-chain-head))
+  (:documentation
+   "An entry point into an effective method.
+
+   Calls to an effective method via different vtable chains will have their
+   `me' pointers pointing to different ichains within the instance layout.
+   Rather than (necessarily) duplicating the entire effective method for each
+   chain, we insert an entry veneer (the method entry) to fix up the pointer.
+   Exactly how it does this is up to the effective method -- and duplication
+   under some circumstances is probably a reasonable approach -- e.g., if the
+   effective method is just going to call a direct method immediately."))
+
+(defmethod print-object ((entry method-entry) stream)
+  (maybe-print-unreadable-object (entry stream :type t)
+    (format stream "~A:~A"
+	    (method-entry-effective-method entry)
+	    (sod-class-nickname (method-entry-chain-head entry)))))
+
+(defgeneric make-method-entry (effective-method chain-head)
+  (:documentation
+   "Return a METHOD-ENTRY for an EFFECTIVE-METHOD called via CHAIN-HEAD.
+
+   There is no default method for this function.  (Maybe when the
+   effective-method/method-entry output protocol has settled down I'll know
+   what a sensible default action would be.)"))
+
+;;; vtmsgs
+
+(defclass vtmsgs ()
+  ((class :initarg :class :type sod-class :reader vtmsgs-class)
+   (subclass :initarg :subclass :type sod-class :reader vtmsgs-subclass)
+   (chain-head :initarg :chain-head
+	       :type sod-class
+	       :reader vtmsgs-chain-head)
+   (entries :initarg :entries :type list :reader vtmsgs-entries))
+  (:documentation
+   "The message dispatch table for a particular CLASS.
+
+   The BODY contains a list of effective method objects for the messages
+   defined on CLASS, customized for calling from the chain headed by
+   CHAIN-HEAD."))
+
+(defmethod print-object ((vtmsgs vtmsgs) stream)
+  (print-unreadable-object (vtmsgs stream :type t)
+    (format stream "~A <= ~A ~_~:<~@{~S~^ ~_~}~:>"
+	    (vtmsgs-subclass vtmsgs)
+	    (vtmsgs-class vtmsgs)
+	    (vtmsgs-entries vtmsgs))))
+
+(defgeneric compute-vtmsgs (class subclass chain-head)
+  (:documentation
+   "Return a VTMSGS object containing method entries for CLASS.
+
+   The CHAIN-HEAD describes which chain the method entries should be
+   constructed for.
+
+   The default method simply calls MAKE-METHOD-ENTRY for each of the methods
+   and wraps a VTMSGS object around them.  This ought to be enough for almost
+   all purposes."))
+
+;;; class-pointer
+
+(defclass class-pointer ()
+  ((class :initarg :class
+	  :type sod-class
+	  :reader class-pointer-class)
+   (chain-head :initarg :chain-head
+	       :type sod-class
+	       :reader class-pointer-chain-head)
+   (metaclass :initarg :metaclass
+	      :type sod-class
+	      :reader class-pointer-metaclass)
+   (meta-chain-head :initarg :meta-chain-head
+		    :type sod-class
+		    :reader class-pointer-meta-chain-head))
+  (:documentation
+   "Represents a pointer to a class object for the instance's class.
+
+   A class instance can have multiple chains.  It may be useful to find any
+   of those chains from an instance of the class.  Therefore the vtable
+   stores a pointer to each separate chain of the class instance."))
+
+(defmethod print-object ((cptr class-pointer) stream)
+  (print-unreadable-object (cptr stream :type t)
+    (format stream "~A:~A"
+	    (class-pointer-metaclass cptr)
+	    (sod-class-nickname (class-pointer-meta-chain-head cptr)))))
+
+(defgeneric make-class-pointer (class chain-head metaclass meta-chain-head)
+  (:documentation
+   "Return a class pointer to a metaclass chain."))
+
+;;; base-offset
+
+(defclass base-offset ()
+  ((class :initarg :class :type sod-class :reader base-offset-class)
+   (chain-head :initarg :chain-head
+	       :type sod-class
+	       :reader base-offset-chain-head))
+  (:documentation
+   "The offset of this chain to the ilayout base.
+
+   There's only one of these per vtable."))
+
+(defmethod print-object ((boff base-offset) stream)
+  (print-unreadable-object (boff stream :type t)
+    (format stream "~A:~A"
+	    (base-offset-class boff)
+	    (sod-class-nickname (base-offset-chain-head boff)))))
+
+(defgeneric make-base-offset (class chain-head)
+  (:documentation
+   "Return the base offset object for CHAIN-HEAD ichain."))
+
+;;; chain-offset
+
+(defclass chain-offset ()
+  ((class :initarg :class :type sod-class :reader chain-offset-class)
+   (chain-head :initarg :chain-head
+	       :type sod-class
+	       :reader chain-offset-chain-head)
+   (target-head :initarg :target-head
+		:type sod-class
+		:reader chain-offset-target-head))
+  (:documentation
+   "The offset from the CHAIN-HEAD ichain to the TARGET-HEAD ichain."))
+
+(defmethod print-object ((choff chain-offset) stream)
+  (print-unreadable-object (choff stream :type t)
+    (format stream "~A:~A->~A"
+	    (chain-offset-class choff)
+	    (sod-class-nickname (chain-offset-chain-head choff))
+	    (sod-class-nickname (chain-offset-target-head choff)))))
+
+(defgeneric make-chain-offset (class chain-head target-head)
+  (:documentation
+   "Return the offset from CHAIN-HEAD to TARGET-HEAD."))
+
+;;; vtable
+
+(defclass vtable ()
+  ((class :initarg :class :type sod-class :reader vtable-class)
+   (chain-head :initarg :chain-head
+	       :type sod-class
+	       :reader vtable-chain-head)
+   (body :initarg :body :type list :reader vtable-body))
+  (:documentation
+   "VTABLEs hold all of the per-chain static information for a class.
+
+   There is one vtable for each chain of each class.  The vtables for a class
+   are prefixes of the corresponding chains of its subclasses.
+
+   Vtables contain method entry pointers, pointers to class objects, and
+   the offset information used for cross-chain slot access."))
+
+(defmethod print-object ((vtable vtable) stream)
+  (print-unreadable-object (vtable stream :type t)
+    (format stream "~A:~A ~_~:<~@{~S~^ ~_~}~:>"
+	    (vtable-class vtable)
+	    (sod-class-nickname (vtable-chain-head vtable))
+	    (vtable-body vtable))))
+
+(defgeneric compute-vtable (class chain)
+  (:documentation
+   "Compute the vtable layout for a chain of CLASS.
+
+   The CHAIN is a list of classes, with the least specific first."))
+
+(defgeneric compute-vtables (class)
+  (:documentation
+   "Compute the vtable layouts for CLASS.
+
+   Returns a list of VTABLE objects in the order of CLASS's chains."))
+
+;;; Implementation.
+
+(defmethod compute-vtmsgs
+    ((class sod-class)
+     (subclass sod-class)
+     (chain-head sod-class))
+  (flet ((make-entry (message)
+	   (let ((method (find message
+			       (sod-class-effective-methods subclass)
+			       :key #'effective-method-message)))
+	     (make-method-entry method chain-head))))
+    (make-instance 'vtmsgs
+		   :class class
+		   :subclass subclass
+		   :chain-head chain-head
+		   :entries (mapcar #'make-entry
+				    (sod-class-messages class)))))
+
+(defmethod make-class-pointer
+    ((class sod-class) (chain-head sod-class)
+     (metaclass sod-class) (meta-chain-head sod-class))
+
+  ;; Slightly tricky.  We don't necessarily want a pointer to the metaclass,
+  ;; but to its most specific subclass on the given chain.  Fortunately, CL
+  ;; is good at this game.
+  (let* ((meta-chains (sod-class-chains metaclass))
+	 (meta-chain-tails (mapcar #'car meta-chains))
+	 (meta-chain-tail (find meta-chain-head meta-chain-tails
+				:key #'sod-class-chain-head)))
+    (make-instance 'class-pointer
+		   :class class
+		   :chain-head chain-head
+		   :metaclass meta-chain-tail
+		   :meta-chain-head meta-chain-head)))
+
+(defmethod make-base-offset ((class sod-class) (chain-head sod-class))
+  (make-instance 'base-offset
+		 :class class
+		 :chain-head chain-head))
+
+(defmethod make-chain-offset
+    ((class sod-class) (chain-head sod-class) (target-head sod-class))
+  (make-instance 'chain-offset
+		 :class class
+		 :chain-head chain-head
+		 :target-head target-head))
+
+;; Special variables used by COMPUTE-VTABLE.
+(defvar *done-metaclass-chains*)
+(defvar *done-instance-chains*)
+
+(defgeneric compute-vtable-items (class super chain-head emit)
+  (:documentation
+   "Emit vtable items for a superclass of CLASS.
+
+   This function is called for each superclass SUPER of CLASS reached on the
+   chain headed by CHAIN-HEAD.  The function should call EMIT for each
+   vtable item it wants to write.
+
+   The right way to check to see whether items have already been emitted
+   (e.g., has an offset to some other chain been emitted?) is as follows:
+
+     * In a method on COMPUTE-VTABLE, bind a special variable to an empty
+       list or hash table.
+
+     * In a method on this function, check the variable or hash table.
+
+   This function is the real business end of COMPUTE-VTABLE."))
+
+(defmethod compute-vtable-items
+    ((class sod-class) (super sod-class) (chain-head sod-class)
+     (emit function))
+
+  ;; If this class introduces new metaclass chains, then emit pointers to
+  ;; them.
+  (let* ((metasuper (sod-class-metaclass super))
+	 (metasuper-chains (sod-class-chains metasuper))
+	 (metasuper-chain-heads (mapcar (lambda (chain)
+					  (sod-class-chain-head (car chain)))
+					metasuper-chains)))
+    (dolist (metasuper-chain-head metasuper-chain-heads)
+      (unless (member metasuper-chain-head *done-metaclass-chains*)
+	(funcall emit (make-class-pointer class
+					  chain-head
+					  metasuper
+					  metasuper-chain-head))
+	(push metasuper-chain-head *done-metaclass-chains*))))
+
+  ;; If there are new instance chains, then emit offsets to them.
+  (let* ((chains (sod-class-chains super))
+	 (chain-heads (mapcar (lambda (chain)
+				(sod-class-chain-head (car chain)))
+			      chains)))
+    (dolist (head chain-heads)
+      (unless (member head *done-instance-chains*)
+	(funcall emit (make-chain-offset class chain-head head))
+	(push head *done-instance-chains*))))
+
+  ;; Finally, if there are interesting methods, emit those too.
+  (when (sod-class-messages super)
+    (funcall emit (compute-vtmsgs super class chain-head))))
+
+(defmethod compute-vtable ((class sod-class) (chain list))
+  (let* ((chain-head (car chain))
+	 (*done-metaclass-chains* nil)
+	 (*done-instance-chains* (list chain-head))
+	 (done-superclasses nil)
+	 (items nil))
+    (flet ((emit (item)
+	     (push item items)))
+
+      ;; Find the root chain in the metaclass and write a pointer.
+      (let* ((metaclass (sod-class-metaclass class))
+	     (metaclass-chains (sod-class-chains metaclass))
+	     (metaclass-chain-heads (mapcar (lambda (chain)
+					      (sod-class-chain-head
+					       (car chain)))
+					    metaclass-chains))
+	     (metaclass-root-chain (find-if-not
+				    #'sod-class-direct-superclasses
+				    metaclass-chain-heads)))
+	(emit (make-class-pointer class chain-head
+				  metaclass metaclass-root-chain))
+	(push metaclass-root-chain *done-metaclass-chains*))
+
+      ;; Write an offset to the instance base.
+      (emit (make-base-offset class chain-head))
+
+      ;; Now walk the chain.  As we ascend the chain, scan the class
+      ;; precedence list of each class in reverse to ensure that we have
+      ;; everything interesting.
+      (dolist (super chain)
+	(dolist (sub (reverse (sod-class-precedence-list super)))
+	  (unless (member sub done-superclasses)
+	    (compute-vtable-items class
+				  sub
+				  chain-head
+				  #'emit)
+	    (push sub done-superclasses))))
+
+      ;; We're through.
+      (make-instance 'vtable
+		     :class class
+		     :chain-head chain-head
+		     :body (nreverse items)))))
+
+(defgeneric compute-effective-methods (class)
+  (:documentation
+   "Return a list of all of the effective methods needed for CLASS.
+
+   The list needn't be in any particular order."))
+
+(defmethod compute-effective-methods ((class sod-class))
+  (mapcan (lambda (super)
+	    (mapcar (lambda (message)
+		      (compute-sod-effective-method message class))
+		    (sod-class-messages super)))
+	  (sod-class-precedence-list class)))
+
+(defmethod compute-vtables ((class sod-class))
+  (mapcar (lambda (chain)
+	    (compute-vtable class (reverse chain)))
+	  (sod-class-chains class)))
+
+;;;--------------------------------------------------------------------------
+;;; Names of things.
+
+(defun islots-struct-tag (class)
+  (format nil "~A__islots" class))
+
+(defun ichain-struct-tag (class chain-head)
+  (format nil "~A__ichain_~A" class(sod-class-nickname chain-head)))
+
+(defun ilayout-struct-tag (class)
+  (format nil "~A__ilayout" class))
+
+(defun vtmsgs-struct-tag (class super)
+  (format nil "~A__vtmsgs_~A" class (sod-class-nickname super)))
+
+(defun vtable-struct-tag (class chain-head)
+  (format nil "~A__vt_~A" class (sod-class-nickname chain-head)))
+
+(defun vtable-name (class chain-head)
+  (format nil "~A__vtable_~A" class (sod-class-nickname chain-head)))
+
+;;;--------------------------------------------------------------------------
+;;; Hacks for now.
+
+(defclass hacky-effective-method (effective-method)
+  ((direct-methods :initarg :direct-methods)))
+
+(defmethod print-object ((method hacky-effective-method) stream)
+  (if *print-escape*
+      (print-unreadable-object (method stream :type t)
+	(format stream "~A ~_~A ~_~:<~@{~S~^ ~_~}~:>"
+		(effective-method-message method)
+		(effective-method-class method)
+		(slot-value method 'direct-methods)))
+      (call-next-method)))
+
+(defmethod message-effective-method-class ((message sod-message))
+  'hacky-effective-method)
+
+(defmethod make-method-entry
+    ((method hacky-effective-method) (chain-head sod-class))
+  (make-instance 'method-entry
+		 :method method
+		 :chain-head chain-head))
+
+;;;----- That's all, folks --------------------------------------------------
diff --git a/class-output.lisp b/class-output.lisp
new file mode 100644
index 0000000..8fdcc82
--- /dev/null
+++ b/class-output.lisp
@@ -0,0 +1,314 @@
+;;; -*-lisp-*-
+;;;
+;;; Output functions for classes
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Simple Object Definition system.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Utility macro.
+
+(defmacro sequence-output
+    ((streamvar sequencer) &body clauses)
+  (let ((seqvar (gensym "SEQ")))
+    (labels ((convert-item-name (name)
+	       (if (listp name)
+		   (cons 'list name)
+		   name))
+	     (convert-constraint (constraint)
+	       (cons 'list (mapcar #'convert-item-name constraint)))
+	     (process-body (clauses)
+	       (if (eq (car clauses) :constraint)
+		   (cons `(add-sequencer-constraint
+			   ,seqvar
+			   ,(convert-constraint (cadr clauses)))
+			 (process-body (cddr clauses)))
+		   (mapcar (lambda (clause)
+			     (let ((name (car clause))
+				   (body (cdr clause)))
+			       `(add-sequencer-item-function
+				 ,seqvar
+				 ,(convert-item-name name)
+				 (lambda (,streamvar)
+				   ,@body))))
+			   clauses))))
+      `(let ((,seqvar ,sequencer))
+	 ,@(process-body clauses)))))
+
+;;;--------------------------------------------------------------------------
+;;; Classes.
+
+(defmethod add-output-hooks progn
+    ((class sod-class) (reason (eql :h)) sequencer)
+
+  ;; Main output sequencing.
+  (sequence-output (stream sequencer)
+
+    :constraint
+    (:typedefs)
+
+    :constraint
+    ((:classes :start)
+     (class :banner)
+     (class :islots :start) (class :islots :slots) (class :islots :end)
+     (class :vtmsgs :start) (class :vtmsgs :end)
+     (class :vtables :start) (class :vtables :end)
+     (class :vtable-externs) (class :vtable-externs-after)
+     (class :direct-methods)
+     (class :ichains :start) (class :ichains :end)
+     (class :ilayout :start) (class :ilayout :slots) (class :ilayout :end)
+     (class :conversions)
+     (:classes :end))
+
+    (:typedefs
+     (format stream "typedef struct ~A ~A;~%"
+	     (ichain-struct-tag class (sod-class-chain-head class)) class))
+
+    ((class :banner)
+     (banner (format nil "Class ~A" class) stream))
+    ((class :vtable-externs-after)
+     (terpri stream)))
+
+  ;; Maybe generate an islots structure.
+  (when (sod-class-slots class)
+    (dolist (slot (sod-class-slots class))
+      (add-output-hooks slot 'populate-islots sequencer))
+    (sequence-output (stream sequencer)
+      ((class :islots :start)
+       (format stream "struct ~A {~%" (islots-struct-tag class)))
+      ((class :islots :end)
+       (format stream "};~2%"))))
+
+  ;; Declare the direct methods.
+  (when (sod-class-methods class)
+    (dolist (method (sod-class-methods class))
+      (add-output-hooks method :declare-direct-methods sequencer))
+    (sequence-output (stream sequencer)
+      ((class :direct-methods)
+       (terpri stream))))
+
+  ;; Provide upcast macros which do the right thing.
+  (when (sod-class-direct-superclasses class)
+    (sequence-output (stream sequencer)
+      ((class :conversions)
+       (let ((chain-head (sod-class-chain-head class)))
+	 (dolist (super (cdr (sod-class-precedence-list class)))
+	   (let ((super-head (sod-class-chain-head super)))
+	     (format stream (concatenate 'string "#define "
+					 "~:@(~A__CONV_~A~)(p) ((~A *)"
+					 "~:[SOD_XCHAIN(~A, p)~;p~])~%")
+		     class (sod-class-nickname super) super
+		     (eq chain-head super-head)
+		     (sod-class-nickname super-head))))))))
+
+  ;; Generate vtmsgs structure for all superclasses.
+  (add-output-hooks (car (sod-class-vtables class))
+		    'populate-vtmsgs
+		    sequencer))
+
+(defmethod add-output-hooks progn ((class sod-class) reason sequencer)
+  (with-slots (ilayout vtables) class
+    (add-output-hooks ilayout reason sequencer)
+    (dolist (vtable vtables) (add-output-hooks vtable reason sequencer))))
+
+;;;--------------------------------------------------------------------------
+;;; Instance structure.
+
+(defmethod add-output-hooks progn
+    ((slot sod-slot) (reason (eql 'populate-islots)) sequencer)
+  (sequence-output (stream sequencer)
+    (((sod-slot-class slot) :islots :slots)
+     (pprint-logical-block (stream nil :prefix "  " :suffix ";")
+       (pprint-c-type (sod-slot-type slot) stream (sod-slot-name slot)))
+     (terpri stream))))
+
+(defmethod add-output-hooks progn ((ilayout ilayout) reason sequencer)
+  (with-slots (ichains) ilayout
+    (dolist (ichain ichains) (add-output-hooks ichain reason sequencer))))
+
+(defmethod add-output-hooks progn
+    ((ilayout ilayout) (reason (eql :h)) sequencer)
+  (with-slots (class ichains) ilayout
+    (sequence-output (stream sequencer)
+      ((class :ilayout :start)
+       (format stream "struct ~A {~%" (ilayout-struct-tag class)))
+      ((class :ilayout :end)
+       (format stream "};~2%")))
+    (dolist (ichain ichains)
+      (add-output-hooks ichain 'populate-ilayout sequencer))))
+
+(defmethod add-output-hooks progn
+    ((ichain ichain) (reason (eql :h)) sequencer)
+  (with-slots (class chain-head) ichain
+    (sequence-output (stream sequencer)
+      :constraint ((class :ichains :start)
+		   (class :ichain chain-head :start)
+		   (class :ichain chain-head :slots)
+		   (class :ichain chain-head :end)
+		   (class :ichains :end))
+      ((class :ichain chain-head :start)
+       (format stream "struct ~A {~%" (ichain-struct-tag class chain-head)))
+      ((class :ichain chain-head :end)
+       (format stream "};~2%")))))
+
+(defmethod add-output-hooks progn
+    ((ichain ichain) (reason (eql 'populate-ilayout)) sequencer)
+  (with-slots (class chain-head) ichain
+    (sequence-output (stream sequencer)
+      ((class :ilayout :slots)
+       (format stream "  struct ~A ~A;~%"
+	       (ichain-struct-tag class chain-head)
+	       (sod-class-nickname chain-head))))))
+
+(defmethod add-output-hooks progn ((ichain ichain) reason sequencer)
+  (with-slots (body) ichain
+    (dolist (item body) (add-output-hooks item reason sequencer))))
+
+(defmethod add-output-hooks progn
+    ((vtptr vtable-pointer) (reason (eql :h)) sequencer)
+  (with-slots (class chain-head) vtptr
+    (sequence-output (stream sequencer)
+      ((class :ichain chain-head :slots)
+       (format stream "  const struct ~A *_vt;~%"
+	       (vtable-struct-tag class chain-head))))))
+
+(defmethod add-output-hooks progn
+    ((islots islots) (reason (eql :h)) sequencer)
+  (with-slots (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))))))
+
+;;;--------------------------------------------------------------------------
+;;; Vtable structure.
+
+(defmethod add-output-hooks progn ((vtable vtable) reason sequencer)
+  (with-slots (body) vtable
+    (dolist (item body) (add-output-hooks item reason sequencer))))
+
+(defmethod add-output-hooks progn
+    ((vtable vtable) (reason (eql :h)) sequencer)
+  (with-slots (class chain-head) vtable
+    (sequence-output (stream sequencer)
+      :constraint ((class :vtables :start)
+		   (class :vtable chain-head :start)
+		   (class :vtable chain-head :slots)
+		   (class :vtable chain-head :end)
+		   (class :vtables :end))
+      ((class :vtable chain-head :start)
+       (format stream "struct ~A {~%" (vtable-struct-tag class chain-head)))
+      ((class :vtable chain-head :end)
+       (format stream "};~2%"))
+      ((class :vtable-externs)
+       (format stream "~@<extern struct ~A ~2I~_~A__vtable_~A;~:>~%"
+	       (vtable-struct-tag class chain-head)
+	       class (sod-class-nickname chain-head))))))
+
+(defmethod add-output-hooks progn
+    ((vtmsgs vtmsgs) (reason (eql :h)) sequencer)
+  (with-slots (class subclass chain-head) vtmsgs
+    (sequence-output (stream sequencer)
+      ((subclass :vtable chain-head :slots)
+       (format stream "  struct ~A ~A;~%"
+	       (vtmsgs-struct-tag subclass class)
+	       (sod-class-nickname class))))))
+
+(defmethod add-output-hooks progn
+    ((vtmsgs vtmsgs) (reason (eql 'populate-vtmsgs)) sequencer)
+  (when (vtmsgs-entries vtmsgs)
+    (with-slots (class subclass) vtmsgs
+      (sequence-output (stream sequencer)
+	:constraint ((subclass :vtmsgs :start)
+		     (subclass :vtmsgs class :start)
+		     (subclass :vtmsgs class :slots)
+		     (subclass :vtmsgs class :end)
+		     (subclass :vtmsgs :end))
+	((subclass :vtmsgs class :start)
+	 (format stream "struct ~A {~%" (vtmsgs-struct-tag subclass class)))
+	((subclass :vtmsgs class :end)
+	 (format stream "};~2%"))))))
+
+(defmethod add-output-hooks progn ((vtmsgs vtmsgs) reason sequencer)
+  (with-slots (entries) vtmsgs
+    (dolist (entry entries) (add-output-hooks entry reason sequencer))))
+
+(defmethod add-output-hooks progn ((entry method-entry) reason sequencer)
+  (with-slots (method) entry
+    (add-output-hooks method reason sequencer)))
+
+(defmethod add-output-hooks progn
+    ((method effective-method) (reason (eql 'populate-vtmsgs)) sequencer)
+  (let* ((message (effective-method-message method))
+	 (class (effective-method-class method))
+	 (class-type (find-class-type (sod-class-name class)))
+	 (raw-type (sod-message-type message))
+	 (type (c-type (* (fun (lisp (c-type-subtype raw-type))
+			       ("/*me*/" (* (lisp class-type)))
+			       . (commentify-argument-names
+				  (c-function-arguments raw-type)))))))
+    (sequence-output (stream sequencer)
+      ((class :vtmsgs (sod-message-class message) :slots)
+       (pprint-logical-block (stream nil :prefix "  " :suffix ";")
+	 (pprint-c-type type stream (sod-message-name message)))
+       (terpri stream)))))
+
+(defmethod add-output-hooks progn
+    ((cptr class-pointer) (reason (eql :h)) sequencer)
+  (with-slots (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
+	       (if (sod-class-direct-superclasses meta-chain-head)
+		   (sod-class-nickname meta-chain-head)
+		   nil))))))
+
+(defmethod add-output-hooks progn
+    ((boff base-offset) (reason (eql :h)) sequencer)
+  (with-slots (class chain-head) boff
+    (sequence-output (stream sequencer)
+      ((class :vtable chain-head :slots)
+       (write-line "  size_t _base;" stream)))))
+
+(defmethod add-output-hooks progn
+    ((choff chain-offset) (reason (eql :h)) sequencer)
+  (with-slots (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))))))
+
+;;;--------------------------------------------------------------------------
+;;; Testing.
+
+#+test
+(defun test (name)
+  (let ((sequencer (make-instance 'sequencer))
+	(class (find-sod-class name)))
+    (add-output-hooks class :h sequencer)
+    (invoke-sequencer-items sequencer *standard-output*)
+    sequencer))
+
+;;;----- That's all, folks --------------------------------------------------
diff --git a/codegen.lisp b/codegen.lisp
new file mode 100644
index 0000000..6419c0f
--- /dev/null
+++ b/codegen.lisp
@@ -0,0 +1,470 @@
+;;; -*-lisp-*-
+;;;
+;;; Code generator for effective methods
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Simple Object Definition system.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Temporary names.
+
+(defclass temporary-name ()
+  ((tag :initarg :tag :reader temp-tag))
+  (:documentation
+   "Base class for temporary variable and argument names."))
+
+(defclass temporary-argument (temporary-name) ())
+(defclass temporary-function (temporary-name) ())
+
+(defclass temporary-variable (temporary-name)
+  ((in-use-p :initarg :in-use-p
+	     :initform nil
+	     :type boolean
+	     :accessor var-in-use-p)))
+
+(defmethod var-in-use-p ((var t))
+  "Non-temporary variables are always in use."
+  t)
+
+(defmethod commentify-argument-name ((name temporary-name))
+  nil)
+
+(defparameter *temporary-index* 0
+  "Index for temporary name generation.
+
+   This is automatically reset to zero before the output functions are
+   invoked to write a file.  This way, we can ensure that the same output
+   file is always produced from the same input.")
+
+(defun temporary-function ()
+  "Return a temporary function name."
+  (make-instance 'temporary-function
+		 :tag (prog1 *temporary-index* (incf *temporary-index*))))
+
+(defgeneric format-temporary-name (var stream)
+  (:method ((var temporary-name) stream)
+    (format stream "~A" (temp-tag var)))
+  (:method ((var temporary-argument) stream)
+    (format stream "sod__a~A" (temp-tag var)))
+  (:method ((var temporary-variable) stream)
+    (format stream "sod__v~A" (temp-tag var)))
+  (:method ((var temporary-function) stream)
+    (format stream "sod__f~A" (temp-tag var))))
+
+(defmethod print-object ((var temporary-name) stream)
+  (if *print-escape*
+      (print-unreadable-object (var stream :type t)
+	(prin1 (temp-tag var) stream))
+      (format-temporary-name var stream)))
+
+(defparameter *sod-ap*
+  (make-instance 'temporary-name :tag "sod__ap"))
+(defparameter *sod-master-ap*
+  (make-instance 'temporary-name :tag "sod__master_ap"))
+
+;;;--------------------------------------------------------------------------
+;;; Instructions.
+
+(defclass inst () ()
+  (:documentation
+   "A base class for instructions.
+
+   An `instruction' is anything which might be useful to string into a code
+   generator.  Both statements and expressions map can be represented by
+   trees of instructions.  The DEFINST macro is a convenient way of defining
+   new instructions.
+
+   The only important protocol for instructions is output, which is achieved
+   by calling PRINT-OBJECT with *PRINT-ESCAPE* nil.
+
+   This doesn't really do very much, but it acts as a handy marker for
+   instruction subclasses."))
+
+(defgeneric inst-metric (inst)
+  (:documentation
+   "Returns a `metric' describing how complicated INST is.
+
+   The default metric of an inst node is simply 1; INST subclasses generated
+   by DEFINST (q.v.) have an automatically generated method which returns one
+   plus the sum of the metrics of the node's children.
+
+   This isn't intended to be a particularly rigorous definition.  Its purpose
+   is to allow code generators to make decisions about inlining or calling
+   code fairly simply.")
+  (:method (inst) 1))
+
+(defmacro definst (code (streamvar) args &body body)
+  "Define an instruction type and describe how to output it.
+
+   An INST can represent any structured piece of output syntax: a statement,
+   expression or declaration, for example.  This macro defines the following
+   things:
+
+     * A class CODE-INST to represent the instruction.
+
+     * Instance slots named after the ARGS, with matching keyword initargs,
+       and INST-ARG readers.
+
+     * A constructor MAKE-CODE-INST which accepts the ARGS (in order, not
+       with keywords) as arguments and returns a fresh instance.
+
+     * A print method, which prints a diagnostic dump if *PRINT-ESCAPE* is
+       set, or invokes the BODY (with STREAMVAR bound to the output stream)
+       otherwise.  The BODY is expected to produce target code at this
+       point."
+
+  (let ((inst-var (gensym "INST"))
+	(class-name (symbolicate code '-inst))
+	(keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
+		      args)))
+    `(progn
+       (defclass ,class-name (inst)
+	 ,(mapcar (lambda (arg key)
+		    `(,arg :initarg ,key :reader ,(symbolicate 'inst- arg)))
+		  args keys))
+       (defun ,(symbolicate 'make- code '-inst) (,@args)
+	 (make-instance ',class-name ,@(mappend #'list keys args)))
+       (defmethod inst-metric ((,inst-var ,class-name))
+	 (with-slots (,@args) ,inst-var
+	   (+ 1 ,@(mapcar (lambda (arg) `(inst-metric ,arg)) args))))
+       (defmethod print-object ((,inst-var ,class-name) ,streamvar)
+	 (with-slots (,@args) ,inst-var
+	   (if *print-escape*
+	       (print-unreadable-object (,inst-var ,streamvar :type t)
+		 (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"
+			 ,@(mappend #'list keys args)))
+	       (progn ,@body)))))))
+
+(defun format-compound-statement* (stream child morep thunk)
+  "Underlying function for FORMAT-COMPOUND-STATEMENT."
+  (cond ((typep child 'block-inst)
+	 (funcall thunk stream)
+	 (write-char #\space stream)
+	 (princ child stream)
+	 (when morep (write-char #\space stream)))
+	(t
+	 (pprint-logical-block (stream nil)
+	   (funcall thunk stream)
+	   (write-char #\space stream)
+	   (pprint-indent :block 2 stream)
+	   (pprint-newline :linear stream)
+	   (princ child stream)
+	   (pprint-indent :block 0 stream)
+	   (case morep
+	     (:space
+	      (write-char #\space stream)
+	      (pprint-newline :linear stream))
+	     (t
+	      (pprint-newline :mandatory stream)))))))
+
+(defmacro format-compound-statement
+    ((stream child &optional morep) &body body)
+  "Format a compound statement to STREAM.
+
+   The introductory material is printed by BODY.  The CHILD is formatted
+   properly according to whether it's a BLOCK-INST.  If MOREP is true, then
+   allow for more stuff following the child."
+  `(format-compound-statement* ,stream ,child ,morep
+			       (lambda (,stream) ,@body)))
+
+;;;--------------------------------------------------------------------------
+;;; Instruction types.
+
+;; Compound statements.
+
+(definst block (stream) (decls body)
+  (format stream "{~:@_~@<  ~2I~@[~{~A;~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
+	  decls body))
+
+(definst if (stream) (condition consequent alternative)
+  (format-compound-statement (stream consequent alternative)
+    (format stream "if (~A)" condition))
+  (when alternative
+    (format-compound-statement (stream alternative)
+      (write-string "else" stream))))
+
+(definst while (stream) (condition body)
+  (format-compound-statement (stream body)
+    (format stream "while (~A)" condition)))
+
+(definst do-while (stream) (body condition)
+  (format-compound-statement (stream body :space)
+    (write-string "do" stream))
+  (format stream "while (~A);" condition))
+
+;; Simple statements.
+
+(definst set (stream) (var expr)
+  (format stream "~@<~A = ~@_~2I~A;~:>" var expr))
+
+(definst return (stream) (expr)
+  (format stream "return~@[ (~A)~];" expr))
+
+(definst expr (stream) (expr)
+  (format stream "~A;" expr))
+
+;; Special varargs hacks.
+
+(definst va-start (stream) (ap arg)
+  (format stream "va_start(~@<~A, ~_~A~:>);" ap arg))
+
+(definst va-copy (stream) (to from)
+  (format stream "va_copy(~@<~A, ~_~A~:>);" to from))
+
+(definst va-end (stream) (ap)
+  (format stream "va_end(~A);" ap))
+
+;; Declarations.  These should appear at the heads of BLOCK-INSTs.
+
+(definst var (stream) (name type init)
+  (pprint-c-type type stream name)
+  (when init
+    (format stream " = ~A" init)))
+
+;; Expressions.
+
+(definst call (stream) (func args)
+  (format stream "~A(~@<~{~A~^, ~_~}~:>)" func args))
+
+;; Top level things.
+
+(definst function (stream) (name type body)
+  (pprint-logical-block (stream nil)
+    (pprint-c-type type stream name)
+    (format stream "~:@_~A~:@_~:@_" body)))
+
+;;;--------------------------------------------------------------------------
+;;; Code generator objects.
+
+(defclass basic-codegen ()
+  ((vars :initarg :vars :initform nil :type list :accessor codegen-vars)
+   (insts :initarg :insts :initform nil :type list :accessor codegen-insts)
+   (temp-index :initarg :temp-index
+	       :initform 0
+	       :type fixnum
+	       :accessor codegen-temp-index))
+  (:documentation
+   "Base class for code generator state.
+
+   This contains the bare essentials for supporting the EMIT-INST and
+   ENSURE-VAR protocols; see the documentation for those generic functions
+   for more details.
+
+   This class isn't abstract.  A full CODEGEN object uses instances of this
+   to keep track of pending functions which haven't been completed yet.
+
+   Just in case that wasn't clear enough: this is nothing to do with the
+   BASIC language."))
+
+(defgeneric emit-inst (codegen inst)
+  (:documentation
+   "Add INST to the end of CODEGEN's list of instructions.")
+  (:method ((codegen basic-codegen) inst)
+    (push inst (codegen-insts codegen))))
+
+(defgeneric emit-insts (codegen insts)
+  (:documentation
+   "Add a list of INSTS to the end of CODEGEN's list of instructions.")
+  (:method ((codegen basic-codegen) insts)
+    (setf (codegen-insts codegen)
+	  (revappend insts (codegen-insts codegen)))))
+
+(defgeneric ensure-var (codegen name type &optional init)
+  (:documentation
+   "Add a variable to CODEGEN's list.
+
+   The variable is called NAME (which should be comparable using EQUAL and
+   print to an identifier) and has the given TYPE.  If INIT is present and
+   non-nil it is an expression INST used to provide the variable with an
+   initial value.")
+  (:method ((codegen basic-codegen) name type &optional init)
+    (let* ((vars (codegen-vars codegen))
+	   (var (find name vars :key #'inst-name :test #'equal)))
+      (cond ((not var)
+	     (setf (codegen-vars codegen)
+		   (cons (make-var-inst name type init) vars)))
+	    ((not (c-type-equal-p type (inst-type var)))
+	     (error "(Internal) Redefining type for variable ~A." name)))
+      name)))
+
+(defclass codegen (basic-codegen)
+  ((functions :initform nil :type list :accessor codegen-functions)
+   (stack :initform nil :type list :accessor codegen-stack))
+  (:documentation
+   "A full-fat code generator which can generate and track functions.
+
+   This is the real deal.  Subclasses may which to attach additional state
+   for convenience's sake, but this class is self-contained.  It supports the
+   CODEGEN-PUSH, CODEGEN-POP and CODEGEN-POP-FUNCTION protocols."))
+
+(defgeneric codegen-push (codegen)
+  (:documentation
+   "Pushes the current code generation state onto a stack.
+
+   The state consists of the accumulated variables and instructions, i.e.,
+   what is representable by a BASIC-CODEGEN.")
+  (:method ((codegen codegen))
+    (with-slots (vars insts temp-index stack) codegen
+      (push (make-instance 'basic-codegen
+			   :vars vars
+			   :insts insts
+			   :temp-index temp-index)
+	    stack)
+      (setf vars nil insts nil temp-index 0))))
+
+(defgeneric codegen-pop (codegen)
+  (:documentation
+   "Pops a saved state off of the CODEGEN's stack.
+
+   Returns the newly accumulated variables and instructions as lists, as
+   separate values.")
+  (:method ((codegen codegen))
+    (with-slots (vars insts temp-index stack) codegen
+      (multiple-value-prog1
+	  (values (nreverse vars) (nreverse insts))
+	(let ((sub (pop stack)))
+	  (setf vars (codegen-vars sub)
+		insts (codegen-insts sub)
+		temp-index (codegen-temp-index sub)))))))
+
+(defgeneric codegen-add-function (codegen function)
+  (:documentation
+   "Adds a function to CODEGEN's list.
+
+   Actually, we're not picky: FUNCTION can be any kind of object that you're
+   willing to find in the list returned by CODEGEN-FUNCTIONS.")
+  (:method ((codegen codegen) function)
+    (with-slots (functions) codegen
+      (setf functions (nconc functions (list function))))))
+
+(defun codegen-build-function (codegen name type vars insts)
+  "Build a function and add it to CODEGEN's list.
+
+   Returns the function's name."
+  (codegen-add-function codegen
+			(make-function-inst name type
+					    (make-block-inst vars insts)))
+  name)
+
+(defgeneric codegen-pop-function (codegen name type)
+  (:documentation
+   "Makes a function out of the completed code in CODEGEN.
+
+   The NAME can be any object you like.  The TYPE should be a function type
+   object which includes argument names.  The return value is the NAME.")
+  (:method ((codegen codegen) name type)
+    (multiple-value-bind (vars insts) (codegen-pop codegen)
+      (codegen-build-function codegen name type vars insts))))
+
+(defgeneric temporary-var (codegen type)
+  (:documentation
+   "Return the name of a temporary variable.
+
+   The temporary variable will have the given TYPE, and will be marked
+   in-use.  You should clear the in-use flag explicitly when you've finished
+   with the variable -- or, better, use WITH-TEMPORARY-VAR to do the cleanup
+   automatically."))
+
+(defmethod temporary-var ((codegen basic-codegen) type)
+  (with-slots (vars temp-index) codegen
+    (or (find-if (lambda (var)
+		   (and (not (var-in-use-p (inst-name var)))
+			(c-type-equal-p type (inst-type var))))
+		 vars)
+	(let* ((name (make-instance 'temporary-variable
+				    :tag (prog1 temp-index
+					   (incf temp-index)))))
+	  (push (make-var-inst name type nil) vars)
+	  name))))
+
+(defmacro with-temporary-var ((codegen var type) &body body)
+  "Evaluate BODY with VAR bound to a temporary variable name.
+
+   During BODY, VAR will be marked in-use; when BODY ends, VAR will be marked
+  available for re-use."
+  `(let ((,var (temporary-var ,codegen ,type)))
+     (unwind-protect
+	  (progn ,@body)
+       (setf (var-in-use-p ,var) nil))))
+
+;;;--------------------------------------------------------------------------
+;;; Code generation idioms.
+
+(defun deliver-expr (codegen target expr)
+  "Emit code to deliver the value of EXPR to the TARGET.
+
+   The TARGET may be one of the following.
+
+     * :VOID, indicating that the value is to be discarded.  The expression
+       will still be evaluated.
+
+     * :VOID-RETURN, indicating that the value is to be discarded (as for
+       :VOID) and furthermore a `return' from the current function should be
+       forced after computing the value.
+
+     * :RETURN, indicating that the value is to be returned from the current
+       function.
+
+     * A variable name, indicating that the value is to be stored in the
+       variable.
+
+   In the cases of :RETURN, :VOID and :VOID-RETURN targets, it is valid for
+   EXPR to be nil; this signifies that no computation needs to be performed.
+   Variable-name targets require an expression."
+
+  (case target
+    (:return (emit-inst codegen (make-return-inst expr)))
+    (:void (when expr (emit-inst codegen (make-expr-inst expr))))
+    (:void-return (when expr (emit-inst codegen (make-expr-inst expr)))
+		  (emit-inst codegen (make-return-inst nil)))
+    (t (emit-inst codegen (make-set-inst target expr)))))
+
+(defun convert-stmts (codegen target type func)
+  "Invoke FUNC to deliver a value to a non-:RETURN target.
+
+   FUNC is a function which accepts a single argument, a non-:RETURN target,
+   and generates statements which deliver a value (see DELIVER-EXPR) of the
+   specified TYPE to this target.  In general, the generated code will have
+   the form
+
+     setup instructions...
+     (DELIVER-EXPR CODEGEN TARGET (compute value...))
+     cleanup instructions...
+
+   where the cleanup instructions are essential to the proper working of the
+   generated program.
+
+   CONVERT-STMTS will call FUNC to generate code, and arrange that its value
+   is correctly delivered to TARGET, regardless of what the TARGET is --
+   i.e., it lifts the restriction to non-:RETURN targets.  It does this by
+   inventing a new temporary variable."
+
+  (case target
+    (:return (with-temporary-var (codegen var type)
+	       (funcall func var)
+	       (deliver-expr codegen target var)))
+    (:void-return (funcall func :void)
+		  (emit-inst codegen (make-return-inst nil)))
+    (t (funcall func target))))
+
+;;;----- That's all, folks --------------------------------------------------
diff --git a/combination.lisp b/combination.lisp
new file mode 100644
index 0000000..be5257e
--- /dev/null
+++ b/combination.lisp
@@ -0,0 +1,131 @@
+;;; -*-lisp-*-
+;;;
+;;; Method combinations
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Simple Object Definition system.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Common behaviour.
+
+(defclass simple-message (basic-message)
+  ()
+  (:documentation
+   "Base class for messages with `simple' method combinations.
+
+   A simple method combination is one which has only one method role other
+   than the `before', `after' and `around' methods provided by BASIC-MESSAGE.
+   We call these `primary' methods, and the programmer designates them by not
+   specifying an explicit role.
+
+   If the programmer doesn't define any primary methods then the effective
+   method is null -- i.e., the method entry pointer shows up as a null
+   pointer."))
+
+(defclass simple-effective-method (basic-effective-method)
+  ((primary-methods :initarg :primary-methods
+		    :initform nil
+		    :type list
+		    :reader effective-method-primary-methods))
+  (:documentation
+   "Effective method counterpart to SIMPLE-MESSAGE."))
+
+(defgeneric primary-method-class (message)
+  (:documentation
+   "Return the name of the primary direct method class for MESSAGE."))
+
+(defgeneric simple-method-body (method codegen target)
+  (:documentation
+   "Generate the body of a simple effective method.
+
+   The function is invoked on an effective METHOD, with a CODEGEN to which it
+   should emit code delivering the method's value to TARGET."))
+
+(defmethod sod-message-method-class
+    ((message standard-message) (class sod-class) pset)
+  (if (get-property pset :role :keyword nil)
+      (call-next-method)
+      (primary-method-class message)))
+
+(defmethod shared-initialize :after
+    ((method simple-effective-method) slot-names &key direct-methods)
+  (declare (ignore slot-names))
+  (categorize (method direct-methods :bind ((role (sod-method-role method))))
+      ((primary (null role))
+       (before (eq role :before))
+       (after (eq role :after))
+       (around (eq role :around)))
+    (with-slots (primary-methods before-methods after-methods around-methods)
+	method
+      (setf primary-methods primary
+	    before-methods before
+	    after-methods (reverse after)
+	    around-methods around))))
+
+(defmethod compute-effective-method-entry-functions
+    ((method standard-effective-method))
+  (if (effective-method-primary-methods method)
+      (call-next-method)
+      nil))
+
+(defmethod compute-effective-method-body
+    ((method simple-effective-method) codegen target)
+  (with-slots (message basic-argument-names primary-methods) method
+    (basic-effective-method-body codegen target method
+				 (lambda (target)
+				   (simple-method-body method
+						       codegen
+						       target)))))
+
+;;;--------------------------------------------------------------------------
+;;; Standard method combination.
+
+(defclass standard-message (simple-message)
+  ()
+  (:documentation
+   "Message class for standard method combination.
+
+   Standard method combination is a simple method combination where the
+   primary methods are invoked as a delegation chain, from most- to
+   least-specific."))
+
+(defclass standard-effective-method (simple-effective-method)
+  ()
+  (:documentation
+   "Effective method counterpart to STANDARD-MESSAGE."))
+
+(defmethod primary-method-class ((message standard-message))
+  'delegating-direct-method)
+
+(defmethod message-effective-method-class ((message standard-message))
+  'standard-effective-method)
+
+(defmethod simple-method-body
+    ((method standard-effective-method) codegen target)
+  (invoke-delegation-chain codegen
+			   target
+			   (effective-method-basic-argument-names method)
+			   (effective-method-primary-methods method)
+			   nil))
+
+;;;----- That's all, folks --------------------------------------------------
diff --git a/cpl.lisp b/cpl.lisp
index 5a8c7c1..041e8e7 100644
--- a/cpl.lisp
+++ b/cpl.lisp
@@ -82,11 +82,8 @@
   (labels ((superclasses (class)
 	     (let ((direct-supers (sod-class-direct-superclasses class)))
 	       (remove-duplicates (cons class
-					(reduce #'append
-						(mapcar #'superclasses
-							direct-supers)
-						:from-end t
-						:initial-value nil))))))
+					(mappend #'superclasses
+						 direct-supers))))))
     (merge-lists (mapcar (lambda (class)
 			   (cons class
 				 (sod-class-direct-superclasses class)))
diff --git a/cutting-room-floor.lisp b/cutting-room-floor.lisp
index 1781f98..2f82c65 100644
--- a/cutting-room-floor.lisp
+++ b/cutting-room-floor.lisp
@@ -8,7 +8,7 @@
 	#+ecl #:clos)
   (:export #:c-type
 	   #:c-declarator-priority #:maybe-parenthesize
-	   #:c-declaration
+	   #:pprint-c-type
 	   #:c-type-subtype #:compount-type-declaration
 	   #:qualifiable-c-type #:c-type-qualifiers #:format-qualifiers
 	   #:simple-c-type #:c-type-name
@@ -91,3 +91,105 @@
 	  (ldb t-byte flags) type)
     flags))
 
+
+(defun expand-c-type (spec)
+  "Parse SPEC as a C type and return the result.
+
+   The SPEC can be one of the following.
+
+     * A C-TYPE object, which is returned immediately.
+
+     * A list, (OPERATOR . ARGUMENTS), where OPERATOR is a symbol: a parser
+       function associated with the OPERATOR symbol by DEFINE-C-TYPE-SYNTAX
+       or some other means is invoked on the ARGUMENTS, and the result is
+       returned.
+
+     * A symbol, which is treated the same way as a singleton list would be."
+
+  (flet ((interp (sym)
+	   (or (get sym 'c-type)
+	       (error "Unknown C type operator ~S." sym))))
+    (etypecase spec
+      (c-type spec)
+      (symbol (funcall (interp spec)))
+      (list (apply (interp (car spec)) (cdr spec))))))
+
+(defmacro c-type (spec)
+  "Evaluates to the type that EXPAND-C-TYPE would return.
+
+   Currently this just quotes SPEC and calls EXPAND-C-TYPE at runtime.  Maybe
+   later it will do something more clever."
+  `(expand-c-type ',spec))
+
+;; S-expression machinery.  Qualifiers have hairy syntax and need to be
+;; implemented by hand.
+
+(defun qualifier (qual &rest args)
+  "Parse a qualified C type.
+
+   The ARGS consist of a number of qualifiers and exactly one C-type
+   S-expression.  The result is a qualified version of this type, with the
+   given qualifiers attached."
+  (if (null args)
+      qual
+      (let* ((things (mapcar #'expand-c-type args))
+	     (quals (delete-duplicates
+		     (sort (cons qual (remove-if-not #'keywordp things))
+			   #'string<)))
+	     (types (remove-if-not (lambda (thing) (typep thing 'c-type))
+				   things)))
+	(when (or (null types)
+		  (not (null (cdr types))))
+	  (error "Only one proper type expected in ~S." args))
+	(qualify-type (car types) quals))))
+(setf (get 'qualifier 'c-type) #'qualifier)
+
+(defun declare-qualifier (qual)
+  "Defines QUAL as being a type qualifier.
+
+   When used as a C-type operator, it applies that qualifier to the type that
+   is its argument."
+  (let ((kw (intern (string qual) :keyword)))
+    (setf (get qual 'c-type)
+	  (lambda (&rest args)
+	    (apply #'qualifier kw args)))))
+
+;; Define some initial qualifiers.
+(dolist (qual '(const volatile restrict))
+  (declare-qualifier qual))
+
+
+(define-c-type-syntax simple-c-type (name)
+  "Constructs a simple C type called NAME (a string or symbol)."
+  (make-simple-type (c-name-case name)))
+
+(defmethod print-c-type :around
+    (stream (type qualifiable-c-type) &optional colon atsign)
+  (if (c-type-qualifiers type)
+      (pprint-logical-block (stream nil :prefix "(" :suffix ")")
+	(format stream "QUALIFIER~{ ~:_~:I~A~} ~:_"
+		(c-type-qualifiers type))
+	(call-next-method stream type colon atsign))
+      (call-next-method)))
+;; S-expression syntax.
+
+
+(define-c-type-syntax enum (tag)
+  "Construct an enumeration type named TAG."
+  (make-instance 'c-enum-type :tag (c-name-case tag)))
+(define-c-type-syntax struct (tag)
+  "Construct a structure type named TAG."
+  (make-instance 'c-struct-type :tag (c-name-case tag)))
+(define-c-type-syntax union (tag)
+  "Construct a union type named TAG."
+  (make-instance 'c-union-type :tag (c-name-case tag)))
+
+(defgeneric make-me-argument (message class)
+  (:documentation
+   "Return an ARGUMENT object for the `me' argument to MESSAGE, as
+   specialized to CLASS."))
+
+(defmethod make-me-argument
+    ((message basic-message) (class sod-class))
+  (make-argument "me" (make-instance 'c-pointer-type
+				     :subtype (sod-class-type class))))
diff --git a/examples.lisp b/examples.lisp
new file mode 100644
index 0000000..92489dd
--- /dev/null
+++ b/examples.lisp
@@ -0,0 +1,60 @@
+(set-dispatch-macro-character #\# #\{ 'c-fragment-reader)
+
+(progn
+  (clear-the-decks)
+
+  (define-sod-class "Animal" ("SodObject")
+    :nick 'nml
+    :link '|SodObject|
+    (slot "tickles" int)
+    (instance-initializer "nml" "tickles" :single #{ 0 })
+    (message "tickle" (fun void))
+    (method "nml" "tickle" (fun void) #{
+       me->tickles++;
+     }
+     :role :before)
+    (method "nml" "tickle" (fun void) #{ }))
+
+  (define-sod-class "Lion" ("Animal")
+    :nick 'lion
+    :link '|Animal|
+    (message "bite" (fun void))
+    (method "lion" "bite" (fun void) nil)
+    (method "nml" "tickle" (fun void) #{
+       me->_vt->lion.bite(me);
+       CALL_NEXT_METHOD;
+     }))
+
+  (define-sod-class "Goat" ("Animal")
+    :nick 'goat
+    (message "butt" (fun void))
+    (method "goat" "butt" (fun void) nil)
+    (method "nml" "tickle" (fun void) #{
+       me->_vt->goat.bite(me);
+       CALL_NEXT_METHOD;
+     }))
+
+  (define-sod-class "Serpent" ("Animal")
+    :nick 'serpent
+    (message "bite" (fun void))
+    (method "serpent" "bite" (fun void) nil)
+    (message "hiss" (fun void))
+    (method "serpent" "hiss" (fun void) nil)
+    (method "nml" "tickle" (fun void) #{
+       if (me->tickles < 3) me->_vt->hiss(me);
+       else me->_vt->bite(me);
+       CALL_NEXT_METHOD;
+     }))
+
+  (define-sod-class "Chimaera" ("Lion" "Goat" "Serpent")
+    :nick 'sir
+    :link '|Lion|)
+
+  (defparameter *chimaera* (find-sod-class "Chimaera"))
+  (defparameter *emeth* (find "tickle"
+			      (sod-class-effective-methods *chimaera*)
+			      :key (lambda (method)
+				     (sod-message-name
+				      (effective-method-message method)))
+			      :test #'string=)))
+
diff --git a/layout.lisp b/layout.lisp
deleted file mode 100644
index d077fe2..0000000
--- a/layout.lisp
+++ /dev/null
@@ -1,84 +0,0 @@
-;;; -*-lisp-*-
-;;;
-;;; Layout for instances and vtables
-;;;
-;;; (c) 2009 Straylight/Edgeware
-;;;
-
-;;;----- Licensing notice ---------------------------------------------------
-;;;
-;;; This file is part of the Simple Object Definition system.
-;;;
-;;; SOD is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; SOD is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with SOD; if not, write to the Free Software Foundation,
-;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(cl:in-package #:sod)
-
-;;;--------------------------------------------------------------------------
-;;; Layout objects.
-
-(defclass effective-slot ()
-  ((slot :initarg :slot :type sod-slot :reader slot-direct-slot)
-   (initializer :initarg :initializer
-		:type (or sod-initializer null)
-		:reader slot-initializer)))
-
-(defclass islots ()
-  ((class :initarg :class :type sod-class :reader islots-class)
-   (slots :initarg :slots :type list :reader islots-slots)))
-
-(defclass ichain ()
-  ((class :initarg :class :type sod-class :reader ichain-class)
-   (chain :initarg :chain :type sod-class :reader ichain-chain)
-   (body :initarg :body :type list :reader ichain-body)))
-
-(defclass ilayout ()
-  ((class :initarg :class :type sod-class :reader ilayout-class)
-   (ichains :initarg :ichains :type list :reader ilayout-ichains)))
-
-(defclass effective-method ()
-  ((message :initarg :message :type sod-message :reader method-message)
-   (class :initarg :class :type sod-class :reader method-class)))
-
-(defclass method-entry ()
-  ((method :initarg :method
-	   :type effective-method
-	   :reader method-entry-effective-method)
-   (ichain :initarg :chain :type ichain :reader method-entry-ichain)))
-
-(defclass vtmsgs ()
-  ((class :initargs :class :type sod-class :reader vtmsgs-class)
-   (body :initargs :body :type list :reader vtmsgs-body)))
-
-(defclass class-pointer ()
-  ((metaclass :initarg :metaclass
-	      :type sod-class
-	      :reader class-pointer-metaclass)
-   (ichain :initarg :chain :type ichain :reader class-pointer-ichain)))
-
-(defclass base-offset ()
-  ((class :initargs :class :type sod-class :reader base-offset-class)
-   (ichain :initargs :chain :type ichain :reader base-offset-ichain)))
-
-(defclass chain-offset ()
-  ((class :initargs :class :type sod-class :reader chain-offset-class)
-   (ichain :initargs :ichain :type ichain :reader chain-offset-ichain)
-   (target :initargs :chain :type ichain :reader chain-offset-target)))
-
-(defclass vtable ()
-  ((class :initargs :class :type sod-class :reader vtable-class)
-   (ichain :initargs :ichain :type ichain :reader vtable-ichain)
-   (body :initargs :body :type list :reader vtable-body)))
-
-;;;----- That's all, folks --------------------------------------------------
diff --git a/lex.lisp b/lex.lisp
index 46b951d..cd0a5a8 100644
--- a/lex.lisp
+++ b/lex.lisp
@@ -235,7 +235,8 @@
    ;; Words with important meanings to us.
    "class"
    "import" "load" "lisp" "typename"
-   "source" "header"
+   "code"
+   "extern"
 
    ;; Words with a meaning to C's type system.
    "char" "int" "float" "void"
@@ -284,7 +285,7 @@
 
 	 ;; Strings.
 	 ((or (char= ch #\") (char= ch #\'))
-	  (with-default-error-location (file-location lexer)
+	  (with-default-error-location ((file-location lexer))
 	    (let* ((quote ch)
 		   (string
 		    (with-output-to-string (out)
@@ -292,7 +293,7 @@
 			(flet ((getch ()
 				 (setf ch (next-char lexer))
 				 (when (null ch)
-				   (cerror* floc
+				   (cerror*
 		       "Unexpected end of file in string/character constant")
 				   (return))))
 			  (getch)
@@ -349,8 +350,18 @@
 
 	    ;; If we last munched an interesting letter, we need to skip over
 	    ;; it.  That's what the SKIP-CHAR flag is for.
+	    ;;
+	    ;; Danger, Will Robinson!  If we're' just about to eat a radix
+	    ;; letter, then the next thing must be a digit.  For example,
+	    ;; `0xfatenning' parses as a hex number followed by an identifier
+	    ;; `0xfa ttening', but `0xturning' is an octal number followed
+	    ;; by an identifier `0 xturning'.
 	    (when skip-char
-	      (setf ch (next-char lexer)))
+	      (let ((peek (next-char lexer)))
+		(unless (digit-char-p peek radix)
+		  (pushback-char lexer ch)
+		  (return-from scan-token (values :integer 0)))
+		(setf ch peek)))
 
 	    ;; Scan an integer.  While there are digits, feed them into the
 	    ;; accumulator.
@@ -434,19 +445,46 @@
    A C fragment is aware of its original location, and will bear proper #line
    markers when written out."))
 
-(defgeneric write-fragment (fragment stream)
-  (:documentation
-   "Writes a fragment to the output stream, marking its source properly.")
-
-  (:method ((fragment c-fragment) stream)
-    (with-slots (location text) fragment
-      (format stream "~&#line ~D ~S~%~A~&"
-	      (file-location-line location)
-	      (namestring (file-location-pathname location))
-	      text)
-      (format stream "#line ~D ~S~%"
-	      (1+ (position-aware-stream-line stream))
-	      (namestring (stream-pathname stream))))))
+(defun output-c-excursion (stream location thunk)
+  "Invoke THUNK surrounding it by writing #line markers to STREAM.
+
+   The first marker describes LOCATION; the second refers to the actual
+   output position in STREAM.  If LOCATION doesn't provide a line number then
+   no markers are output after all.  If the output stream isn't
+   position-aware then no final marker is output."
+
+  (let* ((location (file-location location))
+	 (line (file-location-line location))
+	 (pathname (file-location-pathname location))
+	 (namestring (and pathname (namestring pathname))))
+    (cond (line
+	   (format stream "~&#line ~D~@[ ~S~]~%" line namestring)
+	   (funcall thunk)
+	   (when (typep stream 'position-aware-stream)
+	     (fresh-line stream)
+	     (format stream "~&#line ~D ~S~%"
+		     (1+ (position-aware-stream-line stream))
+		     (namestring (stream-pathname stream)))))
+	  (t
+	   (funcall thunk)))))
+
+(defmethod print-object ((fragment c-fragment) stream)
+  (let ((text (c-fragment-text fragment))
+	(location (c-fragment-location fragment)))
+    (if *print-escape*
+	(print-unreadable-object (fragment stream :type t)
+	  (when location
+	    (format stream "~A " location))
+	  (cond ((< (length text) 40)
+		 (prin1 text stream) stream)
+		(t
+		 (prin1 (subseq text 0 40) stream)
+		 (write-string "..." stream))))
+	(output-c-excursion stream location
+			    (lambda () (write-string text stream))))))
+
+(defmethod make-load-form ((fragment c-fragment) &optional environment)
+  (make-load-form-saving-slots fragment :environment environment))
 
 (defun scan-c-fragment (lexer end-chars)
   "Snarfs a sequence of C tokens with balanced brackets.
@@ -597,7 +635,7 @@
 
       ;; Return the fragment we've collected.
       (make-instance 'c-fragment
-		     :location floc
+		     :location start-floc
 		     :text (get-output-stream-string output)))))
 
 (defun c-fragment-reader (stream char arg)
@@ -608,6 +646,9 @@
     (next-char lexer)
     (scan-c-fragment lexer '(#\}))))
 
+#+interactive
+(set-dispatch-macro-character #\# #\{ 'c-fragment-reader)
+
 ;;;--------------------------------------------------------------------------
 ;;; Testing cruft.
 
@@ -615,6 +656,8 @@
 (with-input-from-string (in "
 { foo } 'x' /?/***/!
 123 0432 0b010123 0xc0ffee __burp_32 class
+
+0xturning 0xfattening
 ...
 
 class integer : integral_domain {
diff --git a/methods.lisp b/methods.lisp
new file mode 100644
index 0000000..4a3b52d
--- /dev/null
+++ b/methods.lisp
@@ -0,0 +1,721 @@
+;;; -*-lisp-*-
+;;;
+;;; Infrastructure for effective method generation
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Simple Object Definition system.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Function type protocol.
+
+(defgeneric sod-message-argument-tail (message)
+  (:documentation
+   "Return the argument tail for the message, with invented argument names.
+
+   No `me' argument is prepended; any :ELLIPSIS is left as it is."))
+
+(defgeneric sod-message-no-varargs-tail (message)
+  (:documentation
+   "Return the argument tail for the message with :ELLIPSIS substituted.
+
+   As with SOD-MESSAGE-ARGUMENT-TAIL, no `me' argument is prepended.
+   However, an :ELLIPSIS is replaced by an argument of type `va_list', named
+   `sod__ap'."))
+
+(defgeneric direct-method-function-type (method)
+  (:documentation
+   "Return the C function type for the direct method.
+
+   This is called during initialization of a direct method object, and the
+   result is cached.
+
+   A default method is provided (by BASIC-DIRECT-METHOD) which simply
+   prepends an appropriate `me' argument to the user-provided argument list.
+   Fancy method classes may need to override this behaviour."))
+
+(defgeneric direct-method-next-method-type (method)
+  (:documentation
+   "Return the C function type for the next-method trampoline.
+
+   This is called during initialization of a direct method object, and the
+   result is cached.  It should return a function type, not a pointer type.
+
+   A default method is provided (by DELEGATING-DIRECT-METHOD) which should do
+   the right job.  Very fancy subclasses might need to do something
+   different."))
+
+(defgeneric direct-method-function-name (method)
+  (:documentation
+   "Return the C function name for the direct method."))
+
+;;;--------------------------------------------------------------------------
+;;; Message classes.
+
+(defclass basic-message (sod-message)
+  ((argument-tail :type list :reader sod-message-argument-tail)
+   (no-varargs-tail :type list :reader sod-message-no-varargs-tail))
+  (:documentation
+   "Base class for built-in message classes.
+
+   Provides the basic functionality for the built-in method combinations.
+   This is a separate class so that `special effect' messages can avoid
+   inheriting its default behaviour.
+
+   The function type protocol is implemented on BASIC-MESSAGE using slot
+   reader methods.  The actual values are computed on demand in methods
+   defined on SLOT-UNBOUND."))
+
+;;; Function type protocol.
+
+(defmethod slot-unbound (class
+			 (message basic-message)
+			 (slot-name (eql 'argument-tail)))
+  (let ((seq 0))
+    (mapcar (lambda (arg)
+	      (if (or (eq arg :ellipsis) (argument-name arg))
+		  arg
+		  (make-argument (make-instance 'temporary-argument
+						:tag (prog1 seq (incf seq)))
+				 (argument-type arg))))
+	    (c-function-arguments (sod-message-type message)))))
+
+(defmethod slot-unbound (class
+			 (message basic-message)
+			 (slot-name (eql 'no-varargs-tail)))
+  (mapcar (lambda (arg)
+	    (if (eq arg :ellipsis)
+		(make-argument *sod-ap* (c-type va-list))
+		arg))
+	  (sod-message-argument-tail message)))
+
+;;; Method class selection.
+
+(defmethod sod-message-method-class
+    ((message basic-message) (class sod-class) pset)
+  (let ((role (get-property pset :role :keyword nil)))
+    (case role
+      ((:before :after) 'daemon-direct-method)
+      (:around 'delegating-direct-method)
+      ((nil) (error "How odd: a primary method slipped through the net"))
+      (t (error "Unknown method role ~A" role)))))
+
+;;; Utility functions.
+
+(defun varargs-message-p (message)
+  "Answer whether the MESSAGE accepts a variable-length argument list.
+
+   We need to jump through some extra hoops in order to cope with varargs
+   messages, so this is useful to know."
+  (member :ellipsis (sod-message-argument-tail message)))
+
+;;;--------------------------------------------------------------------------
+;;; Direct method classes.
+
+(defclass basic-direct-method (sod-method)
+  ((role :initarg :role
+	 :type symbol
+	 :reader sod-method-role)
+   (function-type :type c-function-type
+		  :reader sod-method-function-type))
+  (:documentation
+   "Base class for built-in direct method classes.
+
+   Provides the basic functionality for the built-in direct-method classes.
+   This is a separate class so that `special effect' methods can avoid
+   inheriting its default behaviour and slots.
+
+   A basic method can be assigned a `role', which may be set either as an
+   initarg or using the :ROLE property.  Roles are used for method
+   categorization.
+
+   The function type protocol is implemented on BASIC-DIRECT-METHOD using
+   slot reader methods.  The actual values are computed on demand in methods
+   defined on SLOT-UNBOUND."))
+
+(defmethod shared-initialize :after
+    ((method basic-direct-method) slot-names &key pset)
+  (declare (ignore slot-names))
+  (default-slot (method 'role) (get-property pset :role :keyword nil)))
+
+(defmethod slot-unbound
+    (class (method basic-direct-method) (slot-name (eql 'function-type)))
+  (let ((type (sod-method-type method)))
+    (setf (slot-value method 'function-type)
+	  (c-type (fun (lisp (c-type-subtype type))
+		       ("me" (* (class (sod-method-class method))))
+		       . (c-function-arguments type))))))
+
+(defmethod direct-method-function-name ((method basic-direct-method))
+  (with-slots (class role message) method
+    (format nil "~A__~@[~(~A~)_~]method_~A__~A" class role
+	    (sod-class-nickname (sod-message-class message))
+	    (sod-message-name message))))
+
+(defclass daemon-direct-method (basic-direct-method)
+  ()
+  (:documentation
+   "A daemon direct method is invoked for side effects and cannot override.
+
+   This is the direct method class for `before' and `after' methods, which
+   cannot choose to override the remaining methods and are not involved in
+   the computation of the final result.
+
+   In C terms, a daemon method must return `void', and is not passed a
+   `next_method' pointer."))
+
+(defmethod check-method-type
+    ((method daemon-direct-method)
+     (message sod-message)
+     (type c-function-type))
+  (with-slots ((msgtype type)) message
+    (unless (c-type-equal-p (c-type-subtype type) (c-type void))
+      (error "Method return type ~A must be `void'" (c-type-subtype type)))
+    (unless (argument-lists-compatible-p (c-function-arguments msgtype)
+					 (c-function-arguments type))
+      (error "Method arguments ~A don't match message ~A" type msgtype))))
+
+(defclass delegating-direct-method (basic-direct-method)
+  ((next-method-type :type c-function-type
+		     :reader sod-method-next-method-type))
+  (:documentation
+   "A delegating direct method can choose to override other methods.
+
+   This is the direct method class for `around' and standard-method-
+   combination primary methods, which are given the choice of computing the
+   entire method's result or delegating to (usually) less-specific methods.
+
+   In C terms, a delegating method is passed a `next_method' pointer so that
+   it can delegate part of its behaviour.  (A delegating direct method for a
+   varargs message is also given an additional `va_list' argument,
+   conventionally named `sod__ap_master', which it is expected to pass on to
+   its `next_method' function if necessary.)
+
+   The function type protocol is implemented on DELEGATING-DIRECT-METHOD
+   using slot reader methods.  The actual values are computed on demand in
+   methods defined on SLOT-UNBOUND."))
+
+(defmethod slot-unbound (class
+			 (method delegating-direct-method)
+			 (slot-name (eql 'next-method-type)))
+  (let* ((message (sod-method-message method))
+	 (type (sod-message-type message)))
+    (setf (slot-value method 'next-method-type)
+	  (c-type (fun (lisp (c-type-subtype type))
+		       ("me" (* (class (sod-method-class method))))
+		       . (c-function-arguments type))))))
+
+(defmethod slot-unbound (class
+			 (method delegating-direct-method)
+			 (slot-name (eql 'function-type)))
+  (let* ((message (sod-method-message method))
+	 (type (sod-method-type method))
+	 (method-args (c-function-arguments type)))
+    (setf (slot-value method 'function-type)
+	  (c-type (fun (lisp (c-type-subtype type))
+		       ("me" (* (class (sod-method-class method))))
+		       ("next_method" (* (lisp (commentify-function-type
+						(sod-method-next-method-type
+						 method)))))
+		       . (if (varargs-message-p message)
+			     (cons (make-argument *sod-master-ap*
+						  (c-type va-list))
+				   method-args)
+			     method-args))))))
+
+;;;--------------------------------------------------------------------------
+;;; Effective method classes.
+
+(defgeneric effective-method-basic-argument-names (method)
+  (:documentation
+   "Return a list of argument names to be passed to direct methods.
+
+   The argument names are constructed from the message's arguments returned
+   by SOD-MESSAGE-NO-VARARGS-TAIL.  The basic arguments are the ones
+   immediately derived from the programmer's explicitly stated arguments; the
+   `me' argument is not included, and neither are more exotic arguments added
+   as part of the method delegation protocol."))
+
+(defclass basic-effective-method (effective-method)
+  ((around-methods :initarg :around-methods
+		   :initform nil
+		   :type list
+		   :reader effective-method-around-methods)
+   (before-methods :initarg :before-methods
+		   :initform nil
+		   :type list
+		   :reader effective-method-before-methods)
+   (after-methods :initarg :after-methods
+		  :initform nil
+		  :type list
+		  :reader effective-method-after-methods)
+   (basic-argument-names :type list
+			 :reader effective-method-basic-argument-names)
+   (functions :type list :reader effective-method-functions))
+  (:documentation
+   "Base class for built-in effective method classes.
+
+   This class maintains lists of the applicable `before', `after' and
+   `around' methods and provides behaviour for invoking these methods
+   correctly.
+
+   The argument names protocol is implemented on BASIC-EFFECTIVE-METHOD using
+   a slot reader method.  The actual values are computed on demand in methods
+   defined on SLOT-UNBOUND."))
+
+(defmethod slot-unbound (class
+			 (method basic-effective-method)
+			 (slot-name (eql 'basic-argument-names)))
+  (let ((message (effective-method-message method)))
+    (setf (slot-value method 'basic-argument-names)
+	  (subst *sod-master-ap* *sod-ap*
+		 (mapcar #'argument-name
+			 (sod-message-no-varargs-tail message))))))
+
+;;;--------------------------------------------------------------------------
+;;; Method categorization.
+
+(defmacro categorize ((itemvar items &key bind) categories &body body)
+  "Categorize ITEMS into lists and invoke BODY.
+
+   The ITEMVAR is a symbol; as the macro iterates over the ITEMS, ITEMVAR
+   will contain the current item.  The BIND argument is a list of LET*-like
+   clauses.  The CATEGORIES are a list of clauses of the form (SYMBOL
+   PREDICATE).
+
+   The behaviour of the macro is as follows.  ITEMVAR is assigned (not
+   bound), in turn, each item in the list ITEMS.  The PREDICATEs in the
+   CATEGORIES list are evaluated in turn, in an environment containing
+   ITEMVAR and the BINDings, until one of them evaluates to a non-nil value.
+   At this point, the item is assigned to the category named by the
+   corresponding SYMBOL.  If none of the PREDICATEs returns non-nil then an
+   error is signalled; a PREDICATE consisting only of T will (of course)
+   match anything; it is detected specially so as to avoid compiler warnings.
+
+   Once all of the ITEMS have been categorized in this fashion, the BODY is
+   evaluated as an implicit PROGN.  For each SYMBOL naming a category, a
+   variable named after that symbol will be bound in the BODY's environment
+   to a list of the items in that category, in the same order in which they
+   were found in the list ITEMS.  The final values of the macro are the final
+   values of the BODY."
+
+  (let* ((cat-names (mapcar #'car categories))
+	 (cat-match-forms (mapcar #'cadr categories))
+	 (cat-vars (mapcar (lambda (name) (gensym (symbol-name name)))
+			   cat-names))
+	 (items-var (gensym "ITEMS")))
+    `(let ((,items-var ,items)
+	   ,@(mapcar (lambda (cat-var) (list cat-var nil)) cat-vars))
+       (dolist (,itemvar ,items-var)
+	 (let* ,bind
+	   (cond ,@(mapcar (lambda (cat-match-form cat-var)
+			     `(,cat-match-form
+			       (push ,itemvar ,cat-var)))
+			   cat-match-forms cat-vars)
+		 ,@(and (not (member t cat-match-forms))
+			`((t (error "Failed to categorize ~A" ,itemvar)))))))
+       (let ,(mapcar (lambda (name var)
+		       `(,name (nreverse ,var)))
+		     cat-names cat-vars)
+	 ,@body))))
+
+;;;--------------------------------------------------------------------------
+;;; Code generation.
+
+(defclass method-codegen (codegen)
+  ((message :initarg :message :type sod-message :reader codegen-message)
+   (class :initarg :class :type sod-class :reader codegen-class)
+   (method :initarg :method :type effective-method :reader codegen-method)
+   (target :initarg :target :reader codegen-target))
+  (:documentation
+   "Augments CODEGEN with additional state regarding an effective method.
+
+   We store the effective method, and also its target class and owning
+   message, so that these values are readily available to the code-generating
+   functions."))
+
+(defmethod shared-initialize :after
+    ((codegen method-codegen) slot-names &key)
+  (with-slots (message target) codegen
+    (setf target
+	  (if (eq (c-type-subtype (sod-message-type message)) (c-type void))
+	      :void
+	      :return))))
+
+(defgeneric compute-effective-method-body (method codegen target)
+  (:documentation
+   "Generates the body of an effective method.
+
+   Writes the function body to the code generator.  It can (obviously)
+   generate auxiliary functions if it needs to.
+
+   The arguments are as specified by the SOD-MESSAGE-NO-VARARGS-TAIL, with an
+   additional argument `sod__obj' of type pointer-to-ilayout.  The code
+   should deliver the result (if any) to the TARGET."))
+
+(defun invoke-method (codegen target arguments-tail direct-method)
+  "Emit code to invoke DIRECT-METHOD, passing it ARGUMENTS-TAIL.
+
+   The code is generated in the context of CODEGEN, which can be any instance
+   of the CODEGEN class -- it needn't be an instance of METHOD-CODEGEN.  The
+   DIRECT-METHOD is called with the given ARGUMENTS-TAIL (a list of argument
+   expressions), preceded by a `me' argument of type pointer-to-CLASS where
+   CLASS is the class on which the method was defined.
+
+   If the message accepts a variable-length argument list then a copy of the
+   prevailing master argument pointer is provided in place of the :ELLIPSIS."
+
+  (let* ((message (sod-method-message direct-method))
+	 (class (sod-method-class direct-method))
+	 (function (direct-method-function-name direct-method))
+	 (arguments (cons (format nil "(~A *)&sod__obj.~A" class
+				  (sod-class-nickname
+				   (sod-class-chain-head class)))
+			  arguments-tail)))
+    (if (varargs-message-p message)
+	(convert-stmts codegen target
+		       (c-type-subtype (sod-method-type direct-method))
+		       (lambda (var)
+			 (ensure-var codegen *sod-ap* (c-type va-list))
+			 (emit-inst codegen
+				    (make-va-copy-inst *sod-ap*
+						       *sod-master-ap*))
+			 (deliver-expr codegen var
+				       (make-call-inst function arguments))
+			 (emit-inst codegen
+				    (make-va-end-inst *sod-ap*))))
+	(deliver-expr codegen target (make-call-inst function arguments)))))
+
+(definst convert-to-ilayout (stream) (class chain-head expr)
+  (format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)"
+	  class (sod-class-nickname chain-head) expr))
+
+(defun ensure-ilayout-var (codegen super)
+  "Define a variable `sod__obj' pointing to the class's ilayout structure.
+
+   CODEGEN is a METHOD-CODEGEN.  The class in question is CODEGEN's class,
+   i.e., the target class for the effective method.  SUPER is one of the
+   class's superclasses; it is assumed that `me' is a pointer to a SUPER
+   (i.e., to SUPER's ichain within the ilayout)."
+
+  (let* ((class (codegen-class codegen))
+	 (super-head (sod-class-chain-head super)))
+    (ensure-var codegen "sod__obj"
+		(c-type (* (struct (ilayout-struct-tag class))))
+		(make-convert-to-ilayout-inst class super-head "me"))))
+
+(defun make-trampoline (codegen super body)
+  "Construct a trampoline function and return its name.
+
+   CODEGEN is a METHOD-CODEGEN.  SUPER is a superclass of the CODEGEN class.
+   We construct a new trampoline function (with an unimaginative name)
+   suitable for being passed to a direct method defined on SUPER as its
+   `next_method'.  In particular, it will have a `me' argument whose type is
+   pointer-to-SUPER.
+
+   The code of the function is generated by BODY, which will be invoked with
+   a single argument which is the TARGET to which it should deliver its
+   result.
+
+   The return value is the name of the generated function."
+
+  (let* ((message (codegen-message codegen))
+	 (message-type (sod-message-type message))
+	 (return-type (c-type-subtype message-type))
+	 (arguments (mapcar (lambda (arg)
+			      (if (eq (argument-name arg) *sod-ap*)
+				  (make-argument *sod-master-ap*
+						 (c-type va-list))
+				  arg))
+			    (sod-message-no-varargs-tail message))))
+    (codegen-push codegen)
+    (ensure-ilayout-var codegen super)
+    (funcall body (codegen-target codegen))
+    (codegen-pop-function codegen (temporary-function)
+			  (c-type (fun (lisp return-type)
+				       ("me" (* (class super)))
+				       . arguments))))))
+
+(defun invoke-delegation-chain (codegen target basic-tail chain kernel)
+  "Invoke a chain of delegating methods.
+
+   CODEGEN is a METHOD-CODEGEN.  BASIC-TAIL is a list of argument expressions
+   to provide to the methods.  The result of the delegation chain will be
+   delivered to TARGET.
+
+   The CHAIN is a list of DELEGATING-DIRECT-METHOD objects.  The behaviour is
+   as follows.  The first method in the chain is invoked with the necessary
+   arguments (see below) including a `next_method' pointer.  If KERNEL is nil
+   and there are no more methods in the chain then the `next_method' pointer
+   will be null; otherwise it will point to a `trampoline' function, whose
+   behaviour is to call the remaining methods on the chain as a delegation
+   chain.  The method may choose to call this function with its arguments.
+   It will finally return a value, which will be delivered to the TARGET.
+
+   If the chain is empty, then the code generated by KERNEL (given a TARGET
+   argument) will be invoked.  It is an error if both CHAIN and KERNEL are
+   nil."
+
+  (let* ((message (codegen-message codegen))
+	 (argument-tail (if (varargs-message-p message)
+			    (cons *sod-master-ap* basic-tail)
+			    basic-tail)))
+    (labels ((next-trampoline (method chain)
+	       (if (or kernel chain)
+		   (make-trampoline codegen (sod-method-class method)
+				    (lambda (target)
+				      (invoke chain target)))
+		   0))
+	     (invoke (chain target)
+	       (if (null chain)
+		   (funcall kernel target)
+		   (let* ((trampoline (next-trampoline (car chain)
+						       (cdr chain))))
+		     (invoke-method codegen target
+				    (cons trampoline argument-tail)
+				    (car chain))))))
+      (invoke chain target))))
+
+(defun basic-effective-method-body (codegen target method body)
+  "Build the common method-invocation structure.
+
+   Writes to CODEGEN some basic method-invocation instructions.  It invokes
+   the `around' methods, from most- to least-specific.  If they all delegate,
+   then the `before' methods are run, most-specific first; next, the
+   instructions generated by BODY (invoked with a target argument); then, the
+   `after' methods are run, least-specific first; and, finally, the value
+   delivered by the BODY is returned to the `around' methods.  The result
+   returned by the outermost `around' method -- or, if there are none,
+   delivered by the BODY -- is finally delivered to the TARGET."
+
+  (with-slots (message class before-methods after-methods around-methods)
+      method
+    (let* ((message-type (sod-message-type message))
+	   (return-type (c-type-subtype message-type))
+	   (voidp (eq return-type (c-type void)))
+	   (basic-tail (effective-method-basic-argument-names method)))
+      (flet ((method-kernel (target)
+	       (dolist (before before-methods)
+		 (invoke-method codegen :void basic-tail before))
+	       (if (or voidp (null after-methods))
+		   (funcall body target)
+		   (convert-stmts codegen target return-type
+				  (lambda (target)
+				    (funcall body target)
+				    (dolist (after (reverse after-methods))
+				      (invoke-method codegen :void
+						     after basic-tail)))))))
+	(invoke-delegation-chain codegen target basic-tail
+				 around-methods #'method-kernel)))))
+
+;;;--------------------------------------------------------------------------
+;;; Effective method entry points.
+
+(defgeneric compute-method-entry-functions (method)
+  (:documentation
+   "Construct method entry functions.
+
+   Builds the effective method function (if there is one) and the necessary
+   method entries.  Returns a list of functions (i.e., FUNCTION-INST objects)
+   which need to be defined in the generated source code."))
+
+(defparameter *method-entry-inline-threshold* 20
+  "Threshold below which effective method bodies are inlined into entries.
+
+   After the effective method body has been computed, we calculate its
+   metric, multiply by the number of entries we need to generate, and compare
+   it with this threshold.  If the metric is below the threshold then we
+   fold the method body into the entry functions; otherwise we split the
+   effective method out into its own function.")
+
+(defgeneric effective-method-function-name (method)
+  (:documentation
+   "Returns the function name of an effective method."))
+
+(defgeneric method-entry-function-name (method chain-head)
+  (:documentation
+   "Returns the function name of a method entry.
+
+   The method entry is given as an effective method/chain-head pair, rather
+   than as a method entry object because we want the function name before
+   we've made the entry object."))
+
+(defmethod effective-method-function-name ((method effective-method))
+  (let* ((class (effective-method-class method))
+	 (message (effective-method-message method))
+	 (message-class (sod-message-class message)))
+    (format nil "~A__emethod_~A__~A"
+	    class
+	    (sod-class-nickname message-class)
+	    (sod-message-name message))))
+
+(defmethod method-entry-function-name
+    ((method effective-method) (chain-head sod-class))
+  (let* ((class (effective-method-class method))
+	 (message (effective-method-message method))
+	 (message-class (sod-message-class message)))
+    (format nil "~A__mentry_~A__~A__~A"
+	    class
+	    (sod-class-nickname message-class)
+	    (sod-message-name message)
+	    (sod-class-nickname chain-head))))
+
+(defmethod compute-method-entry-functions ((method basic-effective-method))
+
+  ;; OK, there's quite a lot of this, so hold tight.
+  ;;
+  ;; The first thing we need to do is find all of the related objects.  This
+  ;; is a bit verbose but fairly straightforward.
+  ;;
+  ;; Next, we generate the effective method body -- using COMPUTE-EFFECTIVE-
+  ;; METHOD-BODY of all things.  This gives us the declarations and body for
+  ;; an effective method function, but we don't have an actual function yet.
+  ;;
+  ;; Now we look at the chains which are actually going to need a method
+  ;; entry: only those chains whose tail (most specific) class is a
+  ;; superclass of the class which defined the message need an entry.  We
+  ;; build a list of these tail classes.
+  ;;
+  ;; Having done this, we decide whether it's better to generate a standalone
+  ;; effective-method function and call it from each of the method entries,
+  ;; or to inline the effective method body into each of the entries.
+  ;;
+  ;; Most of the complexity here comes from (a) dealing with the two
+  ;; different strategies for constructing method entry functions and (b)
+  ;; (unsurprisingly) the mess involved with dealing with varargs messages.
+
+  (let* ((message (effective-method-message method))
+	 (class (effective-method-class method))
+	 (message-class (sod-message-class message))
+	 (return-type (c-type-subtype (sod-message-type message)))
+	 (codegen (make-instance 'method-codegen
+				 :message message
+				 :class class
+				 :method method))
+
+	 ;; Effective method function details.
+	 (emf-name (effective-method-function-name method))
+	 (ilayout-type (c-type (* (struct (ilayout-struct-tag class)))))
+	 (emf-arg-tail (mapcar (lambda (arg)
+				 (if (eq (argument-name arg) *sod-ap*)
+				     (make-argument *sod-master-ap*
+						    (c-type va-list))
+				     arg))
+			       (sod-message-no-varargs-tail message)))
+	 (emf-type (c-type (fun (lisp return-type)
+				("sod__obj" (lisp ilayout-type))
+				. (sod-message-no-varargs-tail message))))
+	 (result (if (eq return-type (c-type void)) nil
+		     (temporary-var codegen return-type)))
+	 (emf-target (or result :void))
+
+	 ;; Method entry details.
+	 (chain-tails (remove-if-not (lambda (super)
+				       (sod-subclass-p super message-class))
+				     (mapcar #'car
+					     (sod-class-chains class))))
+	 (n-entries (length chain-tails))
+	 (entry-args (sod-message-argument-tail message))
+	 (parm-n (do ((prev "me" (car args))
+		      (args entry-args (cdr args)))
+		     ((endp args) nil)
+		   (when (eq (car args) :ellipsis)
+		     (return prev))))
+	 (entry-target (codegen-target codegen)))
+
+    (labels ((setup-entry (tail)
+	       (let ((head (sod-class-chain-head tail)))
+		 (codegen-push codegen)
+		 (ensure-var codegen "sod__obj" ilayout-type
+			     (make-convert-to-ilayout-inst class
+							   head "me"))))
+	     (varargs-prologue ()
+	       (ensure-var codegen *sod-master-ap* (c-type va-list))
+	       (emit-inst codegen
+			  (make-va-start-inst *sod-master-ap* parm-n)))
+	     (varargs-epilogue ()
+	       (emit-inst codegen (make-va-end-inst *sod-master-ap*)))
+	     (finish-entry (tail)
+	       (let* ((head (sod-class-chain-head tail))
+		      (name (method-entry-function-name method head))
+		      (type (c-type (fun (lisp return-type)
+					 ("me" (* (class tail)))
+					 . entry-args))))
+		 (codegen-pop-function codegen name type))))
+
+      ;; Generate the method body.  We'll work out what to do with it later.
+      (codegen-push codegen)
+      (compute-effective-method-body method codegen emf-target)
+      (multiple-value-bind (vars insts) (codegen-pop codegen)
+	(cond ((or (= n-entries 1)
+		   (<= (* n-entries (reduce #'+ insts :key #'inst-metric))
+		       *method-entry-inline-threshold*))
+
+	       ;; The effective method body is simple -- or there's only one
+	       ;; of them.  We'll inline the method body into the entry
+	       ;; functions.
+	       (dolist (tail chain-tails)
+		 (setup-entry tail)
+		 (dolist (var vars)
+		   (ensure-var codegen (inst-name var)
+			       (inst-type var) (inst-init var)))
+		 (when parm-n (varargs-prologue))
+		 (emit-insts codegen insts)
+		 (when parm-n (varargs-epilogue))
+		 (deliver-expr codegen entry-target result)
+		 (finish-entry tail)))
+
+	      (t
+
+	       ;; The effective method body is complicated and we'd need more
+	       ;; than one copy.  We'll generate an effective method function
+	       ;; and call it a lot.
+	       (codegen-build-function codegen emf-name emf-type vars
+		(nconc insts (and result (list (make-return-inst result)))))
+
+	       (let ((call (make-call-inst emf-name
+			    (cons "sod__obj" (mapcar #'argument-name
+						     emf-arg-tail)))))
+		 (dolist (tail chain-tails)
+		   (setup-entry tail)
+		   (cond (parm-n
+			  (varargs-prologue)
+			  (convert-stmts codegen entry-target return-type
+					 (lambda (target)
+					   (deliver-expr codegen target call)
+					   (varargs-epilogue))))
+			 (t
+			  (deliver-expr codegen entry-target call)))
+		   (finish-entry tail))))))
+
+      (codegen-functions codegen))))
+
+(defmethod slot-unbound
+    (class (method basic-effective-method) (slot-name (eql 'functions)))
+  (setf (slot-value method 'functions)
+	(compute-method-entry-functions method)))
+
+(defmethod make-method-entry
+    ((method basic-effective-method) (chain-head sod-class))
+  (make-instance 'method-entry :method method :chain-head chain-head))
+
+;;;----- That's all, folks --------------------------------------------------
diff --git a/module.lisp b/module.lisp
index 2575b39..bcfc912 100644
--- a/module.lisp
+++ b/module.lisp
@@ -169,7 +169,7 @@
 	 ;; might not work very well, but it could be worth a shot.)
 	 (if module
 	     (setf (gethash truename *module-map*) module)
-	     (remhash truename *module-map*))))
+	     (remhash truename *module-map*)))
 
       ;; A module which is being read can't be included again.
       ((eql module :in-progress)
diff --git a/output.lisp b/output.lisp
index 44ec6e2..67d2907 100644
--- a/output.lisp
+++ b/output.lisp
@@ -26,6 +26,135 @@
 (cl:in-package #:sod)
 
 ;;;--------------------------------------------------------------------------
+;;; Sequencing machinery.
+
+(defclass sequencer-item ()
+  ((name :initarg :name
+	 :reader sequencer-item-name)
+   (functions :initarg :functions
+	      :initform nil
+	      :type list
+	      :accessor sequencer-item-functions))
+  (:documentation
+   "Represents a distinct item to be sequenced by a SEQUENCER.
+
+   A SEQUENCER-ITEM maintains a list of FUNCTIONS which are invoked when the
+   sequencer is invoked.  This class is not intended to be subclassed."))
+
+(defmethod print-object ((item sequencer-item) stream)
+  (print-unreadable-object (item stream :type t)
+    (prin1 (sequencer-item-name item) stream)))
+
+(defclass sequencer ()
+  ((constraints :initarg :constraints
+		:initform nil
+		:type list
+		:accessor sequencer-constraints)
+   (table :initform (make-hash-table :test #'equal)
+	  :reader sequencer-table))
+  (:documentation
+   "A sequencer tracks items and invokes them in the proper order.
+
+   The job of a SEQUENCER object is threefold.  Firstly, it collects
+   sequencer items and stores them in its table indexed by name.  Secondly,
+   it gathers CONSTRAINTS, which impose an ordering on the items.  Thirdly,
+   it can be instructed to invoke the items in an order compatible with the
+   established constraints.
+
+   Sequencer item names may may any kind of object which can be compared with
+   EQUAL.  In particular, symbols, integers and strings are reasonable
+   choices for atomic names, and lists work well for compound names -- so
+   it's possible to construct a hierarchy."))
+
+(defgeneric ensure-sequencer-item (sequencer name)
+  (:documentation
+   "Arrange that SEQUENCER has a sequencer-item called NAME.
+
+   Returns the corresponding SEQUENCER-ITEM object."))
+
+(defgeneric add-sequencer-constraint (sequencer constraint)
+  (:documentation
+   "Attach the given CONSTRAINT to an SEQUENCER.
+
+   The CONSTRAINT should be a list of sequencer-item names; see
+   ENSURE-SEQUENCER-ITEM for what they look like.  Note that the names
+   needn't have been declared in advance; indeed, they needn't be mentioned
+   anywhere else at all."))
+
+(defgeneric add-sequencer-item-function (sequencer name function)
+  (:documentation
+   "Arranges to call FUNCTION when the item called NAME is traversed.
+
+   More than one function can be associated with a given sequencer item.
+   They are called in the same order in which they were added.
+
+   Note that an item must be mentioned in at least one constraint in order to
+   be traversed by INVOKE-SEQUENCER-ITEMS.  If there are no special ordering
+   requirments for a particular item, then the trivial constraint (NAME) will
+   suffice."))
+
+(defgeneric invoke-sequencer-items (sequencer &rest arguments)
+  (:documentation
+   "Invoke functions attached to the SEQUENCER's items in the right order.
+
+   Each function is invoked in turn with the list of ARGUMENTS.  The return
+   values of the functions are discarded."))
+
+(defmethod ensure-sequencer-item ((sequencer sequencer) name)
+  (with-slots (table) sequencer
+    (or (gethash name table)
+	(setf (gethash name table)
+	      (make-instance 'sequencer-item :name name)))))
+
+(defmethod add-sequencer-constraint ((sequencer sequencer) (constraint list))
+  (let ((converted-constraint (mapcar (lambda (name)
+					(ensure-sequencer-item sequencer
+							       name))
+				      constraint)))
+    (with-slots (constraints) sequencer
+      (pushnew converted-constraint constraints :test #'equal))))
+
+(defmethod add-sequencer-item-function ((sequencer sequencer) name function)
+  (let ((item (ensure-sequencer-item sequencer name)))
+    (pushnew function (sequencer-item-functions item))))
+
+(defmethod invoke-sequencer-items ((sequencer sequencer) &rest arguments)
+  (dolist (item (merge-lists (reverse (sequencer-constraints sequencer))))
+    (dolist (function (reverse (sequencer-item-functions item)))
+      (apply function arguments))))
+
+;;;--------------------------------------------------------------------------
+;;; Output preparation.
+
+(defgeneric add-output-hooks (object reason sequencer)
+  (:documentation
+   "Announces the intention to write SEQUENCER, with a particular REASON.
+
+   The SEQUENCER is an SEQUENCER instance; the REASON will be a symbol which
+   can be matched using an EQL-specializer.  In response, OBJECT should add
+   any constrains and item functions that it wishes, and pass the
+   announcement to its sub-objects.")
+  (:method-combination progn)
+  (:method progn (object reason sequencer)
+    nil))
+
+(defvar *seen-announcement*)		;Keep me unbound!
+#+hmm
+(defmethod add-output-hooks :around (object reason sequencer &rest stuff)
+  "Arrange not to invoke any object more than once during a particular
+   announcement."
+  (declare (ignore stuff))
+  (cond ((not (boundp '*seen-announcement*))
+	 (let ((*seen-announcement* (make-hash-table)))
+	   (setf (gethash object *seen-announcement*) t)
+	   (call-next-method)))
+	((gethash object *seen-announcement*)
+	 nil)
+	(t
+	 (setf (gethash object *seen-announcement*) t)
+	 (call-next-method))))
+
+;;;--------------------------------------------------------------------------
 ;;; Utilities.
 
 (defun banner (title output &key (blank-line-p t))
@@ -90,7 +219,7 @@
 	  (when (module-header-fragments module)
 	    (banner "User code" output)
 	    (dolist (frag (module-header-fragments module))
-	      (write-fragment frag output)))
+	      (princ frag output)))
 
 	  ;; The definitions of the necessary structures.
 	  ;;
@@ -137,7 +266,7 @@
 	  (when (module-source-fragments module)
 	    (banner "User code" output)
 	    (dolist (frag (module-source-fragments module))
-	      (write-fragment frag output)))
+	      (princ frag output)))
 
 	  ;; The definitions of the necessary tables.
 	  ;;
diff --git a/parse-c-types.lisp b/parse-c-types.lisp
index 702ae77..d273045 100644
--- a/parse-c-types.lisp
+++ b/parse-c-types.lisp
@@ -407,6 +407,9 @@
 		   (return)))
 	       (setf dims (nreverse dims))
 	       (push (lambda (ty)
+		       (when (typep ty 'c-function-type)
+			 (error "Array element type cannot be ~
+				 a function type"))
 		       (make-instance 'c-array-type
 				      :dimensions dims
 				      :subtype ty))
@@ -438,7 +441,6 @@
 
 	       ;; Catch: if the only thing in the list is `void' (with no
 	       ;; identifier) then kill the whole thing.
-	       (break)
 	       (setf args
 		     (if (and args
 			      (null (cdr args))
@@ -449,6 +451,9 @@
 
 	       ;; Stash the operator.
 	       (push (lambda (ty)
+		       (when (typep ty '(or c-function-type c-array-type))
+			 (error "Function return type cannot be ~
+				 a function or array type"))
 		       (make-instance 'c-function-type
 				      :arguments args
 				      :subtype ty))
@@ -486,7 +491,8 @@
 (with-input-from-string (in "
 //  int stat(struct stat *st)
 //  void foo(void)
-    int vsnprintf(size_t n, char *buf, va_list ap)
+//  int vsnprintf(size_t n, char *buf, va_list ap)
+//  size_t size_t;
 //  int (*signal(int sig, int (*handler)(int s)))(int t)
 ")
   (let* ((stream (make-instance 'position-aware-input-stream
@@ -498,10 +504,10 @@
     (next-token lex)
     (let ((ty (parse-c-type lex)))
       (multiple-value-bind (type name) (parse-c-declarator lex ty)
-	(multiple-value-bind (typestr declstr) (c-declaration type name)
-	  (list ty
-		(list type name)
-		(list typestr declstr)
+	(list ty
+	      (list type name)
+	      (with-output-to-string (out)
+		(pprint-c-type type out name)
 		(format-token lex)))))))
 
 ;;;----- That's all, folks --------------------------------------------------
diff --git a/posn-stream.lisp b/posn-stream.lisp
index b687ad0..6aa1a1f 100644
--- a/posn-stream.lisp
+++ b/posn-stream.lisp
@@ -89,11 +89,13 @@
     (make-file-location (stream-pathname stream) nil nil)))
 
 (defmethod print-object ((object file-location) stream)
-  (if *print-escape*
-      (call-next-method)
-      (with-slots (pathname line column) object
-	(format stream "~:[<unnamed>~;~:*~A~]~@[:~D~]~@[:~D~]"
-		pathname line column))))
+  (maybe-print-unreadable-object (object stream :type t)
+    (with-slots (pathname line column) object
+      (format stream "~:[<unnamed>~;~:*~A~]~@[:~D~]~@[:~D~]"
+	      pathname line column))))
+
+(defmethod make-load-form ((object file-location) &optional environment)
+  (make-load-form-saving-slots object :environment environment))
 
 ;;;--------------------------------------------------------------------------
 ;;; Proxy streams.
diff --git a/pset.lisp b/pset.lisp
index f1c1172..67a77fc 100644
--- a/pset.lisp
+++ b/pset.lisp
@@ -39,11 +39,13 @@
 
 (defun property-type (value)
   "Guess the right property type to use for VALUE."
-  (etypecase value
+  (typecase value
     (symbol :symbol)
     (integer :integer)
     (string :string)
-    (c-fragment :frag)))
+    (character :char)
+    (c-fragment :frag)
+    (t :other)))
 
 (defstruct (property
 	     (:conc-name p-)
@@ -87,7 +89,6 @@
    processed; don't put colons in package names if you want to use them from
    SOD property sets."
 
-  (declare (optimize debug))
   (let* ((length (length string))
 	 (colon (position #\: string)))
     (multiple-value-bind (start internalp)
@@ -120,18 +121,17 @@
    "Convert VALUE, a property of type TYPE, to be of type WANTED.")
 
   ;; If TYPE matches WANTED, we'll assume that VALUE already has the right
-  ;; form.
-  (:method :around (value type wanted)
-    (if (eq type wanted)
-	value
-	(call-next-method)))
-
-  ;; If nothing else matched, then I guess we'll have to say it didn't work.
+  ;; form.  Otherwise, if nothing else matched, then I guess we'll have to
+  ;; say it didn't work.
   (:method (value type wanted)
     (if (eql type wanted)
 	value
 	(error "Incorrect type: expected ~A but found ~A" wanted type)))
 
+  ;; If the caller asks for type T then give him the raw thing.
+  (:method (value type (wanted (eql t)))
+    value)
+
   ;; Keywords.
   (:method ((value symbol) (type (eql :symbol)) (wanted (eql :keyword)))
     value)
@@ -158,10 +158,10 @@
    the value and its file location.  In the latter case, mark the property as
    having been used.
 
-   The value returned depends on the TYPE argument provided.  If you pass T
-   (meaning any type) then you get back the entire PROPERTY object.
-   Otherwise the value is coerced to the right kind of thing (where possible)
-   and returned."
+   The value returned depends on the TYPE argument provided.  If you pass NIL
+   then you get back the entire PROPERTY object.  If you pass T, then you get
+   whatever was left in the property set, uninterpreted.  Otherwise the value
+   is coerced to the right kind of thing (where possible) and returned."
 
   (let ((prop (find name pset :key #'p-key)))
     (with-default-error-location ((and prop (p-location prop)))
@@ -182,7 +182,7 @@
   (dolist (prop pset)
     (unless (p-seenp prop)
       (cerror*-with-location (p-location prop) "Unknown property `~A'"
-			     (p-name prop)))))a
+			     (p-name prop)))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Property set parsing.
@@ -190,8 +190,8 @@
 (defun parse-expression (lexer)
   "Parse an expression from the LEXER.
 
-   The return values are the expression's VALUE and TYPE; currently the
-   types are :ID, :INTEGER and :STRING.  If an error prevented a sane value
+   The return values are the expression's VALUE and TYPE; currently the types
+   are :ID, :INTEGER, :STRING, and :CHAR.  If an error prevented a sane value
    being produced, the TYPE :INVALID is returned.
 
    Expression syntax is rather limited at the moment:
@@ -283,7 +283,7 @@
 
 	       ;; Aha.  A primary.  Push it onto the stack, and see if
 	       ;; there's an infix operator.
-	       ((:integer :id :string)
+	       ((:integer :id :string :char)
 		(push (cons (token-type lexer)
 			    (token-value lexer))
 		      valstack)
diff --git a/sod-tut.tex b/sod-tut.tex
new file mode 100644
index 0000000..cff9859
--- /dev/null
+++ b/sod-tut.tex
@@ -0,0 +1,228 @@
+%%% -*-latex-*-
+%%%
+%%% Tutorial information
+%%%
+%%% (c) 2009 Straylight/Edgeware
+%%%
+
+%%%----- Licensing notice ---------------------------------------------------
+%%%
+%%% This file is part of the Simple Object Definition system.
+%%%
+%%% SOD is free software; you can redistribute it and/or modify
+%%% it under the terms of the GNU General Public License as published by
+%%% the Free Software Foundation; either version 2 of the License, or
+%%% (at your option) any later version.
+%%%
+%%% SOD is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+%%% GNU General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License
+%%% along with SOD; if not, write to the Free Software Foundation,
+%%% Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+\chapter{Tutorial}
+\label{ch:tut}
+
+This chapter provides a tutorial introduction to the Sod object system.  It
+intentionally misses out nitty-gritty details.  If you want those, the
+remaining chapters provide a complete reference to Sod.
+
+The author isn't terribly good at writing tutorial-style documentation.
+You'll have to bear with him.  If you think you can do a better job, I'm sure
+that he'll be grateful for your contribution.
+
+%%%--------------------------------------------------------------------------
+\section{Introduction} \label{sec:tut.intro}
+
+Sod is an object system for the C~programming language.  Because it doesn't
+have enough already.  Actually, that's not right: it's got plenty already.
+But Sod is a Sensible Object Design, and C doesn't have any of those.
+
+What does that mean when the author's not off on one of his tirades?  It
+means that is has the following features.
+\begin{itemize}
+\item It has a \emph{minimal runtime system}.  Sod isn't likely to interfere
+  with other language runtimes or be difficult to deal with from a practical
+  point of view.
+\item It provides \emph{multiple inheritance}.  Rather than having a single
+  superclass, Sod allows a class to specify any number of superclasses.
+  Moreover, it implements multiple inheritance using \emph{superclass
+    linearization}, which means that it's not a nightmare to deal with.
+\item It provides multiple \emph{method rÃ´les}, including `before', `after'
+  and `around' methods, which makes constructing object protocols rather more
+  straightforward.
+\item It provides a number of \emph{method combinations}.  For those coming
+  from languages other than Lisp, a method combination is a rule for deciding
+  how to invoke the various methods which might be used to respond to a
+  message.  (This might still sound like a strange idea.  We'll deal with it
+  in detail later.)
+\item It allows \emph{user-defined method combinations}.  It does a whole lot
+  more: there's an entire translation-time \emph{meta-object protocol}, so
+  that extensions can modify many different aspects of the object system.
+  The downside is that you have to learn Common Lisp and roll up your sleeves
+  if you want to do any of this.
+\end{itemize}
+There's a good chance that half of that didn't mean anything to you.  Bear
+with me, though, because we'll explain it all eventually.
+
+\subsection{Building programs with Sod} \label{sec:tut.intro.build}
+
+Sod is basically a fancy preprocessor, in the same vein as Lex and Yacc.  It
+reads source files written in a vaguely C-like language.  It produces output
+files which are actually C code (both header files and standalone sources),
+and which contain chunks of the input files verbatim.
+
+The main consequences of this are as follows.
+\begin{itemize}
+\item The output is completely portable between different machines and
+  compilers.  If you're preparing a source distribution for general release,
+  it's probably a good idea to provide the generated C~source as well as your
+  Sod sources.
+\item Sod hasn't made any attempt to improve C's syntax.  It's just as
+  hostile to object-oriented programming as it ever was.  This means that
+  you'll end up writing ugly things like
+  \begin{prog}%
+    thing->_vt->foo.frob(thing, mumble);%
+  \end{prog}
+  fairly frequently.  This can be made somewhat less painful using macros,
+  but we're basically stuck with C.  The upside is that you know exactly what
+  you're getting.  A common complaint about \Cplusplus\ is that it has a
+  tendency to hide arbitrarily complicated runtime behaviour behind
+  apparently innocent syntax: you don't get any of that with Sod.  Some
+  people might even think this is a benefit.
+\end{itemize}
+Of course, this means that your build system needs to become more
+complicated.  If you use \man{make}{1}, then something like
+\begin{prog}%
+  SOD = sod
+
+  .SUFFIXES: .sod .c .h
+  .sod.c:; \$(SOD) -gc -o \$@@ \$<
+  .sod.h:; \$(SOD) -gh -o \$@@ \$< %
+\end{prog}
+ought to do the job.
+
+%%%--------------------------------------------------------------------------
+\section{A traditional trivial introduction}
+
+The following is a simple Sod input file.
+\begin{prog}\quad\=\quad\=\kill%
+/* -*-sod-*- */
+
+code c : includes \{
+\#include "greeter.h"
+\}
+
+code h : includes \{
+\#include <stdio.h>
+\#include <sod.h>
+\}
+
+class Greeter : SodObject \{ \+
+  void greet(FILE *fp) \{ \+
+    fputs("Hello, world!\textbackslash n", fp); \-
+  \} \-
+\} %
+\end{prog}
+Save it as @"greeter.sod", and run
+\begin{prog}%
+sod --gc --gh greeter %
+\end{prog}
+This will create files @"greeter.c" and @"greeter.h" in the current
+directory.  Here's how we might use such a simple thing.
+\begin{prog}\quad\=\kill%
+\#include "greeter.h"
+
+int main(void)
+\{ \+
+  struct Greeter__ilayout g_obj;
+  Greeter *g = Greeter__class->cls.init(\&g_obj);
+
+  g->_vt.greeter.greet(g, stdout);
+  return (0); \-
+\} %
+\end{prog}
+Compare this to the traditional
+\begin{prog}\quad\=\kill%
+\#include <stdio.h>
+
+int main(void) \+
+  \{ fputs("Hello, world\\n", stdout); return (0); \} %
+\end{prog}
+and I'm sure you'll appreciate the benefits of using Sod already -- mostly to
+do with finger exercise.  Trust me, it gets more useful.
+
+The @".sod" file was almost comprehensible.  There are two important parts to
+it (after the comment which tells Emacs how to cope with it).
+
+The first part consists of the two @"code" stanzas.  Both of them define
+gobbets of raw C code to copy into output files.  The first one, @"code~:
+c"~\ldots, says that
+\begin{prog}%
+  \#include "greeter.h" %
+\end{prog}
+needs to appear in the generated @|greeter.c| file; the second says that
+\begin{prog}%
+  \#include <stdio.h>
+  \#include <sod.h> %
+\end{prog}
+needs to appear in the header file @|greeter.h|.  The generated C files need
+to get declarations for external types and functions (e.g., @"FILE" and
+@"fputs") from somewhere, and the generated @".c" file will need the
+declarations from the corresponding @".h" file.  Sod takes a very simple
+approach to all of this: it expects you, the programmer, to deal with it.
+
+The basic syntax for @"code" stanzas is
+\begin{prog}\quad\=\kill%
+  code @<file-label> : @<section> \{
+  \>  @<code>
+  \} %
+\end{prog}
+The @<file-label> is either @"c" or @"h", and says which output file the code
+wants to be written to.  The @<section> is a name which explains where in the
+output file to place the code.  The @"includes" section is the usual choice:
+it's the `right' place for @`\#include' directives and similar declarations.
+
+The remaining part, the `meat' of the file, defines a class called
+@"greeter".  The class can respond to a single message, named @"greet", and
+in response, it writes a traditional greeting to the file passed in with the
+message.
+
+So far, so good.  The C code, which we thought we understood, contains some
+bizarre looking runes.  Let's take it one step at a time.
+\begin{prog}%
+  struct Greeter__ilayout g_obj; %
+\end{prog}
+allocates space for an instance of class @"Greeter".  We're not going to use
+this space directly.  Instead, we do this frightening looking thing.
+\begin{prog}%
+  Greeter *g = Greeter__class->cls.init(\&g_obj); %
+\end{prog}
+Taking it slowly: @"Greeter__class" is a pointer to the object that
+represents our class @"Greeter".  This object contains a member, named
+@"cls.init", which points to a function whose job is to turn uninitialized
+storage space into working instances of the class.  It returns a pointer to
+the instance, which we use in preference to grovelling about in the
+@"ilayout" structure.
+
+Having done this, we `send the instance a message':
+\begin{prog}%
+  g->_vt->greeter.greet(g, stdout); %
+\end{prog}
+This looks horrific, and seems to repeat itself quite unnecessarily.  The
+first @"g" is the recipient of our `message'.  The second is indeed a copy of
+the first: we have to tell it who it is.  (Sod doesn't extend C's syntax, so
+this is the sort of thing we just have to put up with.)  The lowercase
+@"greeter" is our class's `nickname': we didn't choose one explicitly, so Sod
+picked one by forcing the classname to lowercase.
+
+%%%----- That's all, folks --------------------------------------------------
+
+%%% Local variables:
+%%% mode: LaTeX
+%%% TeX-master: "sod.tex"
+%%% TeX-PDF-mode: t
+%%% End:
diff --git a/sod.asd b/sod.asd
index 932b611..54214fc 100644
--- a/sod.asd
+++ b/sod.asd
@@ -71,13 +71,19 @@
    (:file "utilities" :depends-on ("package"))
    (:file "tables" :depends-on ("package"))
    (:file "c-types" :depends-on ("utilities"))
+   (:file "codegen" :depends-on ("c-types"))
    (:file "posn-stream" :depends-on ("utilities"))
-   (:file "lex" :depends-on ("posn-stream"))
+   (:file "errors" :depends-on ("posn-stream"))
+   (:file "lex" :depends-on ("posn-stream" "errors"))
    (:file "pset" :depends-on ("lex"))
-   (:file "parse-c-types" :depends-on ("lex" "c-types"))
-   (:file "class-defs" :depends-on ("parse-c-types" "tables"))
-   (:file "class-builder" :depends-on ("class-defs"))
+   (:file "parse-c-types" :depends-on ("lex" "c-types" "tables"))
+   (:file "class-defs" :depends-on ("parse-c-types"))
+   (:file "cpl" :depends-on ("class-defs"))
+   (:file "class-finalize" :depends-on ("class-defs" "cpl"))
+   (:file "class-builder" :depends-on ("class-finalize" "pset"))
+   (:file "class-layout" :depends-on ("class-defs"))
    (:file "module" :depends-on ("parse-c-types" "tables"))
-   (:file "output" :depends-on ("module"))))
+   (:file "output" :depends-on ("module"))
+   (:file "class-output" :depends-on ("class-layout" "output"))))
 
 ;;;----- That's all, folks --------------------------------------------------
diff --git a/sod.h b/sod.h
new file mode 100644
index 0000000..7b1b7fa
--- /dev/null
+++ b/sod.h
@@ -0,0 +1,152 @@
+/* -*-c-*-
+ *
+ * Sensible Object Design header file
+ *
+ * (c) 2009 Straylight/Edgeware
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of the Simple Object Definition system.
+ *
+ * SOD is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * SOD is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with SOD; if not, write to the Free Software Foundation,
+ * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */
+
+#ifndef SOD_H
+#define SOD_H
+
+#ifdef __cplusplus
+  extern "C" {
+#endif
+
+/*----- Header files ------------------------------------------------------*/
+
+#include <stdarg.h>
+#include <stddef.h>
+
+#include <sod-base.h>
+
+/*----- Data structures ---------------------------------------------------*/
+
+/* A skeletal vtable structure.  At the beginning of every ichain is a
+ * pointer to one of these.
+ */
+struct sod_vtable {
+  SodClass *_class;			/* Pointer to class object */
+  size_t _base;				/* Offset to instance base */
+};
+
+/* A skeletal instance structure.  Every instance pointer points to one of
+ * these.
+ */
+struct sod_instance {
+  struct sod_vtable *_vt;		/* Pointer to (chain's) vtable */
+};
+
+/* Information about a particular chain of superclasses.  In each class,
+ * there's a pointer to an array of these.  If you search hard enough, you'll
+ * be able to find out a fair amount of information about an instance and its
+ * class.
+ */
+struct sod_chain {
+  size_t n_classes;			/* Number of classes in chain */
+  const SodClass *const *classes;	/* Vector of classes, head first */
+  size_t off_ichain;			/* Offset of ichain from base */
+  const struct sod_vtable *vt;		/* Chain's vtable pointer */
+  size_t ichainsz;			/* Size of the ichain structure */
+};
+
+/*----- Infrastructure macros ---------------------------------------------*/
+
+/* --- @SOD_XCHAIN@ --- *
+ *
+ * Arguments:	@chead@ = nickname of target chain's head
+ *		@p@ = pointer to an instance chain
+ *
+ * Returns:	Pointer to target chain, as a @char *@.
+ *
+ * Use:		Utility for implementing cross-chain upcasts.  It's probably
+ *		not that clever to use this macro directly; it's used to make
+ *		the automatically-generated upcast macros more palatable.
+ */
+
+#define SOD_XCHAIN(chead, p) ((char *)(p) + (p)->_vt->_off_##chead)
+
+/* --- @SOD_ILAYOUT@ --- *
+ *
+ * Arguments:	@cls@ = name of a class
+ *		@chead@ = nickname of chain head of @cls@
+ *		@p@ = pointer to the @chead@ ichain of an (exact) instance of
+ *			@cls@
+ *
+ * Returns:	A pointer to the instance's base, cast as a pointer to the
+ *		ilayout structure.
+ *
+ * Use:		Finds an instance's base address given a pointer to one of
+ *		its ichains, if you know precisely the instance's class and
+ *		which chain you're pointing to.  If you don't, then (a)
+ *
+ *		  @(char *)(p) - (p)->_vt->_base@
+ *
+ *		will do the job just fine, and (b) you'll have the wrong
+ *		ilayout anyway.
+ *
+ *		This macro is not intended to be used directly outside of
+ *		automatically generated effective method and trampoline
+ *		functions, which have the kinds of specific knowledge
+ *		necessary to use it safely.
+ */
+
+#define SOD_ILAYOUT(cls, chead, p)					\
+  ((struct cls##__ilayout *)						\
+   ((char *)(p) - offsetof(struct cls##__ilayout, chead)))
+
+/*----- Functions provided ------------------------------------------------*/
+
+/* --- @sod_convert@ --- *
+ *
+ * Arguments:	@const SodClass *cls@ = desired class object
+ *		@const void *obj@ = pointer to instance
+ *
+ * Returns:	Pointer to appropriate ichain of object, or null if the
+ *		instance isn't of the specified class.
+ *
+ * Use:		General down/cross-casting function.
+ *
+ *		Upcasts can be performed efficiently using the automatically
+ *		generated macros.  In particular, upcasts with a chain are
+ *		trivial; cross-chain upcasts require information from vtables
+ *		but are fairly fast.  This function is rather slower, but is
+ *		much more general.
+ *
+ *		Suppose we have an instance of a class C, referred to by a
+ *		pointer to an instance of one of C's superclasses S.  If S'
+ *		is some other superclass of C then this function will return
+ *		a pointer to C suitable for use as an instance of S'.  If S'
+ *		is not a superclass of C, then the function returns null.
+ *		(If the pointer doesn't point to an instance of some class
+ *		then the behaviour is undefined.)  Note that you don't need
+ *		to know what C or S actually are.
+ */
+
+extern void *sod_convert(const SodClass */*cls*/, void */*p*/);
+
+/*----- That's all, folks -------------------------------------------------*/
+
+#ifdef __cplusplus
+  }
+#endif
+
+#endif
diff --git a/sod.tex b/sod.tex
new file mode 100644
index 0000000..6b8275f
--- /dev/null
+++ b/sod.tex
@@ -0,0 +1,942 @@
+\documentclass[noarticle]{strayman}
+
+\usepackage[T1]{fontenc}
+\usepackage[utf8]{inputenc}
+\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
+\usepackage{syntax}
+\usepackage{sverb}
+\usepackage{at}
+\usepackage{mdwref}
+
+\title{A Sensible Object Design for C}
+\author{Mark Wooding}
+
+\def\syntleft{\normalfont\itshape}
+\let\syntright\empty
+
+\def\ulitleft{\normalfont\sffamily}
+\let\ulitright\empty
+
+\let\listingsize\relax
+
+\let\epsilon\varepsilon
+
+\atdef <#1>{\synt{#1}}
+\atdef "#1"{\lit*{#1}}
+\atdef `#1'{\lit{#1}}
+\atdef |#1|{\textsf{#1}}
+
+\def\Cplusplus{C\kern-1pt++}
+\def\Csharp{C\#}
+\def\man#1#2{\textbf{#1}(#2)}
+
+\begingroup\lccode`\~=`\
+\lowercase{
+\endgroup
+\def\prog{%
+  \sffamily%
+  \quote%
+  \let\oldnl\\%
+  \obeylines%
+  \tabbing%
+  \global\let~\\%
+  \global\let\\\textbackslash%
+}
+\def\endprog{%
+  \endtabbing%
+  \global\let\\\oldnl%
+  \endquote%
+}}
+
+\begin{document}
+
+\maketitle
+
+\include{sod-tut}
+
+%%%--------------------------------------------------------------------------
+\chapter{Internals}
+
+\section{Generated names}
+
+The generated names for functions and objects related to a class are
+constructed systematically so as not to interfere with each other.  The rules
+on class, slot and message naming exist so as to ensure that the generated
+names don't collide with each other.
+
+The following notation is used in this section.
+\begin{description}
+\item[@<class>] The full name of the `focus' class: the one for which we are
+  generating name.
+\item[@<super-nick>] The nickname of a superclass.
+\item[@<head-nick>] The nickname of the chain-head class of the chain
+  in question.
+\end{description}
+
+\subsection{Instance layout}
+
+%%%--------------------------------------------------------------------------
+\section{Syntax}
+\label{sec:syntax}
+
+Fortunately, Sod is syntactically quite simple.  I've used a little slightly
+unusual notation in order to make the presentation easier to read.
+\begin{itemize}
+\item $\epsilon$ denotes the empty nonterminal:
+  \begin{quote}
+    $\epsilon$ ::=
+  \end{quote}
+\item $[$@<item>$]$ means an optional @<item>:
+  \begin{quote}
+    \syntax{$[$<item>$]$ ::= $\epsilon$ | <item>}
+  \end{quote}
+\item @<item>$^*$ means a sequence of zero or more @<item>s:
+  \begin{quote}
+    \syntax{<item>$^*$ ::= $\epsilon$ | <item>$^*$ <item>}
+  \end{quote}
+\item @<item>$^+$ means a sequence of one or more @<item>s:
+  \begin{quote}
+    \syntax{<item>$^+$ ::= <item> <item>$^*$}
+  \end{quote}
+\item @<item-list> means a sequence of one or more @<item>s separated
+  by commas:
+  \begin{quote}
+    \syntax{<item-list> ::= <item> | <item-list> "," <item>}
+  \end{quote}
+\end{itemize}
+
+\subsection{Lexical syntax}
+\label{sec:syntax.lex}
+
+Whitespace and comments are discarded.  The remaining characters are
+collected into tokens according to the following syntax.
+
+\begin{grammar}
+<token> ::= <identifier>
+\alt <reserved-word>
+\alt <string-literal>
+\alt <char-literal>
+\alt <integer-literal>
+\alt <punctuation>
+\end{grammar}
+
+This syntax is slightly ambiguous.  The following two rules serve to
+disambiguate:
+\begin{enumerate}
+\item Reserved words take precedence.  All @<reserved-word>s are
+  syntactically @<identifier>s; Sod resolves the ambiguity in favour of
+  @<reserved-word>.
+\item `Maximal munch'.  In other cases, at each stage we take the longest
+  sequence of characters which could be a token.
+\end{enumerate}
+
+\subsubsection{Identifiers} \label{sec:syntax.lex.id}
+
+\begin{grammar}
+<identifier> ::= <id-start-char> <id-body-char>$^*$
+
+<id-start-char> ::= <alpha-char> $|$ "_"
+
+<id-body-char> ::= <id-start-char> $|$ <digit-char>
+
+<alpha-char> ::= "A" $|$ "B" $|$ \dots\ $|$ "Z"
+\alt "a" $|$ "b" $|$ \dots\ $|$ "z"
+\alt <extended-alpha-char>
+
+<digit-char> ::= "0" $|$ <nonzero-digit-char>
+
+<nonzero-digit-char> ::= "1" $|$ "2" $| \cdots |$ "9"
+\end{grammar}
+
+The precise definition of @<alpha-char> is left to the function
+\textsf{alpha-char-p} in the hosting Lisp system.  For portability,
+programmers are encouraged to limit themselves to the standard ASCII letters.
+
+\subsubsection{Reserved words} \label{sec:syntax.lex.reserved}
+
+\begin{grammar}
+<reserved-word> ::=
+"char" $|$ "class" $|$ "code" $|$ "const" $|$ "double" $|$ "enum" $|$
+"extern" $|$ "float" $|$ "import" $|$ "int" $|$ "lisp" $|$ "load" $|$ "long"
+$|$ "restrict" $|$ "short" $|$ "signed" $|$ "struct" $|$ "typename" $|$
+"union" $|$ "unsigned" $|$ "void" $|$ "volatile"
+\end{grammar}
+
+Many of these are borrowed from~C; however, some (e.g., @"import" and
+@"lisp") are not, and some C reserved words are not reserved (e.g.,
+@"static").
+
+\subsubsection{String and character literals} \label{sec:syntax.lex.string}
+
+\begin{grammar}
+<string-literal> ::= "\"" <string-literal-char>$^*$ "\""
+
+<char-literal> ::= "'" <char-literal-char> "'"
+
+<string-literal-char> ::= any character other than "\\" or "\""
+\alt "\\" <char>
+
+<char-literal-char> ::= any character other than "\\" or "'"
+\alt "\\" <char>
+
+<char> ::= any single character
+\end{grammar}
+
+The syntax for string and character literals differs from~C.  In particular,
+escape sequences such as @`\textbackslash n' are not recognized.  The use
+of string and character literals in Sod, outside of C~fragments, is limited,
+and the simple syntax seems adequate.  For the sake of future compatibility,
+the use of character sequences which resemble C escape sequences is
+discouraged.
+
+\subsubsection{Integer literals} \label{sec:syntax.lex.int}
+
+\begin{grammar}
+<integer-literal> ::= <decimal-integer>
+\alt <binary-integer>
+\alt <octal-integer>
+\alt <hex-integer>
+
+<decimal-integer> ::= <nonzero-digit-char> <digit-char>$^*$
+
+<binary-integer> ::= "0" $($"b"$|$"B"$)$ <binary-digit-char>$^+$
+
+<binary-digit-char> ::= "0" $|$ "1"
+
+<octal-integer> ::= "0" $[$"o"$|$"O"$]$ <octal-digit-char>$^+$
+
+<octal-digit-char> ::= "0" $|$ "1" $| \cdots |$ "7"
+
+<hex-integer> ::= "0" $($"x"$|$"X"$)$ <hex-digit-char>$^+$
+
+<hex-digit-char> ::= <digit-char>
+\alt "A" $|$ "B" $|$ "C" $|$ "D" $|$ "E" $|$ "F"
+\alt "a" $|$ "b" $|$ "c" $|$ "d" $|$ "e" $|$ "f"
+\end{grammar}
+
+Sod understands only integers, not floating-point numbers; its integer syntax
+goes slightly beyond C in allowing a @`0o' prefix for octal and @`0b' for
+binary.  However, length and signedness indicators are not permitted.
+
+\subsubsection{Punctuation} \label{sec:syntax.lex.punct}
+
+\begin{grammar}
+<punctuation> ::= any character other than "\"" or "'"
+\end{grammar}
+
+Due to the `maximal munch' rule, @<punctuation> tokens cannot be
+alphanumeric.
+
+\subsubsection{Comments} \label{sec:lex-comment}
+
+\begin{grammar}
+<comment> ::= <block-comment>
+\alt <line-comment>
+
+<block-comment> ::=
+  "/*"
+  <not-star>$^*$ $($<star>$^+$ <not-star-or-slash> <not-star>$^*)^*$
+  <star>$^*$
+  "*/"
+
+<star> ::= "*"
+
+<not-star> ::= any character other than "*"
+
+<not-star-or-slash> ::= any character other than "*" or  "/"
+
+<line-comment> ::= "//" <not-newline>$^*$ <newline>
+
+<newline> ::= a newline character
+
+<not-newline> ::= any character other than newline
+\end{grammar}
+
+Comments are exactly as in C99: both traditional block comments `\texttt{/*}
+\dots\ \texttt{*/}' and \Cplusplus-style `\texttt{//} \dots' comments are
+permitted and ignored.
+
+\subsection{Special nonterminals}
+\label{sec:special-nonterminals}
+
+Aside from the lexical syntax presented above (\xref{sec:lexical-syntax}),
+two special nonterminals occur in the module syntax.
+
+\subsubsection{S-expressions} \label{sec:syntax-sexp}
+
+\begin{grammar}
+<s-expression> ::= an S-expression, as parsed by the Lisp reader
+\end{grammar}
+
+When an S-expression is expected, the Sod parser simply calls the host Lisp
+system's \textsf{read} function.  Sod modules are permitted to modify the
+read table to extend the S-expression syntax.
+
+S-expressions are self-delimiting, so no end-marker is needed.
+
+\subsubsection{C fragments} \label{sec:syntax.lex.cfrag}
+
+\begin{grammar}
+<c-fragment> ::= a sequence of C tokens, with matching brackets
+\end{grammar}
+
+Sequences of C code are simply stored and written to the output unchanged
+during translation.  They are read using a simple scanner which nonetheless
+understands C comments and string and character literals.
+
+A C fragment is terminated by one of a small number of delimiter characters
+determined by the immediately surrounding context -- usually a closing brace
+or bracket.  The first such delimiter character which is not enclosed in
+brackets, braces or parenthesis ends the fragment.
+
+\subsection{Module syntax} \label{sec:syntax-module}
+
+\begin{grammar}
+<module> ::= <definition>$^*$
+
+<definition> ::= <import-definition>
+\alt <load-definition>
+\alt <lisp-definition>
+\alt <code-definition>
+\alt <typename-definition>
+\alt <class-definition>
+\end{grammar}
+
+A module is the top-level syntactic item.  A module consists of a sequence of
+definitions.
+
+\subsection{Simple definitions} \label{sec:syntax.defs}
+
+\subsubsection{Importing modules} \label{sec:syntax.defs.import}
+
+\begin{grammar}
+<import-definition> ::= "import" <string> ";"
+\end{grammar}
+
+The module named @<string> is processed and its definitions made available.
+
+A search is made for a module source file as follows.
+\begin{itemize}
+\item The module name @<string> is converted into a filename by appending
+  @`.sod', if it has no extension already.\footnote{%
+    Technically, what happens is \textsf{(merge-pathnames name (make-pathname
+    :type "SOD" :case :common))}, so exactly what this means varies
+    according to the host system.} %
+\item The file is looked for relative to the directory containing the
+  importing module.
+\item If that fails, then the file is looked for in each directory on the
+  module search path in turn.
+\item If the file still isn't found, an error is reported and the import
+  fails.
+\end{itemize}
+At this point, if the file has previously been imported, nothing further
+happens.\footnote{%
+  This check is done using \textsf{truename}, so it should see through simple
+  tricks like symbolic links.  However, it may be confused by fancy things
+  like bind mounts and so on.} %
+
+Recursive imports, either direct or indirect, are an error.
+
+\subsubsection{Loading extensions} \label{sec:syntax.defs.load}
+
+\begin{grammar}
+<load-definition> ::= "load" <string> ";"
+\end{grammar}
+
+The Lisp file named @<string> is loaded and evaluated.
+
+A search is made for a Lisp source file as follows.
+\begin{itemize}
+\item The name @<string> is converted into a filename by appending @`.lisp',
+  if it has no extension already.\footnote{%
+    Technically, what happens is \textsf{(merge-pathnames name (make-pathname
+    :type "LISP" :case :common))}, so exactly what this means varies
+    according to the host system.} %
+\item A search is then made in the same manner as for module imports
+  (\xref{sec:syntax-module}).
+\end{itemize}
+If the file is found, it is loaded using the host Lisp's \textsf{load}
+function.
+
+Note that Sod doesn't attempt to compile Lisp files, or even to look for
+existing compiled files.  The right way to package a substantial extension to
+the Sod translator is to provide the extension as a standard ASDF system (or
+similar) and leave a dropping @"foo-extension.lisp" in the module path saying
+something like
+\begin{listing}
+(asdf:operate 'asdf:load-op :foo-extension)
+\end{listing}
+which will arrange for the extension to be compiled if necessary.
+
+(This approach means that the language doesn't need to depend on any
+particular system definition facility.  It's bad enough already that it
+depends on Common Lisp.)
+
+\subsubsection{Lisp escapes} \label{sec:syntax.defs.lisp}
+
+\begin{grammar}
+<lisp-definition> ::= "lisp" <s-expression> ";"
+\end{grammar}
+
+The @<s-expression> is evaluated immediately.  It can do anything it likes.
+
+\textbf{Warning!}  This means that hostile Sod modules are a security hazard.
+Lisp code can read and write files, start other programs, and make network
+connections.  Don't install Sod modules from sources that you don't
+trust.\footnote{%
+  Presumably you were going to run the corresponding code at some point, so
+  this isn't as unusually scary as it sounds.  But please be careful.} %
+
+\subsubsection{Declaring type names} \label{sec:syntax.defs.typename}
+
+\begin{grammar}
+<typename-definition> ::=
+  "typename" <identifier-list> ";"
+\end{grammar}
+
+Each @<identifier> is declared as naming a C type.  This is important because
+the C type syntax -- which Sod uses -- is ambiguous, and disambiguation is
+done by distinguishing type names from other identifiers.
+
+Don't declare class names using @"typename"; use @"class" forward
+declarations instead.
+
+\subsection{Literal code} \label{sec:syntax-code}
+
+\begin{grammar}
+<code-definition> ::=
+  "code" <identifier> ":" <identifier> $[$<constraints>$]$
+  "{" <c-fragment> "}"
+
+<constraints> ::= "[" <constraint-list> "]"
+
+<constraint> ::= <identifier>$^+$
+\end{grammar}
+
+The @<c-fragment> will be output unchanged to one of the output files.
+
+The first @<identifier> is the symbolic name of an output file.  Predefined
+output file names are @"c" and @"h", which are the implementation code and
+header file respectively; other output files can be defined by extensions.
+
+The second @<identifier> provides a name for the output item.  Several C
+fragments can have the same name: they will be concatenated together in the
+order in which they were encountered.
+
+The @<constraints> provide a means for specifying where in the output file
+the output item should appear.  (Note the two kinds of square brackets shown
+in the syntax: square brackets must appear around the constraints if they are
+present, but that they may be omitted.)  Each comma-separated @<constraint>
+is a sequence of identifiers naming output items, and indicates that the
+output items must appear in the order given -- though the translator is free
+to insert additional items in between them.  (The particular output items
+needn't be defined already -- indeed, they needn't be defined ever.)
+
+There is a predefined output item @"includes" in both the @"c" and @"h"
+output files which is a suitable place for inserting @"\#include"
+preprocessor directives in order to declare types and functions for use
+elsewhere in the generated output files.
+
+\subsection{Property sets} \label{sec:syntax.propset}
+
+\begin{grammar}
+<properties> ::= "[" <property-list> "]"
+
+<property> ::= <identifier> "=" <expression>
+\end{grammar}
+
+Property sets are a means for associating miscellaneous information with
+classes and related items.  By using property sets, additional information
+can be passed to extensions without the need to introduce idiosyncratic
+syntax.
+
+A property has a name, given as an @<identifier>, and a value computed by
+evaluating an @<expression>.  The value can be one of a number of types,
+though the only operators currently defined act on integer values only.
+
+\subsubsection{The expression evaluator} \label{sec:syntax.propset.expr}
+
+\begin{grammar}
+<expression> ::= <term> | <expression> "+" <term> | <expression> "-" <term>
+
+<term> ::= <factor> | <term> "*" <factor> | <term> "/" <factor>
+
+<factor> ::= <primary> | "+" <factor> | "-" <factor>
+
+<primary> ::=
+     <integer-literal> | <string-literal> | <char-literal> | <identifier>
+\alt "?" <s-expression>
+\alt "(" <expression> ")"
+\end{grammar}
+
+The arithmetic expression syntax is simple and standard; there are currently
+no bitwise, logical, or comparison operators.
+
+A @<primary> expression may be a literal or an identifier.  Note that
+identifiers stand for themselves: they \emph{do not} denote values.  For more
+fancy expressions, the syntax
+\begin{quote}
+  @"?" @<s-expression>
+\end{quote}
+causes the @<s-expression> to be evaluated using the Lisp \textsf{eval}
+function.
+%%% FIXME crossref to extension docs
+
+\subsection{C types} \label{sec:syntax.c-types}
+
+Sod's syntax for C types closely mirrors the standard C syntax.  A C type has
+two parts: a sequence of @<declaration-specifier>s and a @<declarator>.  In
+Sod, a type must contain at least one @<declaration-specifier> (i.e.,
+`implicit @"int"' is forbidden), and storage-class specifiers are not
+recognized.
+
+\subsubsection{Declaration specifiers} \label{sec:syntax.c-types.declspec}
+
+\begin{grammar}
+<declaration-specifier> ::= <type-name>
+\alt "struct" <identifier> | "union" <identifier> | "enum" <identifier>
+\alt "void" | "char" | "int" | "float" | "double"
+\alt "short" | "long"
+\alt "signed" | "unsigned"
+\alt <qualifier>
+
+<qualifier> ::= "const" | "volatile" | "restrict"
+
+<type-name> ::= <identifier>
+\end{grammar}
+
+A @<type-name> is an identifier which has been declared as being a type name,
+using the @"typename" or @"class" definitions.
+
+Declaration specifiers may appear in any order.  However, not all
+combinations are permitted.  A declaration specifier must consist of zero or
+more @<qualifiers>, and one of the following, up to reordering.
+\begin{itemize}
+\item @<type-name>
+\item @"struct" <identifier>, @"union" <identifier>, @"enum" <identifier>
+\item @"void"
+\item @"char", @"unsigned char", @"signed char"
+\item @"short", @"unsigned short", @"signed short"
+\item @"short int", @"unsigned short int", @"signed short int"
+\item @"int", @"unsigned int", @"signed int", @"unsigned", @"signed"
+\item @"long", @"unsigned long", @"signed long"
+\item @"long int", @"unsigned long int", @"signed long int"
+\item @"long long", @"unsigned long long", @"signed long long"
+\item @"long long int", @"unsigned long long int", @"signed long long int"
+\item @"float", @"double", @"long double"
+\end{itemize}
+All of these have their usual C meanings.
+
+\subsubsection{Declarators} \label{sec:syntax.c-types.declarator}
+
+\begin{grammar}
+<declarator> ::=
+  <pointer>$^*$ <inner-declarator> <declarator-suffix>$^*$
+
+<inner-declarator> ::= <identifier> | <qualified-identifier>
+\alt "(" <declarator> ")"
+
+<qualified-identifier> ::= <identifier> "." <identifier>
+
+<pointer> ::= "*" <qualifier>$^*$
+
+<declarator-suffix> ::= "[" <c-fragment> "]"
+\alt "(" <arguments> ")"
+
+<arguments> ::= <empty> | "..."
+\alt <argument-list> $[$"," "..."$]$
+
+<argument> ::= <declaration-specifier>$^+$ <argument-declarator>
+
+<argument-declarator> ::= <declarator> | $[$<abstract-declarator>$]$
+
+<abstract-declarator> ::=
+  <pointer>$^+$ | <pointer>$^*$ <inner-abstract-declarator>
+
+<inner-abstract-declarator> ::= "(" <abstract-declarator> ")"
+\alt $[$<inner-abstract-declarator>$]$ <declarator-suffix>$^+$
+\end{grammar}
+
+The declarator syntax is taken from C, but with some differences.
+\begin{itemize}
+\item Array dimensions are uninterpreted @<c-fragments>, terminated by a
+  closing square bracket.  This allows array dimensions to contain arbitrary
+  constant expressions.
+\item A declarator may have either a single @<identifier> at its centre or a
+  pair of @<identifier>s separated by a @`.'; this is used to refer to
+  slots or messages defined in superclasses.
+\end{itemize}
+The remaining differences are (I hope) a matter of presentation rather than
+substance.
+
+\subsection{Defining classes} \label{sec:syntax.class}
+
+\begin{grammar}
+<class-definition> ::= <class-forward-declaration>
+\alt <full-class-definition>
+\end{grammar}
+
+\subsubsection{Forward declarations} \label{sec:class.class.forward}
+
+\begin{grammar}
+<class-forward-declaration> ::= "class" <identifier> ";"
+\end{grammar}
+
+A @<class-forward-declaration> informs Sod that an @<identifier> will be used
+to name a class which is currently undefined.  Forward declarations are
+necessary in order to resolve certain kinds of circularity.  For example,
+\begin{listing}
+class Sub;
+
+class Super : SodObject {
+  Sub *sub;
+};
+
+class Sub : Super {
+  /* ... */
+};
+\end{listing}
+
+\subsubsection{Full class definitions} \label{sec:class.class.full}
+
+\begin{grammar}
+<full-class-definition> ::=
+  $[$<properties>$]$
+  "class" <identifier> ":" <identifier-list>
+  "{" <class-item>$^*$ "}"
+
+<class-item> ::= <slot-item> ";"
+\alt <message-item>
+\alt <method-item>
+\alt  <initializer-item> ";"
+\end{grammar}
+
+A full class definition provides a complete description of a class.
+
+The first @<identifier> gives the name of the class.  It is an error to
+give the name of an existing class (other than a forward-referenced class),
+or an existing type name.  It is conventional to give classes `MixedCase'
+names, to distinguish them from other kinds of identifiers.
+
+The @<identifier-list> names the direct superclasses for the new class.  It
+is an error if any of these @<identifier>s does not name a defined class.
+
+The @<properties> provide additional information.  The standard class
+properties are as follows.
+\begin{description}
+\item[@"lisp_class"] The name of the Lisp class to use within the translator
+  to represent this class.  The property value must be an identifier; the
+  default is @"sod_class".  Extensions may define classes with additional
+  behaviour, and may recognize additional class properties.
+\item[@"metaclass"] The name of the Sod metaclass for this class.  In the
+  generated code, a class is itself an instance of another class -- its
+  \emph{metaclass}.  The metaclass defines which slots the class will have,
+  which messages it will respond to, and what its behaviour will be when it
+  receives them.  The property value must be an identifier naming a defined
+  subclass of @"SodClass".  The default metaclass is @"SodClass".
+  %%% FIXME xref to theory
+\item[@"nick"] A nickname for the class, to be used to distinguish it from
+  other classes in various limited contexts.  The property value must be an
+  identifier; the default is constructed by forcing the class name to
+  lower-case.
+\end{description}
+
+The class body consists of a sequence of @<class-item>s enclosed in braces.
+These items are discussed on the following sections.
+
+\subsubsection{Slot items} \label{sec:sntax.class.slot}
+
+\begin{grammar}
+<slot-item> ::=
+  $[$<properties>$]$
+  <declaration-specifier>$^+$ <init-declarator-list>
+
+<init-declarator> ::= <declarator> $[$"=" <initializer>$]$
+\end{grammar}
+
+A @<slot-item> defines one or more slots.  All instances of the class and any
+subclass will contain these slot, with the names and types given by the
+@<declaration-specifiers> and the @<declarators>.  Slot declarators may not
+contain qualified identifiers.
+
+It is not possible to declare a slot with function type: such an item is
+interpreted as being a @<message-item> or @<method-item>.  Pointers to
+functions are fine.
+
+An @<initializer>, if present, is treated as if a separate
+@<initializer-item> containing the slot name and initializer were present.
+For example,
+\begin{listing}
+[nick = eg]
+class Example : Super {
+  int foo = 17;
+};
+\end{listing}
+means the same as
+\begin{listing}
+[nick = eg]
+class Example : Super {
+  int foo;
+  eg.foo = 17;
+};
+\end{listing}
+
+\subsubsection{Initializer items} \label{sec:syntax.class.init}
+
+\begin{grammar}
+<initializer-item> ::= $[$"class"$]$ <slot-initializer-list>
+
+<slot-initializer> ::= <qualified-identifier> "=" <initializer>
+
+<initializer> :: "{" <c-fragment> "}" | <c-fragment>
+\end{grammar}
+
+An @<initializer-item> provides an initial value for one or more slots.  If
+prefixed by @"class", then the initial values are for class slots (i.e.,
+slots of the class object itself); otherwise they are for instance slots.
+
+The first component of the @<qualified-identifier> must be the nickname of
+one of the class's superclasses (including itself); the second must be the
+name of a slot defined in that superclass.
+
+The initializer has one of two forms.
+\begin{itemize}
+\item A @<c-fragment> enclosed in braces denotes an aggregate initializer.
+  This is suitable for initializing structure, union or array slots.
+\item A @<c-fragment> \emph{not} beginning with an open brace is a `bare'
+  initializer, and continues until the next @`,' or @`;' which is not within
+  nested brackets.  Bare initializers are suitable for initializing scalar
+  slots, such as pointers or integers, and strings.
+\end{itemize}
+
+\subsubsection{Message items} \label{sec:syntax.class.message}
+
+\begin{grammar}
+<message-item> ::=
+  $[$<properties>$]$
+  <declaration-specifier>$^+$ <declarator> $[$<method-body>$]$
+\end{grammar}
+
+\subsubsection{Method items} \label{sec:syntax.class.method}
+
+\begin{grammar}
+<method-item> ::=
+  $[$<properties>$]$
+  <declaration-specifier>$^+$ <declarator> <method-body>
+
+<method-body> ::= "{" <c-fragment> "}" | "extern" ";"
+\end{grammar}
+
+%%%--------------------------------------------------------------------------
+\section{Class objects}
+
+\begin{listing}
+typedef struct SodClass__ichain_obj SodClass;
+
+struct sod_chain {
+  size_t n_classes;                     /* Number of classes in chain */
+  const SodClass *const *classes;       /* Vector of classes, head first */
+  size_t off_ichain;                    /* Offset of ichain from instance base */
+  const struct sod_vtable *vt;          /* Vtable pointer for chain */
+  size_t ichainsz;                      /* Size of the ichain structure */
+};
+
+struct sod_vtable {
+  SodClass *_class;                     /* Pointer to instance's class */
+  size_t _base;                         /* Offset to instance base */
+};
+
+struct SodClass__islots {
+
+  /* Basic information */
+  const char *name;                     /* The class's name as a string */
+  const char *nick;                     /* The nickname as a string */
+
+  /* Instance allocation and initialization */
+  size_t instsz;                        /* Instance layout size in bytes */
+  void *(*imprint)(void *);             /* Stamp instance with vtable ptrs */
+  void *(*init)(void *);                /* Initialize instance */
+
+  /* Superclass structure */
+  size_t n_supers;                      /* Number of direct superclasses */
+  const SodClass *const *supers;        /* Vector of direct superclasses */
+  size_t n_cpl;                         /* Length of class precedence list */
+  const SodClass *const *cpl;           /* Vector for class precedence list */
+
+  /* Chain structure */
+  const SodClass *link;                 /* Link to next class in chain */
+  const SodClass *head;                 /* Pointer to head of chain */
+  size_t level;                         /* Index of class in its chain */
+  size_t n_chains;                      /* Number of superclass chains */
+  const sod_chain *chains;              /* Vector of chain structures */
+
+  /* Layout */
+  size_t off_islots;                    /* Offset of islots from ichain base */
+  size_t islotsz;                       /* Size of instance slots */
+};
+
+struct SodClass__ichain_obj {
+  const SodClass__vt_obj *_vt;
+  struct SodClass__islots cls;
+};
+
+struct sod_instance {
+  struct sod_vtable *_vt;
+};
+\end{listing}
+
+\begin{listing}
+void *sod_convert(const SodClass *cls, const void *obj)
+{
+  const struct sod_instance *inst = obj;
+  const SodClass *real = inst->_vt->_cls;
+  const struct sod_chain *chain;
+  size_t i, index;
+
+  for (i = 0; i < real->cls.n_chains; i++) {
+    chain = &real->cls.chains[i];
+    if (chain->classes[0] == cls->cls.head) {
+      index = cls->cls.index;
+      if (index < chain->n_classes && chain->classes[index] == cls)
+        return ((char *)cls - inst->_vt._base + chain->off_ichain);
+      else
+        return (0);
+    }
+  }
+  return (0);
+}
+\end{listing}
+
+%%%--------------------------------------------------------------------------
+\section{Classes}
+
+\subsection{Classes and superclasses}
+
+A @<full-class-definition> must list one or more existing classes to be the
+\emph{direct superclasses} for the new class being defined.  We make the
+following definitions.
+\begin{itemize}
+\item The \emph{superclasses} of a class consist of the class itself together
+  with the superclasses of its direct superclasses.
+\item The \emph{proper superclasses} of a class are its superclasses other
+  than itself.
+\item If $C$ is a (proper) superclass of $D$ then $D$ is a (\emph{proper})
+  \emph{subclass} of $C$.
+\end{itemize}
+The predefined class @|SodObject| has no direct superclasses; it is unique in
+this respect.  All classes are subclasses of @|SodObject|.
+
+\subsection{The class precedence list}
+
+Let $C$ be a class.  The superclasses of $C$ form a directed graph, with an
+edge from each class to each of its direct superclasses.  This is the
+\emph{superclass graph of $C$}.
+
+In order to resolve inheritance of items, we define a \emph{class precedence
+  list} (or CPL) for each class, which imposes a total order on that class's
+superclasses.  The default algorithm for computing the CPL is the \emph{C3}
+algorithm \cite{fixme-c3}, though extensions may implement other algorithms.
+
+The default algorithm works as follows.  Let $C$ be the class whose CPL we
+are to compute.  Let $X$ and $Y$ be two of $C$'s superclasses.
+\begin{itemize}
+\item $C$ must appear first in the CPL.
+\item If $X$ appears before $Y$ in the CPL of one of $C$'s direct
+  superclasses, then $X$ appears before $Y$ in the $C$'s CPL.
+\item If the above rules don't suffice to order $X$ and $Y$, then whichever
+  of $X$ and $Y$ has a subclass which appears further left in the list of
+  $C$'s direct superclasses will appear earlier in the CPL.
+\end{itemize}
+This last rule is sufficient to disambiguate because if both $X$ and $Y$ are
+superclasses of the same direct superclass of $C$ then that direct
+superclass's CPL will order $X$ and $Y$.
+
+We say that \emph{$X$ is more specific than $Y$ as a superclass of $C$} if
+$X$ is earlier than $Y$ in $C$'s class precedence list.  If $C$ is clear from
+context then we omit it, saying simply that $X$ is more specific than $Y$.
+
+\subsection{Instances and metaclasses}
+
+A class defines the structure and behaviour of its \emph{instances}: run-time
+objects created (possibly) dynamically.  An instance is an instance of only
+one class, though structurally it may be used in place of an instance of any
+of that class's superclasses.  It is possible, with care, to change the class
+of an instance at run-time.
+
+Classes are themselves represented as instances -- called \emph{class
+  objects} -- in the running program.  Being instances, they have a class,
+called the \emph{metaclass}.  The metaclass defines the structure and
+behaviour of the class object.
+
+The predefined class @|SodClass| is the default metaclass for new classes.
+@|SodClass| has @|SodObject| as its only direct superclass.  @|SodClass| is
+its own metaclass.
+
+\subsection{Items and inheritance}
+
+A class definition also declares \emph{slots}, \emph{messages},
+\emph{initializers} and \emph{methods} -- collectively referred to as
+\emph{items}.  In addition to the items declared in the class definition --
+the class's \emph{direct items} -- a class also \emph{inherits} items from
+its superclasses.
+
+The precise rules for item inheritance vary according to the kinds of items
+involved.
+
+Some object systems have a notion of `repeated inheritance': if there are
+multiple paths in the superclass graph from a class to one of its
+superclasses then items defined in that superclass may appear duplicated in
+the subclass.  Sod does not have this notion.
+
+\subsubsection{Slots}
+A \emph{slot} is a unit of state.  In other object systems, slots may be
+called `fields', `member variables', or `instance variables'.
+
+A slot has a \emph{name} and a \emph{type}.  The name serves only to
+distinguish the slot from other direct slots defined by the same class.  A
+class inherits all of its proper superclasses' slots.  Slots inherited from
+superclasses do not conflict with each other or with direct slots, even if
+they have the same names.
+
+At run-time, each instance of the class holds a separate value for each slot,
+whether direct or inherited.  Changing the value of an instance's slot
+doesn't affect other instances.
+
+\subsubsection{Initializers}
+Mumble.
+
+\subsubsection{Messages}
+A \emph{message} is the stimulus for behaviour.  In Sod, a class must define,
+statically, the name and format of the messages it is able to receive and the
+values it will return in reply.  In this respect, a message is similar to
+`abstract member functions' or `interface member functions' in other object
+systems.
+
+Like slots, a message has a \emph{name} and a \emph{type}.  Again, the name
+serves only to distinguish the message from other direct messages defined by
+the same class.  Messages inherited from superclasses do not conflict with
+each other or with direct messages, even if they have the same name.
+
+At run-time, one sends a message to an instance by invoking a function
+obtained from the instance's \emph{vtable}: \xref{sec:fixme-vtable}.
+
+\subsubsection{Methods}
+A \emph{method} is a unit of behaviour.  In other object systems, methods may
+be called `member functions'.
+
+A method is associated with a message.  When a message is received by an
+instance, all of the methods associated with that message on the instance's
+class or any of its superclasses are \emph{applicable}.  The details of how
+the applicable methods are invoked are described fully in
+\xref{sec:fixme-method-combination}.
+
+\subsection{Chains and instance layout}
+
+
+
+\end{document}
+
+%%% Local variables:
+%%% mode: LaTeX
+%%% TeX-PDF-mode: t
+%%% End:
diff --git a/utilities.lisp b/utilities.lisp
index d61bb00..7e9e092 100644
--- a/utilities.lisp
+++ b/utilities.lisp
@@ -28,6 +28,13 @@
 ;;;--------------------------------------------------------------------------
 ;;; List utilities.
 
+(defun mappend (function list &rest more-lists)
+  "Like a nondestructive MAPCAN.
+
+   Map FUNCTION over the the corresponding elements of LIST and MORE-LISTS,
+   and return the result of appending all of the resulting lists."
+  (reduce #'append (apply #'mapcar function list more-lists) :from-end t))
+
 (define-condition inconsistent-merge-error (error)
   ((candidates :initarg :candidates
 	       :reader merge-error-candidates))
@@ -63,7 +70,9 @@
   ;; we can build the list up forwards, so as not to make the PICK function
   ;; interface be weird.  HEAD is a dummy cons cell inserted before the list,
   ;; which gives TAIL something to point to initially.  (If we had locatives,
-  ;; I'd have TAIL point to the thing holding the final NIL, but we haven't.)
+  ;; I'd have TAIL point to the thing holding the final NIL, but we haven't;
+  ;; instead, it points to the cons cell whose cdr holds the final NIL --
+  ;; which means that we need to invent a cons cell if the list is empty.)
   (do* ((head (cons nil nil))
         (tail head))
        ((null lists) (cdr head))
@@ -150,6 +159,31 @@
     (t nil)))
 
 ;;;--------------------------------------------------------------------------
+;;; Symbols.
+
+(defun symbolicate (&rest symbols)
+  "Return a symbol named after the concatenation of the names of the SYMBOLS.
+
+   The symbol is interned in the current *PACKAGE*.  Trad."
+  (intern (apply #'concatenate 'string (mapcar #'symbol-name symbols))))
+
+;;;--------------------------------------------------------------------------
+;;; Object printing.
+
+(defmacro maybe-print-unreadable-object
+    ((object stream &rest args) &body body)
+  "Print helper for usually-unreadable objects.
+
+   If *PRINT-ESCAPE* is set then print OBJECT unreadably using BODY.
+   Otherwise just print using BODY."
+  (let ((func (gensym "PRINT")))
+    `(flet ((,func () ,@body))
+       (if *print-escape*
+	   (print-unreadable-object (,object ,stream ,@args)
+	     (,func))
+	   (,func)))))
+
+;;;--------------------------------------------------------------------------
 ;;; Keyword arguments and lambda lists.
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -359,4 +393,19 @@
    OBJECT except where overridden by INITARGS."
   (apply #'copy-instance-using-class (class-of object) object initargs))
 
+(defmacro default-slot ((instance slot) &body value &environment env)
+  "If INSTANCE's SLOT is unbound, set it to VALUE.
+
+   Both INSTANCE and SLOT are evaluated; VALUE is an implicit progn and only
+   evaluated if it's needed."
+
+  (let* ((quotep (constantp slot env))
+	 (instancevar (gensym "INSTANCE"))
+	 (slotvar (if quotep slot (gensym "SLOT"))))
+    `(let ((,instancevar ,instance)
+	   ,@(and (not quotep) `((,slotvar ,slot))))
+       (unless (slot-boundp ,instancevar ,slotvar)
+	 (setf (slot-value ,instancevar ,slotvar)
+	       (progn ,@value))))))
+
 ;;;----- That's all, folks --------------------------------------------------
-- 
2.11.0

