82413ba524d8

--- a/src/wam/compiler/0-data.lisp	Fri Jul 15 20:16:26 2016 +0000
+++ b/src/wam/compiler/0-data.lisp	Fri Jul 15 20:28:10 2016 +0000
@@ -17,6 +17,8 @@
   (with-output-to-string (str)
     (print-unreadable-object (o str :type t :identity t))))
 
+(defun required ()
+  (error "Argument required."))
 
 
 ;;;; Registers
@@ -35,8 +37,8 @@
 
 
 (defstruct (register (:constructor make-register (type number)))
-  (type (error "Type required.") :type register-type)
-  (number (error "Number required.") :type register-number))
+  (type (required) :type register-type)
+  (number (required) :type register-number))
 
 
 (defun* make-temporary-register ((number register-number) (arity arity))

--- a/src/wam/compiler/3-flattening.lisp	Fri Jul 15 20:16:26 2016 +0000
+++ b/src/wam/compiler/3-flattening.lisp	Fri Jul 15 20:28:10 2016 +0000
@@ -27,24 +27,29 @@
 ;;;   X0 <- p(X1, X2)
 
 
-(defclass register-assignment ()
-  ((register :accessor assignment-register :type register :initarg :register)))
+(defstruct (register-assignment
+             (:conc-name assignment-))
+  (register (required) :type register))
 
 
-(defclass structure-assignment (register-assignment)
-  ((functor :accessor assignment-functor :type symbol :initarg :functor)
-   (arity :accessor assignment-arity :type arity :initarg :arity)
-   (arguments :accessor assignment-arguments :type list :initarg :arguments)))
+(defstruct (structure-assignment (:include register-assignment)
+                                 (:conc-name assignment-))
+  (functor nil :type symbol)
+  (arity 0 :type arity)
+  (arguments () :type list))
 
-(defclass argument-variable-assignment (register-assignment)
-  ((target :accessor assignment-target :type register :initarg :target)))
+(defstruct (argument-variable-assignment (:include register-assignment)
+                                         (:conc-name assignment-))
+  (target (required) :type register))
 
-(defclass list-assignment (register-assignment)
-  ((head :accessor assignment-head :type register :initarg :head)
-   (tail :accessor assignment-tail :type register :initarg :tail)))
+(defstruct (list-assignment (:include register-assignment)
+                            (:conc-name assignment-))
+  (head (required) :type register)
+  (tail (required) :type register))
 
-(defclass lisp-object-assignment (register-assignment)
-  ((object :accessor assignment-object :type t :initarg :object)))
+(defstruct (lisp-object-assignment (:include register-assignment)
+                                   (:conc-name assignment-))
+  (object nil :type t))
 
 
 (defmethod print-object ((assignment structure-assignment) stream)
@@ -82,27 +87,27 @@
   nil)
 
 (defmethod node-flatten ((node structure-node))
-  (values (make-instance 'structure-assignment
-                         :register (node-register node)
-                         :functor (node-functor node)
-                         :arity (node-arity node)
-                         :arguments (mapcar #'node-register (node-arguments node)))))
+  (values (make-structure-assignment
+            :register (node-register node)
+            :functor (node-functor node)
+            :arity (node-arity node)
+            :arguments (mapcar #'node-register (node-arguments node)))))
 
 (defmethod node-flatten ((node argument-variable-node))
-  (values (make-instance 'argument-variable-assignment
-                         :register (node-register node)
-                         :target (node-secondary-register node))))
+  (values (make-argument-variable-assignment
+            :register (node-register node)
+            :target (node-secondary-register node))))
 
 (defmethod node-flatten ((node list-node))
-  (values (make-instance 'list-assignment
-                         :register (node-register node)
-                         :head (node-register (node-head node))
-                         :tail (node-register (node-tail node)))))
+  (values (make-list-assignment
+            :register (node-register node)
+            :head (node-register (node-head node))
+            :tail (node-register (node-tail node)))))
 
 (defmethod node-flatten ((node lisp-object-node))
-  (values (make-instance 'lisp-object-assignment
-                         :register (node-register node)
-                         :object (node-object node))))
+  (values (make-lisp-object-assignment
+            :register (node-register node)
+            :object (node-object node))))
 
 
 (defun* flatten-breadth-first ((tree top-level-node))