# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1468693414 0
# Node ID 6c90a65137d96fc774e39bd6e5ca862a716802b8
# Parent  5593ae4bcb5c047eaced6c07afb7059c7693aad5
Remove defstar

The fucking this is apparently GPL'ed.  This is why we can't have nice things.

diff -r 5593ae4bcb5c -r 6c90a65137d9 bones.asd
--- a/bones.asd	Sat Jul 16 17:37:17 2016 +0000
+++ b/bones.asd	Sat Jul 16 18:23:34 2016 +0000
@@ -8,8 +8,7 @@
   :license "MIT/X11"
   :version "0.0.1"
 
-  :depends-on (#:defstar
-               #:optima
+  :depends-on (#:optima
                #:trivial-types
                #:cl-arrows
                #:policy-cond
diff -r 5593ae4bcb5c -r 6c90a65137d9 examples/ggp-paip-interpreted.lisp
--- a/examples/ggp-paip-interpreted.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/examples/ggp-paip-interpreted.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -7,29 +7,29 @@
                  queue-empty-p queue-append))
 
 
-(defun* queue-contents ((q queue))
+(defun queue-contents (q)
   (cdr q))
 
-(defun* make-queue ()
+(defun make-queue ()
   (let ((q (cons nil nil)))
     (setf (car q) q)))
 
-(defun* enqueue ((item t) (q queue))
+(defun enqueue (item q)
   (setf (car q)
         (setf (rest (car q))
               (cons item nil)))
   q)
 
-(defun* dequeue ((q queue))
+(defun dequeue (q)
   (prog1
       (pop (cdr q))
     (if (null (cdr q))
       (setf (car q) q))))
 
-(defun* queue-empty-p ((q queue))
+(defun queue-empty-p (q)
   (null (queue-contents q)))
 
-(defun* queue-append ((q queue) (l list))
+(defun queue-append (q l)
   (when l
     (setf (car q)
           (last (setf (rest (car q))
diff -r 5593ae4bcb5c -r 6c90a65137d9 package.lisp
--- a/package.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/package.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -1,7 +1,6 @@
 (defpackage #:bones.utils
   (:use
     #:cl
-    #:defstar
     #:cl-arrows
     #:bones.quickutils)
   (:export
@@ -26,12 +25,10 @@
     #:dequeue
     #:queue-contents
     #:queue-empty-p
-    #:queue-append)
-  (:shadowing-import-from #:cl-arrows
-    #:->))
+    #:queue-append))
 
 (defpackage #:bones.circle
-  (:use #:cl #:defstar)
+  (:use #:cl)
   (:export
     #:circle
     #:make-circle-with
@@ -67,7 +64,6 @@
 (defpackage #:bones.wam
   (:use
     #:cl
-    #:defstar
     #:optima
     #:cl-arrows
     #:bones.circle
@@ -108,17 +104,13 @@
 
     #:call
     #:?
-    #:!
-    )
+    #:!)
   (:import-from #:optima
-    #:match)
-  (:shadowing-import-from #:cl-arrows
-    #:->))
+    #:match))
 
 (defpackage #:bones.paip
   (:use
     #:cl
-    #:defstar
     #:bones.quickutils)
   (:documentation "Test?")
   (:export
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/circle.lisp
--- a/src/circle.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/circle.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -52,12 +52,12 @@
 (defstruct circle prev value next)
 
 
-(defun* circle-tie ((c1 circle) (c2 circle))
+(defun circle-tie (c1 c2)
   (setf (circle-next c1) c2
         (circle-prev c2) c1))
 
 
-(defun* make-empty-circle ()
+(defun make-empty-circle ()
   "Create an empty circle.
 
   It will still contain a sentinel.
@@ -68,7 +68,7 @@
           (slot-value circle 'next) circle)
     circle))
 
-(defun* make-circle-with ((list list))
+(defun make-circle-with (list)
   "Create a circle whose nodes contain the values in `list`."
   (let ((sentinel (make-empty-circle)))
     (loop :with prev = sentinel
@@ -81,7 +81,7 @@
                      (circle-tie current sentinel)))
     sentinel))
 
-(defun* make-circle-between ((left circle) value (right circle))
+(defun make-circle-between (left value right)
   ;; L new R
   (let ((c (make-circle :prev left
                         :value value
@@ -91,23 +91,23 @@
     c))
 
 
-(defun* circle-sentinel-p ((circle circle))
+(defun circle-sentinel-p (circle)
   "Return whether this circle node is the sentinel."
   (eq (circle-value circle) +circle-sentinel+))
 
-(defun* circle-empty-p ((circle circle))
+(defun circle-empty-p (circle)
   "Return whether this circle is empty."
   (and (circle-sentinel-p circle)
        (eql circle (circle-next circle))))
 
 
-(defun* circle-rotate ((circle circle) (n integer))
+(defun circle-rotate (circle n)
   (cond
     ((> n 0) (circle-rotate (circle-next circle) (1- n)))
     ((< n 0) (circle-rotate (circle-prev circle) (1+ n)))
     (t circle)))
 
-(defun* circle-nth ((circle circle) (n integer))
+(defun circle-nth (circle n)
   (when (not (circle-sentinel-p circle))
     (error "Can only call circle-nth on the sentinel."))
   (circle-rotate circle
@@ -116,31 +116,31 @@
                    (1+ n))))
 
 
-(defun* circle-insert-before ((circle circle) value)
+(defun circle-insert-before (circle value)
   ;; L new old R
   (let ((old circle)
         (l (circle-prev circle)))
     (make-circle-between l value old)))
 
-(defun* circle-insert-after ((circle circle) value)
+(defun circle-insert-after (circle value)
   ;; L old new R
   (let ((old circle)
         (r (circle-next circle)))
     (make-circle-between old value r)))
 
 
-(defun* circle-insert-beginning ((circle circle) value)
+(defun circle-insert-beginning (circle value)
   (when (not (circle-sentinel-p circle))
     (error "Can only insert-beginning at the sentinel."))
   (circle-insert-after circle value))
 
-(defun* circle-insert-end ((circle circle) value)
+(defun circle-insert-end (circle value)
   (when (not (circle-sentinel-p circle))
     "Can only insert-end at the sentinel.")
   (circle-insert-before circle value))
 
 
-(defun* circle-prepend-circle ((circle circle) (other circle))
+(defun circle-prepend-circle (circle other)
   (when (not (circle-sentinel-p circle))
     (error "Can only prepend to the sentinel."))
   (when (not (circle-sentinel-p other))
@@ -151,12 +151,12 @@
     (circle-tie s (circle-next other))
     (circle-tie (circle-prev other) r)))
 
-(defun* circle-prepend ((circle circle) values)
+(defun circle-prepend (circle values)
   (unless (null values)
     (circle-prepend-circle circle (make-circle-with values))))
 
 
-(defun* circle-append-circle ((circle circle) (other circle))
+(defun circle-append-circle (circle other)
   (when (not (circle-sentinel-p circle))
     (error "Can only append to the sentinel."))
   (when (not (circle-sentinel-p other))
@@ -167,23 +167,23 @@
     (circle-tie l (circle-next other))
     (circle-tie (circle-prev other) s)))
 
-(defun* circle-append ((circle circle) values)
+(defun circle-append (circle values)
   (unless (null values)
     (circle-append-circle circle (make-circle-with values))))
 
 
-(defun* circle-forward ((circle circle))
+(defun circle-forward (circle)
   (let ((next (circle-next circle)))
     (when (not (circle-sentinel-p next))
       next)))
 
-(defun* circle-backward ((circle circle))
+(defun circle-backward (circle)
   (let ((prev (circle-prev circle)))
     (when (not (circle-sentinel-p prev))
       prev)))
 
 
-(defun* circle-remove ((circle circle))
+(defun circle-remove (circle)
   ;; L rem R
   (when (circle-sentinel-p circle)
     (error "Cannot remove sentinel."))
@@ -191,18 +191,18 @@
         (r (circle-next circle)))
     (circle-tie l r)))
 
-(defun* circle-backward-remove ((circle circle))
+(defun circle-backward-remove (circle)
   (prog1
       (circle-backward circle)
     (circle-remove circle)))
 
-(defun* circle-forward-remove ((circle circle))
+(defun circle-forward-remove (circle)
   (prog1
       (circle-forward circle)
     (circle-remove circle)))
 
 
-(defun* circle-replace ((circle circle) value)
+(defun circle-replace (circle value)
   (when (circle-sentinel-p circle)
     (error "Cannot replace sentinel."))
   ;; L new R
@@ -210,18 +210,18 @@
         (r (circle-next circle)))
     (make-circle-between l value r)))
 
-(defun* circle-backward-replace ((circle circle) value)
+(defun circle-backward-replace (circle value)
   (prog1
       (circle-backward circle)
     (circle-replace circle value)))
 
-(defun* circle-forward-replace ((circle circle) value)
+(defun circle-forward-replace (circle value)
   (prog1
       (circle-forward circle)
     (circle-replace circle value)))
 
 
-(defun* circle-splice ((circle circle) values)
+(defun circle-splice (circle values)
   (if (null values)
     (circle-remove circle)
     (progn
@@ -234,18 +234,18 @@
         (circle-tie l (circle-next new))
         (circle-tie (circle-prev new) r)))))
 
-(defun* circle-backward-splice ((circle circle) values)
+(defun circle-backward-splice (circle values)
   (prog1
       (circle-backward circle)
     (circle-splice circle values)))
 
-(defun* circle-forward-splice ((circle circle) values)
+(defun circle-forward-splice (circle values)
   (prog1
       (circle-forward circle)
     (circle-splice circle values)))
 
 
-(defun* circle-to-list ((circle circle) &optional include-sentinel-p)
+(defun circle-to-list (circle &optional include-sentinel-p)
   (loop
     :with node = circle
     :when (or include-sentinel-p
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/paip-compiled.lisp
--- a/src/paip-compiled.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/paip-compiled.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -51,14 +51,14 @@
   (name (incf *var-counter*)) ; The variable's name (defaults to a new number)
   (binding unbound)) ; The variable's binding (defaults to unbound)
 
-(defun* print-var ((var var) stream depth)
+(defun print-var (var stream depth)
   (if (or (and (numberp *print-level*)
                (>= depth *print-level*))
           (var-p (deref var)))
     (format stream "?~A" (var-name var))
     (write var :stream stream)))
 
-(defun* bound-p ((var var))
+(defun bound-p (var)
   "Return whether the given variable has been bound."
   (not (eq (var-binding var) unbound)))
 
@@ -74,7 +74,7 @@
 (defvar *trail* (make-array 200 :fill-pointer 0 :adjustable t)
   "The trail of variable bindings performed so far.")
 
-(defun* set-binding! ((var var) value)
+(defun set-binding! (var value)
   "Set `var`'s binding to `value` after saving it in the trail.
 
   Always returns `t` (success).
@@ -85,7 +85,7 @@
     (setf (var-binding var) value))
   t)
 
-(defun* undo-bindings! ((old-trail integer))
+(defun undo-bindings! (old-trail)
   "Undo all bindings back to a given point in the trail.
 
   The point is specified by giving the desired fill pointer.
@@ -97,7 +97,7 @@
 
 
 ;;;; Unification
-(defun* unify! (x y)
+(defun unify! (x y)
   "Destructively unify two expressions, returning whether it was successful.
 
   Any variables in `x` and `y` may have their bindings set.
@@ -140,10 +140,7 @@
       (compile-predicate symbol arity matching-arity-clauses)
       (prolog-compile symbol other-arity-clauses))))
 
-(defun* clauses-with-arity
-    ((clauses (trivial-types:proper-list clause))
-     (test function)
-     (arity non-negative-integer))
+(defun clauses-with-arity (clauses test arity)
   "Return all clauses whose heads have the given arity."
   (find-all arity clauses
             :key #'(lambda (clause)
@@ -151,7 +148,7 @@
             :test test))
 
 
-(defun* relation-arity ((relation relation))
+(defun relation-arity (relation)
   "Return the number of arguments of the given relation.
 
   For example: `(relation-arity '(likes sally cats))` => `2`
@@ -159,7 +156,7 @@
   "
   (length (relation-arguments relation)))
 
-(defun* relation-arguments ((relation relation))
+(defun relation-arguments (relation)
   "Return the arguments of the given relation.
 
   For example:
@@ -171,10 +168,7 @@
   (rest relation))
 
 
-(defun* compile-predicate
-    ((symbol symbol)
-     (arity non-negative-integer)
-     (clauses (trivial-types:proper-list clause)))
+(defun compile-predicate (symbol arity clauses)
   "Compile all the clauses for the symbol+arity into a single Lisp function."
   (let ((predicate (make-predicate symbol arity))
         (parameters (make-parameters arity)))
@@ -186,13 +180,12 @@
                          (compile-clause parameters clause 'continuation))
                       clauses)))))))
 
-(defun* make-parameters ((arity non-negative-integer))
+(defun make-parameters (arity)
   "Return the list (?arg1 ?arg2 ... ?argN)."
   (loop :for i :from 1 :to arity
         :collect (new-symbol '?arg i)))
 
-(defun* make-predicate ((symbol symbol)
-                        (arity non-negative-integer))
+(defun make-predicate (symbol arity)
   "Returns (and interns) the symbol with the Prolog-style name symbol/arity."
   (values (interned-symbol symbol '/ arity)))
 
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/paip.lisp
--- a/src/paip.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/paip.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -24,40 +24,35 @@
 
 
 ;;;; Unification
-(defun* variable-p (term)
+(defun variable-p (term)
   "Return whether the given term is a logic variable."
   (and (symbolp term)
        (equal (char (symbol-name term) 0)
               #\?)))
 
 
-(defun* get-binding ((variable logic-variable)
-                     (bindings binding-list))
+(defun get-binding (variable bindings)
   "Return the binding (var . val) for the given variable, or nil."
   (assoc variable bindings))
 
-(defun* has-binding ((variable logic-variable)
-                     (bindings binding-list))
+(defun has-binding (variable bindings)
   (not (null (get-binding variable bindings))))
 
 
-(defun* binding-variable ((binding binding))
+(defun binding-variable (binding)
   "Return the variable part of a binding."
   (car binding))
 
-(defun* binding-value ((binding binding))
+(defun binding-value (binding)
   "Return the value part of a binding."
   (cdr binding))
 
 
-(defun* lookup ((variable logic-variable)
-                (bindings binding-list))
+(defun lookup (variable bindings)
   "Return the value the given variable is bound to."
   (binding-value (get-binding variable bindings)))
 
-(defun* extend-bindings ((variable logic-variable)
-                         (value t)
-                         (bindings binding-list))
+(defun extend-bindings (variable value bindings)
   "Add a binding (var . val) to the binding list (nondestructively)."
   (cons (cons variable value)
         (if (and (equal bindings no-bindings))
@@ -65,9 +60,7 @@
           bindings)))
 
 
-(defun* check-occurs ((variable logic-variable)
-                      (target t)
-                      (bindings binding-list))
+(defun check-occurs (variable target bindings)
   "Check whether the variable occurs somewhere in the target.
 
   Takes the bindings into account.  This is expensive.
@@ -145,8 +138,7 @@
 
 
 ;;;; Substitution
-(defun* substitute-bindings ((bindings binding-list)
-                             (form t))
+(defun substitute-bindings (bindings form)
   "Substitute (recursively) the bindings into the given form."
   (cond ((eq bindings fail) fail)
         ((eq bindings no-bindings) form)
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/utils.lisp
--- a/src/utils.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/utils.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -158,13 +158,13 @@
   (size 0 :type fixnum))
 
 
-(defun* make-queue ()
+(defun make-queue ()
   (make-queue%))
 
-(defun* queue-empty-p ((q queue))
+(defun queue-empty-p (q)
   (zerop (queue-size q)))
 
-(defun* enqueue ((item t) (q queue))
+(defun enqueue (item q)
   (let ((cell (cons item nil)))
     (setf (queue-last q)
           (if (queue-empty-p q)
@@ -172,12 +172,12 @@
             (setf (cdr (queue-last q)) cell))))
   (incf (queue-size q)))
 
-(defun* dequeue ((q queue))
+(defun dequeue (q)
   (when (zerop (decf (queue-size q)))
     (setf (queue-last q) nil))
   (pop (queue-contents q)))
 
-(defun* queue-append ((q queue) (l list))
+(defun queue-append (q l)
   (loop :for item :in l
         :for size = (enqueue item q)
         :finally (return size)))
@@ -185,7 +185,7 @@
 
 ;;;; Lookup Tables
 (defmacro define-lookup
-    (name (key key-type value-type default) documentation &rest entries)
+    (name (key value-type default) documentation &rest entries)
   "Define a lookup function.
 
   This macro defines a function that looks up a result in a constant array.
@@ -201,8 +201,7 @@
   with that.
 
   `key` should be a symbol that will be used as the argument for the lookup
-  function.  `key-type` should be its type and should be a subtype of
-  (integer 0 some-small-number) if you want this to be efficient.
+  function.
 
   `value-type` should be the type of your results.
 
@@ -228,7 +227,7 @@
                           :collect (getf entries i default))))
           :test (lambda (x y) (declare (ignore x y)) t)) ; what could go wrong
         (declaim (inline ,name))
-        (defun* ,name ((,key ,key-type))
+        (defun ,name (,key)
           ,documentation
           (the ,value-type (aref ,table ,key)))))))
 
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/bytecode.lisp
--- a/src/wam/bytecode.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/bytecode.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -2,7 +2,7 @@
 
 
 ;;;; Opcodes
-(defun* opcode-name ((opcode opcode))
+(defun opcode-name (opcode)
   (eswitch (opcode)
     (+opcode-noop+ "NOOP")
 
@@ -47,7 +47,7 @@
     (+opcode-get-lisp-object+ "GET-LISP-OBJECT")
     (+opcode-put-lisp-object+ "PUT-LISP-OBJECT")))
 
-(defun* opcode-short-name ((opcode opcode))
+(defun opcode-short-name (opcode)
   (eswitch (opcode)
     (+opcode-noop+ "NOOP")
 
@@ -94,7 +94,7 @@
 
 
 ;;;; Instructions
-(define-lookup instruction-size (opcode opcode instruction-size 0)
+(define-lookup instruction-size (opcode instruction-size 0)
   "Return the size of an instruction for the given opcode.
 
   The size includes one word for the opcode itself and one for each argument.
@@ -145,7 +145,7 @@
 
 
 ;;;; Cells
-(define-lookup cell-type-name (type cell-type string "")
+(define-lookup cell-type-name (type string "")
   "Return the full name of a cell type."
   (#.+cell-type-null+ "NULL")
   (#.+cell-type-structure+ "STRUCTURE")
@@ -156,7 +156,7 @@
   (#.+cell-type-lisp-object+ "LISP-OBJECT")
   (#.+cell-type-stack+ "STACK"))
 
-(define-lookup cell-type-short-name (type cell-type string "")
+(define-lookup cell-type-short-name (type string "")
   "Return the short name of a cell type."
   (#.+cell-type-null+ "NUL")
   (#.+cell-type-structure+ "STR")
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/0-data.lisp
--- a/src/wam/compiler/0-data.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/0-data.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -12,7 +12,7 @@
 ;;;; Utils
 (declaim (inline variablep))
 
-(defun* variablep (term)
+(defun variablep (term)
   (and (symbolp term)
        (char= (char (symbol-name term) 0) #\?)))
 
@@ -44,18 +44,18 @@
   (number (required) :type register-number))
 
 
-(defun* make-temporary-register ((number register-number) (arity arity))
+(defun make-temporary-register (number arity)
   (make-register (if (< number arity) :argument :local)
                  number))
 
-(defun* make-permanent-register ((number register-number))
+(defun make-permanent-register (number)
   (make-register :permanent number))
 
-(defun* make-anonymous-register ()
+(defun make-anonymous-register ()
   (make-register :anonymous 0))
 
 
-(defun* register-to-string ((register register))
+(defun register-to-string (register)
   (if (eq (register-type register) :anonymous)
     "__"
     (format nil "~A~D"
@@ -71,20 +71,20 @@
     (format stream (register-to-string object))))
 
 
-(defun* register-argument-p ((register register))
+(defun register-argument-p (register)
   (eq (register-type register) :argument))
 
-(defun* register-temporary-p ((register register))
+(defun register-temporary-p (register)
   (and (member (register-type register) '(:argument :local)) t))
 
-(defun* register-permanent-p ((register register))
+(defun register-permanent-p (register)
   (eq (register-type register) :permanent))
 
-(defun* register-anonymous-p ((register register))
+(defun register-anonymous-p (register)
   (eq (register-type register) :anonymous))
 
 
-(defun* register= ((r1 register) (r2 register))
+(defun register= (r1 r2)
   (and (eq (register-type r1)
            (register-type r2))
        (= (register-number r1)
@@ -104,7 +104,7 @@
   (anonymous-vars nil :type list))
 
 
-(defun* find-variables ((terms list))
+(defun find-variables (terms)
   "Return the set of variables in `terms`."
   (let ((variables nil))
     (recursively ((term terms))
@@ -172,7 +172,7 @@
     once))
 
 
-(defun* determine-clause-properties (head body)
+(defun determine-clause-properties (head body)
   (let* ((clause
            (cons head body))
          (permanent-vars
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/1-parsing.lisp
--- a/src/wam/compiler/1-parsing.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/1-parsing.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -48,10 +48,11 @@
   (object nil :type t))
 
 
-(defgeneric* node-children (node)
+(defgeneric node-children (node)
+  (:documentation
   "Return the children of the given node.
 
-  Presumably these will need to be traversed when allocating registers.")
+  Presumably these will need to be traversed when allocating registers."))
 
 (defmethod node-children ((node vanilla-node))
   (list))
@@ -66,7 +67,7 @@
   (list (node-head node) (node-tail node)))
 
 
-(defun* nil-node-p ((node node))
+(defun nil-node-p (node)
   "Return whether the given node is the magic nil/0 constant."
   (and (typep node 'structure-node)
        (eql (node-functor node) nil)
@@ -145,7 +146,7 @@
     (dump-node node)))
 
 
-(defun* parse-list ((contents list))
+(defun parse-list (contents)
   (if contents
     (make-list-node :head (parse (car contents))
                     :tail (parse-list (cdr contents)))
@@ -153,14 +154,14 @@
                          :arity 0
                          :arguments ())))
 
-(defun* parse-list* ((contents list))
+(defun parse-list* (contents)
   (destructuring-bind (next . remaining) contents
     (if (null remaining)
       (parse next)
       (make-list-node :head (parse next)
                       :tail (parse-list* remaining)))))
 
-(defun* parse (term &optional top-level-argument)
+(defun parse (term &optional top-level-argument)
   (cond
     ((variablep term)
      (if top-level-argument
@@ -184,7 +185,7 @@
      (make-lisp-object-node :object term))
     (t (error "Cannot parse term ~S into a Prolog term." term))))
 
-(defun* parse-top-level (term)
+(defun parse-top-level (term)
   (typecase term
     (symbol (parse-top-level (list term))) ; c/0 -> (c/0)
     (cons (destructuring-bind (functor . arguments) term
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/2-register-allocation.lisp
--- a/src/wam/compiler/2-register-allocation.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/2-register-allocation.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -149,7 +149,7 @@
   (actual-arity 0 :type arity))
 
 
-(defun* find-variable ((state allocation-state) (variable symbol))
+(defun find-variable (state variable)
   "Return the register that already contains this variable, or `nil` otherwise."
   (or (when-let (r (position variable
                              (queue-contents
@@ -160,7 +160,7 @@
         (make-permanent-register s))
       nil))
 
-(defun* store-variable ((state allocation-state) (variable symbol))
+(defun store-variable (state variable)
   "Assign `variable` to the next available local register.
 
   It is assumed that `variable` is not already assigned to another register
@@ -174,7 +174,7 @@
     :local
     (1- (enqueue variable (allocation-state-local-registers state)))))
 
-(defun* ensure-variable ((state allocation-state) (variable symbol))
+(defun ensure-variable (state variable)
   (or (find-variable state variable)
       (store-variable state variable)))
 
@@ -185,17 +185,17 @@
       (setf (,accessor ,instance) ,value-form))))
 
 
-(defun* variable-anonymous-p ((state allocation-state) (variable symbol))
+(defun variable-anonymous-p (state variable)
   "Return whether `variable` is considered anonymous in `state`."
   (and (member variable (allocation-state-anonymous-variables state)) t))
 
 
-(defun* allocate-variable-register ((state allocation-state) (variable symbol))
+(defun allocate-variable-register (state variable)
   (if (variable-anonymous-p state variable)
     (make-anonymous-register)
     (ensure-variable state variable)))
 
-(defun* allocate-nonvariable-register ((state allocation-state))
+(defun allocate-nonvariable-register (state)
   "Allocate and return a register for something that's not a variable."
   ;; We need to allocate registers for things like structures and lists, but we
   ;; never need to look them up later (like we do with variables), so we'll just
@@ -233,15 +233,13 @@
                 (allocate-nonvariable-register state)))
 
 
-(defun* allocate-argument-registers ((node top-level-node))
+(defun allocate-argument-registers (node)
   (loop :for argument :in (top-level-node-arguments node)
         :for i :from 0
         :do (setf (node-register argument)
                   (make-register :argument i))))
 
-(defun* allocate-nonargument-registers ((node top-level-node)
-                                        (clause-props clause-properties)
-                                        &key nead)
+(defun allocate-nonargument-registers (node clause-props &key nead)
   ;; JESUS TAKE THE WHEEL
   (let*
       ((actual-arity (top-level-node-arity node))
@@ -282,9 +280,7 @@
           (allocate-register node allocation-state)
           (recur (append remaining (node-children node))))))))
 
-(defun* allocate-registers ((node top-level-node)
-                            (clause-props clause-properties)
-                            &key nead)
+(defun allocate-registers (node clause-props &key nead)
   (allocate-argument-registers node)
   (allocate-nonargument-registers node clause-props :nead nead))
 
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/3-flattening.lisp
--- a/src/wam/compiler/3-flattening.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/3-flattening.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -80,7 +80,7 @@
             (lisp-object-to-string (assignment-object assignment)))))
 
 
-(defgeneric* node-flatten (node))
+(defgeneric node-flatten (node))
 
 (defmethod node-flatten (node)
   nil)
@@ -109,7 +109,7 @@
             :object (node-object node))))
 
 
-(defun* flatten-breadth-first ((tree top-level-node))
+(defun flatten-breadth-first (tree)
   (let ((results nil))
     (recursively ((node tree))
       (when-let (assignment (node-flatten node))
@@ -117,7 +117,7 @@
       (mapcar #'recur (node-children node)))
     (nreverse results)))
 
-(defun* flatten-depth-first-post-order ((tree top-level-node))
+(defun flatten-depth-first-post-order (tree)
   (let ((results nil))
     (recursively ((node tree))
       (mapcar #'recur (node-children node))
@@ -126,10 +126,10 @@
     (nreverse results)))
 
 
-(defun* flatten-query ((tree top-level-node))
+(defun flatten-query (tree)
   (flatten-depth-first-post-order tree))
 
-(defun* flatten-program ((tree top-level-node))
+(defun flatten-program (tree)
   (flatten-breadth-first tree))
 
 
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/4-tokenization.lisp
--- a/src/wam/compiler/4-tokenization.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/4-tokenization.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -48,7 +48,7 @@
 (defclass cut-token (token) ())
 
 
-(defun* make-register-token ((register register))
+(defun make-register-token (register)
   (values (make-instance 'register-token :register register)))
 
 
@@ -95,8 +95,8 @@
     (format stream "CUT!")))
 
 
-(defgeneric* tokenize-assignment ((assignment register-assignment))
-  "Tokenize `assignment` into a flat list of tokens.")
+(defgeneric tokenize-assignment (assignment)
+  (:documentation "Tokenize `assignment` into a flat list of tokens."))
 
 (defmethod tokenize-assignment ((assignment structure-assignment))
   (list* (make-instance 'structure-token
@@ -120,20 +120,18 @@
                        :register (assignment-register assignment)
                        :object (assignment-object assignment))))
 
-(defun* tokenize-assignments ((assignments list))
+(defun tokenize-assignments (assignments)
   "Tokenize a flattened set of register assignments into a stream."
   (mapcan #'tokenize-assignment assignments))
 
 
-(defun* tokenize-program-term (term (clause-props clause-properties))
+(defun tokenize-program-term (term clause-props)
   "Tokenize `term` as a program term, returning its tokens."
   (let ((tree (parse-top-level term)))
     (allocate-registers tree clause-props :nead t)
     (-> tree flatten-program tokenize-assignments)))
 
-(defun* tokenize-query-term (term
-                             (clause-props clause-properties)
-                             &key in-nead is-tail)
+(defun tokenize-query-term (term clause-props &key in-nead is-tail)
   "Tokenize `term` as a query term, returning its tokens."
   (let ((tree (parse-top-level term)))
     (allocate-registers tree clause-props :nead in-nead)
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/5-precompilation.lisp
--- a/src/wam/compiler/5-precompilation.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/5-precompilation.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -104,7 +104,7 @@
 ;;; on that rabbit hole).
 
 
-(defun* find-opcode-register ((first-seen boolean) (register register))
+(defun find-opcode-register (first-seen register)
   (let ((register-variant (when register
                             (ecase (register-type register)
                               ((:local :argument) :local)
@@ -120,24 +120,22 @@
         (:stack :subterm-value-stack)
         (:void :subterm-void)))))
 
-(defun* find-opcode-list ((mode keyword))
+(defun find-opcode-list (mode)
   (ecase mode
     (:program :get-list)
     (:query :put-list)))
 
-(defun* find-opcode-lisp-object ((mode keyword))
+(defun find-opcode-lisp-object (mode)
   (ecase mode
     (:program :get-lisp-object)
     (:query :put-lisp-object)))
 
-(defun* find-opcode-structure ((mode keyword))
+(defun find-opcode-structure (mode)
   (ecase mode
     (:program :get-structure)
     (:query :put-structure)))
 
-(defun* find-opcode-argument ((first-seen boolean)
-                              (mode keyword)
-                              (register register))
+(defun find-opcode-argument (first-seen mode register)
   (let ((register-variant (ecase (register-type register)
                             ((:local :argument) :local)
                             ((:permanent) :stack))))
@@ -158,7 +156,7 @@
                   (:stack :put-value-stack)))))))
 
 
-(defun* precompile-tokens ((head-tokens list) (body-tokens list))
+(defun precompile-tokens (head-tokens body-tokens)
   "Generate a series of machine instructions from a stream of head and body
   tokens.
 
@@ -270,7 +268,7 @@
       instructions)))
 
 
-(defun* precompile-clause (head body)
+(defun precompile-clause (head body)
   "Precompile the clause.
 
   `head` should be the head of the clause for program clauses, or `nil` for
@@ -348,7 +346,7 @@
       (values instructions clause-props))))
 
 
-(defun* precompile-query ((query list))
+(defun precompile-query (query)
   "Compile `query`, returning the instructions and permanent variables.
 
   `query` should be a list of goal terms.
@@ -360,7 +358,7 @@
             (clause-permanent-vars clause-props))))
 
 
-(defun* find-predicate ((clause cons))
+(defun find-predicate (clause)
   "Return the functor and arity of the predicate of `clause`."
   ;; ( (f ?x ?y)   | head     ||| clause
   ;;   (foo ?x)      || body  |||
@@ -374,7 +372,7 @@
       (t (error "Clause ~S has a malformed head." clause)))))
 
 
-(defun* precompile-rules ((rules list))
+(defun precompile-rules (rules)
   "Compile a single predicate's `rules` into a list of instructions.
 
   All the rules must for the same predicate.  This is not checked, for
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/6-optimization.lisp
--- a/src/wam/compiler/6-optimization.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/6-optimization.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -13,21 +13,15 @@
 ;;; circle of instructions, doing one optimization each time.
 
 
-(defun* optimize-get-constant ((node circle)
-                               (constant fname)
-                               (register register))
+(defun optimize-get-constant (node constant register)
   ;; 1. get_structure c/0, Ai -> get_constant c, Ai
   (circle-replace node `(:get-constant ,constant ,register)))
 
-(defun* optimize-put-constant ((node circle)
-                               (constant fname)
-                               (register register))
+(defun optimize-put-constant (node constant register)
   ;; 2. put_structure c/0, Ai -> put_constant c, Ai
   (circle-replace node `(:put-constant ,constant ,register)))
 
-(defun* optimize-subterm-constant-query ((node circle)
-                                         (constant fname)
-                                         (register register))
+(defun optimize-subterm-constant-query (node constant register)
   ;; 3. put_structure c/0, Xi                     *** WE ARE HERE
   ;;    ...
   ;;    subterm_value Xi          -> subterm_constant c
@@ -43,9 +37,7 @@
     (circle-replace n `(:subterm-constant ,constant))
     (return previous)))
 
-(defun* optimize-subterm-constant-program ((node circle)
-                                           (constant fname)
-                                           (register register))
+(defun optimize-subterm-constant-program (node constant register)
   ;; 4. subterm_variable Xi       -> subterm_constant c
   ;;    ...
   ;;    get_structure c/0, Xi                     *** WE ARE HERE
@@ -60,7 +52,7 @@
     (circle-replace n `(:subterm-constant ,constant))
     (return (circle-backward-remove node))))
 
-(defun* optimize-constants ((instructions circle))
+(defun optimize-constants (instructions)
   ;; From the book and the erratum, there are four optimizations we can do for
   ;; constants (0-arity structures).
 
@@ -84,7 +76,7 @@
   instructions)
 
 
-(defun* optimize-void-runs ((instructions circle))
+(defun optimize-void-runs (instructions)
   ;; We can optimize runs of N (:[unify/set]-void 1) instructions into a single
   ;; one that does all N at once.
   (loop
@@ -109,7 +101,7 @@
   instructions)
 
 
-(defun* optimize-instructions ((instructions circle))
+(defun optimize-instructions (instructions)
   (->> instructions
     (optimize-constants)
     (optimize-void-runs)))
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/7-rendering.lisp
--- a/src/wam/compiler/7-rendering.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/7-rendering.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -22,10 +22,7 @@
     (1- (instruction-size opcode))))
 
 
-(defun* code-push-instruction ((store generic-code-store)
-                               (opcode opcode)
-                               (arguments list)
-                               (address code-index))
+(defun code-push-instruction (store opcode arguments address)
   "Push the given instruction into `store` at `address`.
 
   `arguments` should be a list of `code-word`s.
@@ -39,7 +36,7 @@
   (instruction-size opcode))
 
 
-(defun* render-opcode ((opcode-designator keyword))
+(defun render-opcode (opcode-designator)
   (ecase opcode-designator
     (:get-structure          +opcode-get-structure+)
     (:get-variable-local     +opcode-get-variable-local+)
@@ -76,7 +73,7 @@
     (:trust                  +opcode-trust+)
     (:cut                    +opcode-cut+)))
 
-(defun* render-argument (argument)
+(defun render-argument (argument)
   (cond
     ;; Ugly choice point args that'll be filled later...
     ((eq +choice-point-placeholder+ argument) 0)
@@ -87,10 +84,7 @@
     ;; Everything else just gets shoved right into the array.
     (t argument)))
 
-(defun* render-bytecode ((store generic-code-store)
-                         (instructions circle)
-                         (start code-index)
-                         (limit code-index))
+(defun render-bytecode (store instructions start limit)
   "Render `instructions` (a circle) into `store` starting at `start`.
 
   Bail if ever pushed beyond `limit`.
@@ -134,22 +128,16 @@
         :do (incf address size)))))
 
 
-(defun* render-query ((wam wam) (instructions circle))
+(defun render-query (wam instructions)
   (render-bytecode (wam-code wam) instructions 0 +maximum-query-size+))
 
 
-(defun* mark-label ((wam wam)
-                    (functor symbol)
-                    (arity arity)
-                    (address code-index))
+(defun mark-label (wam functor arity address)
   "Set the code label `functor`/`arity` to point at `address`."
   (setf (wam-code-label wam functor arity)
         address))
 
-(defun* render-rules ((wam wam)
-                      (functor symbol)
-                      (arity arity)
-                      (instructions circle))
+(defun render-rules (wam functor arity instructions)
   ;; Before we render the instructions, make the label point at where they're
   ;; about to go.
   (mark-label wam functor arity (wam-code-pointer wam))
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/compiler/8-ui.lisp
--- a/src/wam/compiler/8-ui.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/compiler/8-ui.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -8,7 +8,7 @@
 
 ;;; The final phase wraps everything else up into a sane UI.
 
-(defun* compile-query ((wam wam) (query list))
+(defun compile-query (wam query)
   "Compile `query` into the query section of the WAM's code store.
 
   `query` should be a list of goal terms.
@@ -22,7 +22,7 @@
     (render-query wam instructions)
     permanent-variables))
 
-(defun* compile-rules ((wam wam) (rules list))
+(defun compile-rules (wam rules)
   "Compile `rules` into the WAM's code store.
 
   Each rule in `rules` should be a clause consisting of a head term and zero or
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/vm.lisp
--- a/src/wam/vm.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/vm.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -9,11 +9,11 @@
                  constants-match-p))
 
 
-(defun* push-unbound-reference! ((wam wam))
+(defun push-unbound-reference! (wam)
   "Push a new unbound reference cell onto the heap, returning its address."
   (wam-heap-push! wam +cell-type-reference+ (wam-heap-pointer wam)))
 
-(defun* push-new-structure! ((wam wam))
+(defun push-new-structure! (wam)
   "Push a new structure cell onto the heap, returning its address.
 
   The structure cell's value will point at the next address, so make sure you
@@ -22,7 +22,7 @@
   "
   (wam-heap-push! wam +cell-type-structure+ (1+ (wam-heap-pointer wam))))
 
-(defun* push-new-list! ((wam wam))
+(defun push-new-list! (wam)
   "Push a new list cell onto the heap, returning its address.
 
   The list cell's value will point at the next address, so make sure you push
@@ -31,28 +31,27 @@
   "
   (wam-heap-push! wam +cell-type-list+ (1+ (wam-heap-pointer wam))))
 
-(defun* push-new-functor! ((wam wam) (functor fname) (arity arity))
+(defun push-new-functor! (wam functor arity)
   "Push a new functor cell pair onto the heap, returning its address."
   (prog1
       (wam-heap-push! wam +cell-type-functor+ functor)
     (wam-heap-push! wam +cell-type-lisp-object+ arity)))
 
-(defun* push-new-constant! ((wam wam) (constant fname))
+(defun push-new-constant! (wam constant)
   "Push a new constant cell onto the heap, returning its address."
   (wam-heap-push! wam +cell-type-constant+ constant))
 
 
-(defun* functors-match-p ((f1 fname) (a1 arity)
-                          (f2 fname) (a2 arity))
+(defun functors-match-p (f1 a1 f2 a2)
   "Return whether the two functor cell values represent the same functor."
   (and (eq f1 f2)
        (= a1 a2)))
 
-(defun* constants-match-p ((c1 fname) (c2 fname))
+(defun constants-match-p (c1 c2)
   "Return whether the two constant cell values unify."
   (eq c1 c2))
 
-(defun* lisp-objects-match-p ((o1 t) (o2 t))
+(defun lisp-objects-match-p (o1 o2)
   "Return whether the two lisp object cells unify."
   (eql o1 o2))
 
@@ -61,7 +60,7 @@
 (declaim (inline deref unbind! trail!))
 
 
-(defun* backtrack! ((wam wam))
+(defun backtrack! (wam)
   "Backtrack after a failure."
   (if (wam-backtrack-pointer-unset-p wam)
     (setf (wam-fail wam) t)
@@ -69,12 +68,12 @@
           (wam-cut-pointer wam) (wam-stack-choice-cc wam)
           (wam-backtracked wam) t)))
 
-(defun* trail! ((wam wam) (address store-index))
+(defun trail! (wam address)
   "Push the given address onto the trail (but only if necessary)."
   (when (< address (wam-heap-backtrack-pointer wam))
     (wam-trail-push! wam address)))
 
-(defun* unbind! ((wam wam) (address store-index))
+(defun unbind! (wam address)
   "Unbind the reference cell at `address`.
 
   No error checking is done, so please don't try to unbind something that's not
@@ -83,14 +82,12 @@
   "
   (wam-set-store-cell! wam address +cell-type-reference+ address))
 
-(defun* unwind-trail! ((wam wam)
-                       (trail-start trail-index)
-                       (trail-end trail-index))
+(defun unwind-trail! (wam trail-start trail-end)
   "Unbind all the things in the given range of the trail."
   (loop :for i :from trail-start :below trail-end :do
         (unbind! wam (wam-trail-value wam i))))
 
-(defun* tidy-trail! ((wam wam))
+(defun tidy-trail! (wam)
   (with-accessors ((tr wam-trail-pointer)
                    (h wam-heap-pointer)
                    (hb wam-heap-backtrack-pointer)
@@ -114,7 +111,7 @@
                 (wam-trail-value wam (1- tr)))
           (decf tr))))))
 
-(defun* deref ((wam wam) (address store-index))
+(defun deref (wam address)
   "Dereference the address in the WAM store to its eventual destination.
 
   If the address is a variable that's bound to something, that something will be
@@ -130,7 +127,7 @@
                           (setf address ref))) ; bound ref
       (t (return address))))) ; non-ref
 
-(defun* bind! ((wam wam) (address-1 store-index) (address-2 store-index))
+(defun bind! (wam address-1 address-2)
   "Bind the unbound reference cell to the other.
 
   `bind!` takes two addresses as arguments.  You are expected to have `deref`ed
@@ -171,7 +168,7 @@
     ;; wut
     (t (error "At least one cell must be an unbound reference when binding."))))
 
-(defun* unify! ((wam wam) (a1 store-index) (a2 store-index))
+(defun unify! (wam a1 a2)
   (setf (wam-fail wam) nil)
   (wam-unification-stack-push! wam a1 a2)
 
@@ -268,7 +265,7 @@
 ;;;
 ;;; To make the process of defining these two "variants" less excruciating we
 ;;; have these two macros.  `define-instruction` (singular) is just a little
-;;; sugar around `defun*`, for those instructions that don't deal with
+;;; sugar around `defun`, for those instructions that don't deal with
 ;;; arguments.
 ;;;
 ;;; `define-instructions` (plural) is the awful one.  You pass it a pair of
@@ -290,13 +287,14 @@
     ((name &optional should-inline) lambda-list &body body)
   "Define an instruction function.
 
-  This is just sugar over `defun*`.
+  This is just sugar over `defun`.
 
   "
   `(progn
     (declaim (,(if should-inline 'inline 'notinline) ,name))
-    (defun* ,name ,lambda-list
-      ,@body)))
+    (defun ,name ,lambda-list
+      ,@body
+      nil)))
 
 (defmacro define-instructions
     ((local-name stack-name &optional should-inline) lambda-list &body body)
@@ -329,19 +327,13 @@
 
 
 ;;;; Query Instructions
-(define-instruction (%put-structure)
-    ((wam wam)
-     (functor fname)
-     (arity arity)
-     (register register-index))
+(define-instruction (%put-structure) (wam functor arity register)
   (wam-set-local-register! wam register
                            +cell-type-structure+
                            (push-new-functor! wam functor arity))
   (setf (wam-mode wam) :write))
 
-(define-instruction (%put-list)
-    ((wam wam)
-     (register register-index))
+(define-instruction (%put-list) (wam register)
   (wam-set-local-register! wam register
                            +cell-type-list+
                            (wam-heap-pointer wam))
@@ -349,27 +341,20 @@
 
 
 (define-instructions (%put-variable-local %put-variable-stack)
-    ((wam wam)
-     (register register-index)
-     (argument register-index))
+    (wam register argument)
   (let ((ref (push-unbound-reference! wam)))
     (%wam-copy-to-register% wam register ref)
     (wam-copy-to-local-register! wam argument ref)
     (setf (wam-mode wam) :write)))
 
 (define-instructions (%put-value-local %put-value-stack)
-    ((wam wam)
-     (register register-index)
-     (argument register-index))
+    (wam register argument)
   (wam-copy-to-local-register! wam argument (%wam-register% wam register))
   (setf (wam-mode wam) :write))
 
 
 ;;;; Program Instructions
-(define-instruction (%get-structure) ((wam wam)
-                                      (functor fname)
-                                      (arity arity)
-                                      (register register-index))
+(define-instruction (%get-structure) (wam functor arity register)
   (cell-typecase (wam (deref wam register) address)
     ;; If the register points at an unbound reference cell, we push three new
     ;; cells onto the heap:
@@ -417,8 +402,7 @@
     ;; Otherwise we can't unify, so backtrack.
     (t (backtrack! wam))))
 
-(define-instruction (%get-list) ((wam wam)
-                                 (register register-index))
+(define-instruction (%get-list) (wam register)
   (cell-typecase (wam (deref wam register) address)
     ;; If the register points at a reference (unbound, because we deref'ed) we
     ;; bind it to a list and flip into write mode to write the upcoming two
@@ -437,22 +421,17 @@
 
 
 (define-instructions (%get-variable-local %get-variable-stack)
-    ((wam wam)
-     (register register-index)
-     (argument register-index))
+    (wam register argument)
   (%wam-copy-to-register% wam register argument))
 
 (define-instructions (%get-value-local %get-value-stack)
-    ((wam wam)
-     (register register-index)
-     (argument register-index))
+    (wam register argument)
   (unify! wam register argument))
 
 
 ;;;; Subterm Instructions
 (define-instructions (%subterm-variable-local %subterm-variable-stack)
-    ((wam wam)
-     (register register-index))
+    (wam register)
   (%wam-copy-to-register% wam register
                           (ecase (wam-mode wam)
                             (:read (wam-subterm wam))
@@ -460,8 +439,7 @@
   (incf (wam-subterm wam)))
 
 (define-instructions (%subterm-value-local %subterm-value-stack)
-    ((wam wam)
-     (register register-index))
+    (wam register)
   (ecase (wam-mode wam)
     (:read (unify! wam register (wam-subterm wam)))
     (:write (wam-heap-push! wam
@@ -469,7 +447,7 @@
                             (%wam-register-value% wam register))))
   (incf (wam-subterm wam)))
 
-(define-instruction (%subterm-void) ((wam wam) (n arity))
+(define-instruction (%subterm-void) (wam n)
   (ecase (wam-mode wam)
     (:read (incf (wam-subterm wam) n))
     (:write (repeat n
@@ -480,11 +458,7 @@
 (declaim (inline %%procedure-call %%dynamic-procedure-call))
 
 
-(defun* %%procedure-call ((wam wam)
-                          (functor fname)
-                          (arity arity)
-                          (program-counter-increment instruction-size)
-                          (is-tail boolean))
+(defun %%procedure-call (wam functor arity program-counter-increment is-tail)
   (let* ((target (wam-code-label wam functor arity)))
     (if (not target)
       ;; Trying to call an unknown procedure.
@@ -502,15 +476,15 @@
               (wam-program-counter wam) ; jump
               target)))))
 
-(defun* %%dynamic-procedure-call ((wam wam) (is-tail boolean))
-  (flet*
+(defun %%dynamic-procedure-call (wam is-tail)
+  (flet
     ((%go (functor arity)
        (if is-tail
          (%%procedure-call
            wam functor arity (instruction-size +opcode-dynamic-jump+) t)
          (%%procedure-call
            wam functor arity (instruction-size +opcode-dynamic-call+) nil)))
-     (load-arguments ((n arity) start-address)
+     (load-arguments (n start-address)
        (loop :for arg :from 0 :below n
              :for source :from start-address
              :do (wam-copy-to-local-register! wam arg source))))
@@ -536,29 +510,29 @@
       (t (error "Cannot dynamically call something other than a structure.")))))
 
 
-(define-instruction (%jump) ((wam wam) (functor fname) (arity arity))
+(define-instruction (%jump) (wam functor arity)
   (%%procedure-call wam functor arity
                     (instruction-size +opcode-jump+)
                     t))
 
-(define-instruction (%call) ((wam wam) (functor fname) (arity arity))
+(define-instruction (%call) (wam functor arity)
   (%%procedure-call wam functor arity
                     (instruction-size +opcode-call+)
                     nil))
 
 
-(define-instruction (%dynamic-call) ((wam wam))
+(define-instruction (%dynamic-call) (wam)
   (%%dynamic-procedure-call wam nil))
 
-(define-instruction (%dynamic-jump) ((wam wam))
+(define-instruction (%dynamic-jump) (wam)
   (%%dynamic-procedure-call wam t))
 
 
-(define-instruction (%proceed) ((wam wam))
+(define-instruction (%proceed) (wam)
   (setf (wam-program-counter wam) ; P <- CP
         (wam-continuation-pointer wam)))
 
-(define-instruction (%allocate) ((wam wam) (n stack-frame-argcount))
+(define-instruction (%allocate) (wam n)
   (let ((old-e (wam-environment-pointer wam))
         (new-e (wam-stack-top wam)))
     (wam-stack-ensure-size wam (+ new-e 4 n))
@@ -568,7 +542,7 @@
           (wam-stack-word wam (+ new-e 3)) n ; N
           (wam-environment-pointer wam) new-e))) ; E <- new-e
 
-(define-instruction (%deallocate) ((wam wam))
+(define-instruction (%deallocate) (wam)
   (setf (wam-continuation-pointer wam) (wam-stack-frame-cp wam)
         (wam-environment-pointer wam) (wam-stack-frame-ce wam)
         (wam-cut-pointer wam) (wam-stack-frame-cut wam)))
@@ -578,8 +552,7 @@
 (declaim (inline reset-choice-point! restore-registers-from-choice-point!))
 
 
-(defun* reset-choice-point! ((wam wam)
-                             (b backtrack-pointer))
+(defun reset-choice-point! (wam b)
   (setf (wam-backtrack-pointer wam) b
 
         ;; The book is wrong here: when resetting HB we use the NEW value of B,
@@ -597,14 +570,13 @@
           +heap-start+
           (wam-stack-choice-h wam b))))
 
-(defun* restore-registers-from-choice-point! ((wam wam)
-                                              (b backtrack-pointer))
+(defun restore-registers-from-choice-point! (wam b)
   (loop :for register :from 0 :below (wam-stack-choice-n wam b)
         :for saved-register :from (wam-stack-choice-argument-address wam 0 b)
         :do (wam-copy-to-local-register! wam register saved-register)))
 
 
-(define-instruction (%try) ((wam wam) (next-clause code-index))
+(define-instruction (%try) (wam next-clause)
   (let ((new-b (wam-stack-top wam))
         (nargs (wam-number-of-arguments wam)))
     (wam-stack-ensure-size wam (+ new-b 8 nargs))
@@ -622,7 +594,7 @@
           :for n :from 0 :below nargs ; arg N in the choice point frame
           :do (wam-copy-to-stack-choice-argument! wam n i new-b))))
 
-(define-instruction (%retry) ((wam wam) (next-clause code-index))
+(define-instruction (%retry) (wam next-clause)
   (let ((b (wam-backtrack-pointer wam)))
     (restore-registers-from-choice-point! wam b)
     (unwind-trail! wam (wam-stack-choice-tr wam b) (wam-trail-pointer wam))
@@ -634,7 +606,7 @@
           (wam-heap-pointer wam) (wam-stack-choice-h wam b)
           (wam-heap-backtrack-pointer wam) (wam-heap-pointer wam))))
 
-(define-instruction (%trust) ((wam wam))
+(define-instruction (%trust) (wam)
   (let* ((b (wam-backtrack-pointer wam))
          (old-b (wam-stack-choice-cb wam b)))
     (restore-registers-from-choice-point! wam b)
@@ -645,7 +617,7 @@
           (wam-heap-pointer wam) (wam-stack-choice-h wam b))
     (reset-choice-point! wam old-b)))
 
-(define-instruction (%cut) ((wam wam))
+(define-instruction (%cut) (wam)
   (let ((current-choice-point (wam-backtrack-pointer wam))
         (previous-choice-point (wam-stack-frame-cut wam)))
     (when (< previous-choice-point current-choice-point)
@@ -657,9 +629,7 @@
 (declaim (inline %%match-lisp-object))
 
 
-(defun* %%match-lisp-object ((wam wam)
-                             (object t)
-                             (address store-index))
+(defun %%match-lisp-object (wam object address)
   (cell-typecase (wam (deref wam address) address)
     ;; If the thing points at a reference (unbound, because we deref'ed) we just
     ;; bind it.
@@ -676,16 +646,10 @@
     (t (backtrack! wam))))
 
 
-(define-instruction (%get-lisp-object)
-    ((wam wam)
-     (object t)
-     (register register-index))
+(define-instruction (%get-lisp-object) (wam object register)
   (%%match-lisp-object wam object register))
 
-(define-instruction (%put-lisp-object)
-    ((wam wam)
-     (object t)
-     (register register-index))
+(define-instruction (%put-lisp-object) (wam object register)
   (wam-set-local-register! wam register +cell-type-lisp-object+ object))
 
 
@@ -693,10 +657,7 @@
 (declaim (inline %%match-constant))
 
 
-(defun* %%match-constant
-    ((wam wam)
-     (constant fname)
-     (address store-index))
+(defun %%match-constant (wam constant address)
   (cell-typecase (wam (deref wam address) address)
     (:reference
      (wam-set-store-cell! wam address +cell-type-constant+ constant)
@@ -709,21 +670,13 @@
     (t (backtrack! wam))))
 
 
-(define-instruction (%put-constant)
-    ((wam wam)
-     (constant fname)
-     (register register-index))
+(define-instruction (%put-constant) (wam constant register)
   (wam-set-local-register! wam register +cell-type-constant+ constant))
 
-(define-instruction (%get-constant)
-    ((wam wam)
-     (constant fname)
-     (register register-index))
+(define-instruction (%get-constant) (wam constant register)
   (%%match-constant wam constant register))
 
-(define-instruction (%subterm-constant)
-    ((wam wam)
-     (constant fname))
+(define-instruction (%subterm-constant) (wam constant)
   (ecase (wam-mode wam)
     (:read (%%match-constant wam constant (wam-subterm wam)))
     (:write (push-new-constant! wam constant)))
@@ -731,7 +684,7 @@
 
 
 ;;;; Running
-(defun* extract-things ((wam wam) (addresses list))
+(defun extract-things (wam addresses)
   "Extract the things at the given store addresses.
 
   The things will be returned in the same order as the addresses were given.
@@ -767,7 +720,7 @@
              (t (error "What to heck is this?")))))
       (mapcar #'recur addresses))))
 
-(defun* extract-query-results ((wam wam) (vars list))
+(defun extract-query-results (wam vars)
   (let* ((addresses (loop :for var :in vars
                           ;; TODO: make this suck less
                           :for i :from (+ (wam-environment-pointer wam) 4)
@@ -853,7 +806,7 @@
       ,@(mapcar #'parse-opcode-clause clauses))))
 
 
-(defun* run ((wam wam) (done-thunk function) &optional (step *step*))
+(defun run (wam done-thunk &optional (step *step*))
   (loop
     :with code = (wam-code wam)
     :until (or (wam-fail wam) ; failure
@@ -920,11 +873,9 @@
             (error "Fell off the end of the program code store."))))
   (values))
 
-(defun* run-query ((wam wam)
-                   term
-                   &key
-                   ((result-function function)
-                    (lambda (results) (declare (ignore results)))))
+(defun run-query (wam term &key (result-function
+                                  (lambda (results)
+                                    (declare (ignore results)))))
   "Compile query `term` and run the instructions on the `wam`.
 
   Resets the heap, etc before running.
diff -r 5593ae4bcb5c -r 6c90a65137d9 src/wam/wam.lisp
--- a/src/wam/wam.lisp	Sat Jul 16 17:37:17 2016 +0000
+++ b/src/wam/wam.lisp	Sat Jul 16 18:23:34 2016 +0000
@@ -104,9 +104,9 @@
     (format stream "an wam")))
 
 
-(defun* make-wam (&key
-                  (store-size (megabytes 10))
-                  (code-size (megabytes 1)))
+(defun make-wam (&key
+                 (store-size (megabytes 10))
+                 (code-size (megabytes 1)))
   (make-wam% :code (allocate-wam-code code-size)
              :type-store (allocate-wam-type-store store-size)
              :value-store (allocate-wam-value-store store-size)
@@ -155,32 +155,27 @@
                  wam-copy-store-cell!))
 
 
-(defun* wam-store-type ((wam wam) (address store-index))
+(defun wam-store-type (wam address)
   "Return the type of the cell at the given address."
   (aref (wam-type-store wam) address))
 
-(defun* wam-store-value ((wam wam) (address store-index))
+(defun wam-store-value (wam address)
   "Return the value of the cell at the given address."
   (aref (wam-value-store wam) address))
 
 
-(defun* wam-set-store-cell! ((wam wam)
-                             (address store-index)
-                             (type cell-type)
-                             (value cell-value))
+(defun wam-set-store-cell! (wam address type value)
   (setf (aref (wam-type-store wam) address) type
         (aref (wam-value-store wam) address) value))
 
-(defun* wam-copy-store-cell! ((wam wam)
-                              (destination store-index)
-                              (source store-index))
+(defun wam-copy-store-cell! (wam destination source)
   (wam-set-store-cell! wam
                        destination
                        (wam-store-type wam source)
                        (wam-store-value wam source)))
 
 
-(defun* wam-sanity-check-store-read ((wam wam) (address store-index))
+(defun wam-sanity-check-store-read (wam address)
   (declare (ignore wam))
   (when (= address +heap-start+)
     (error "Cannot read from heap address zero.")))
@@ -189,7 +184,7 @@
 (macrolet ((define-unsafe (name return-type)
              `(progn
                (declaim (inline ,name))
-               (defun* ,name ((wam wam) (address store-index))
+               (defun ,name (wam address)
                  (the ,return-type (aref (wam-value-store wam) address))))))
   (define-unsafe %unsafe-null-value        (eql 0))
   (define-unsafe %unsafe-structure-value   store-index)
@@ -303,11 +298,11 @@
 (declaim (inline wam-heap-pointer-unset-p wam-heap-push!))
 
 
-(defun* wam-heap-pointer-unset-p ((wam wam) (address heap-index))
+(defun wam-heap-pointer-unset-p (wam address)
   (declare (ignore wam))
   (= address +heap-start+))
 
-(defun* wam-heap-push! ((wam wam) (type cell-type) (value cell-value))
+(defun wam-heap-push! (wam type value)
   "Push the cell onto the WAM heap and increment the heap pointer.
 
   Returns the address it was pushed to.
@@ -329,16 +324,15 @@
                  (setf wam-trail-value)))
 
 
-(defun* wam-trail-pointer ((wam wam))
+(defun wam-trail-pointer (wam)
   "Return the current trail pointer of the WAM."
   (fill-pointer (wam-trail wam)))
 
-(defun* (setf wam-trail-pointer) ((new-value trail-index)
-                                  (wam wam))
+(defun (setf wam-trail-pointer) (new-value wam)
   (setf (fill-pointer (wam-trail wam)) new-value))
 
 
-(defun* wam-trail-push! ((wam wam) (address store-index))
+(defun wam-trail-push! (wam address)
   "Push `address` onto the trail.
 
   Returns the address and the trail address it was pushed to.
@@ -349,19 +343,17 @@
       (error "WAM trail exhausted.")
       (values address (vector-push-extend address trail)))))
 
-(defun* wam-trail-pop! ((wam wam))
+(defun wam-trail-pop! (wam)
   "Pop the top address off the trail and return it."
   (vector-pop (wam-trail wam)))
 
-(defun* wam-trail-value ((wam wam) (address trail-index))
+(defun wam-trail-value (wam address)
   ;; TODO: can we really not just pop, or is something else gonna do something
   ;; fucky with the trail?
   "Return the element (a heap index) in the WAM trail at `address`."
   (aref (wam-trail wam) address))
 
-(defun* (setf wam-trail-value) ((new-value store-index)
-                                (wam wam)
-                                (address trail-index))
+(defun (setf wam-trail-value) (new-value wam address)
   (setf (aref (wam-trail wam) address) new-value))
 
 
@@ -379,7 +371,7 @@
                  wam-environment-pointer-unset-p))
 
 
-(defun* assert-inside-stack ((wam wam) (address store-index))
+(defun assert-inside-stack (wam address)
   (declare (ignorable wam address))
   (policy-cond:policy-cond
     ((>= debug 2)
@@ -395,36 +387,28 @@
     (t nil)) ; wew lads
   (values))
 
-(defun* wam-stack-ensure-size ((wam wam) (address stack-index))
+(defun wam-stack-ensure-size (wam address)
   "Ensure the WAM stack is large enough to be able to write to `address`."
   (assert-inside-stack wam address)
   (values))
 
 
-(defun* wam-stack-word ((wam wam) (address stack-index))
+(defun wam-stack-word (wam address)
   "Return the stack word at the given address."
   (assert-inside-stack wam address)
   (%unsafe-stack-value wam address))
 
-(defun* (setf wam-stack-word) ((new-value stack-word)
-                               (wam wam)
-                               (address stack-index))
+(defun (setf wam-stack-word) (new-value wam address)
   (assert-inside-stack wam address)
   (wam-set-store-cell! wam address +cell-type-stack+ new-value))
 
 
-(defun* wam-backtrack-pointer-unset-p
-  ((wam wam)
-   &optional
-   ((backtrack-pointer backtrack-pointer)
-    (wam-backtrack-pointer wam)))
+(defun wam-backtrack-pointer-unset-p
+    (wam &optional (backtrack-pointer (wam-backtrack-pointer wam)))
   (= backtrack-pointer +stack-start+))
 
-(defun* wam-environment-pointer-unset-p
-  ((wam wam)
-   &optional
-   ((environment-pointer environment-pointer)
-    (wam-environment-pointer wam)))
+(defun wam-environment-pointer-unset-p
+    (wam &optional (environment-pointer (wam-environment-pointer wam)))
   (= environment-pointer +stack-start+))
 
 
@@ -449,68 +433,35 @@
                  wam-set-stack-frame-argument!))
 
 
-(defun* wam-stack-frame-ce
-    ((wam wam)
-     &optional
-     ((e environment-pointer)
-      (wam-environment-pointer wam)))
+(defun wam-stack-frame-ce (wam &optional (e (wam-environment-pointer wam)))
   (wam-stack-word wam e))
 
-(defun* wam-stack-frame-cp
-    ((wam wam)
-     &optional
-     ((e environment-pointer)
-      (wam-environment-pointer wam)))
+(defun wam-stack-frame-cp (wam &optional (e (wam-environment-pointer wam)))
   (wam-stack-word wam (1+ e)))
 
-(defun* wam-stack-frame-cut
-    ((wam wam)
-     &optional
-     ((e environment-pointer)
-      (wam-environment-pointer wam)))
+(defun wam-stack-frame-cut (wam &optional (e (wam-environment-pointer wam)))
   (wam-stack-word wam (+ 2 e)))
 
-(defun* wam-stack-frame-n
-    ((wam wam)
-     &optional
-     ((e environment-pointer)
-      (wam-environment-pointer wam)))
+(defun wam-stack-frame-n (wam &optional (e (wam-environment-pointer wam)))
   (wam-stack-word wam (+ 3 e)))
 
 
-(defun* wam-stack-frame-argument-address
-    ((wam wam)
-     (n register-index)
-     &optional
-     ((e environment-pointer)
-      (wam-environment-pointer wam)))
+(defun wam-stack-frame-argument-address
+    (wam n &optional (e (wam-environment-pointer wam)))
   (+ 4 n e))
 
-(defun* wam-set-stack-frame-argument!
-    ((wam wam)
-     (n register-index)
-     (type cell-type)
-     (value cell-value)
-     &optional ((e environment-pointer)
-                (wam-environment-pointer wam)))
+(defun wam-set-stack-frame-argument!  (wam n type value
+                                       &optional (e (wam-environment-pointer wam)))
   (wam-set-store-cell! wam (wam-stack-frame-argument-address wam n e)
                        type value))
 
-(defun* wam-copy-to-stack-frame-argument!
-    ((wam wam)
-     (n register-index)
-     (source store-index)
-     &optional ((e environment-pointer)
-                (wam-environment-pointer wam)))
+(defun wam-copy-to-stack-frame-argument!  (wam n source
+                                            &optional (e (wam-environment-pointer wam)))
   (wam-copy-store-cell! wam (wam-stack-frame-argument-address wam n e)
                         source))
 
 
-(defun* wam-stack-frame-size
-    ((wam wam)
-     &optional
-     ((e environment-pointer)
-      (wam-environment-pointer wam)))
+(defun wam-stack-frame-size (wam &optional (e (wam-environment-pointer wam)))
   "Return the size of the stack frame starting at environment pointer `e`."
   (+ (wam-stack-frame-n wam e) 4))
 
@@ -548,99 +499,52 @@
                  wam-copy-to-stack-choice-argument!))
 
 
-(defun* wam-stack-choice-n
-    ((wam wam)
-     &optional
-     ((b backtrack-pointer)
-      (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-n (wam &optional (b (wam-backtrack-pointer wam)))
   (wam-stack-word wam b))
 
-(defun* wam-stack-choice-ce
-    ((wam wam)
-     &optional
-     ((b backtrack-pointer)
-      (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-ce (wam &optional (b (wam-backtrack-pointer wam)))
   (wam-stack-word wam (+ b 1)))
 
-(defun* wam-stack-choice-cp
-    ((wam wam)
-     &optional
-     ((b backtrack-pointer)
-      (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-cp (wam &optional (b (wam-backtrack-pointer wam)))
   (wam-stack-word wam (+ b 2)))
 
-(defun* wam-stack-choice-cb
-    ((wam wam)
-     &optional
-     ((b backtrack-pointer)
-      (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-cb (wam &optional (b (wam-backtrack-pointer wam)))
   (wam-stack-word wam (+ b 3)))
 
-(defun* wam-stack-choice-bp
-    ((wam wam)
-     &optional
-     ((b backtrack-pointer)
-      (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-bp (wam &optional (b (wam-backtrack-pointer wam)))
   (wam-stack-word wam (+ b 4)))
 
-(defun* wam-stack-choice-tr
-    ((wam wam)
-     &optional
-     ((b backtrack-pointer)
-      (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-tr (wam &optional (b (wam-backtrack-pointer wam)))
   (wam-stack-word wam (+ b 5)))
 
-(defun* wam-stack-choice-h
-    ((wam wam)
-     &optional
-     ((b backtrack-pointer)
-      (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-h (wam &optional (b (wam-backtrack-pointer wam)))
   (wam-stack-word wam (+ b 6)))
 
-(defun* wam-stack-choice-cc
-    ((wam wam)
-     &optional
-     ((b backtrack-pointer)
-      (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-cc (wam &optional (b (wam-backtrack-pointer wam)))
   (wam-stack-word wam (+ b 7)))
 
 
-(defun* wam-stack-choice-argument-address
-    ((wam wam)
-     (n register-index)
-     &optional ((b backtrack-pointer)
-                (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-argument-address
+    (wam n &optional (b (wam-backtrack-pointer wam)))
   (+ 8 n b))
 
-(defun* wam-set-stack-choice-argument!
-    ((wam wam)
-     (n register-index)
-     (type cell-type)
-     (value cell-value)
-     &optional ((b backtrack-pointer)
-                (wam-backtrack-pointer wam)))
+(defun wam-set-stack-choice-argument! (wam n type value
+                                        &optional (b (wam-backtrack-pointer wam)))
   (wam-set-store-cell! wam (wam-stack-choice-argument-address wam n b)
                        type value))
 
-(defun* wam-copy-to-stack-choice-argument!
-    ((wam wam)
-     (n register-index)
-     (source store-index)
-     &optional ((b backtrack-pointer)
-                (wam-backtrack-pointer wam)))
+(defun wam-copy-to-stack-choice-argument!  (wam n source
+                                             &optional (b (wam-backtrack-pointer wam)))
   (wam-copy-store-cell! wam (wam-stack-choice-argument-address wam n b)
                         source))
 
 
-(defun* wam-stack-choice-size
-    ((wam wam)
-     &optional ((b backtrack-pointer)
-                (wam-backtrack-pointer wam)))
+(defun wam-stack-choice-size (wam &optional (b (wam-backtrack-pointer wam)))
   "Return the size of the choice frame starting at backtrack pointer `b`."
   (+ (wam-stack-choice-n wam b) 8))
 
 
-(defun* wam-stack-top ((wam wam))
+(defun wam-stack-top (wam)
   "Return the top of the stack.
 
   This is the first place it's safe to overwrite in the stack.
@@ -662,21 +566,21 @@
 
 
 ;;;; Resetting
-(defun* wam-truncate-heap! ((wam wam))
+(defun wam-truncate-heap! (wam)
   ;; todo: null out the heap once we're storing live objects
   (setf (wam-heap-pointer wam) (1+ +heap-start+)))
 
-(defun* wam-truncate-trail! ((wam wam))
+(defun wam-truncate-trail! (wam)
   (setf (fill-pointer (wam-trail wam)) 0))
 
-(defun* wam-truncate-unification-stack! ((wam wam))
+(defun wam-truncate-unification-stack! (wam)
   (setf (fill-pointer (wam-unification-stack wam)) 0))
 
-(defun* wam-reset-local-registers! ((wam wam))
+(defun wam-reset-local-registers! (wam)
   (fill (wam-type-store wam) +cell-type-null+ :start 0 :end +register-count+)
   (fill (wam-value-store wam) 0 :start 0 :end +register-count+))
 
-(defun* wam-reset! ((wam wam))
+(defun wam-reset! (wam)
   (wam-truncate-heap! wam)
   (wam-truncate-trail! wam)
   (wam-truncate-unification-stack! wam)
@@ -708,7 +612,7 @@
 ;;;
 ;;; Each arity's table will be created on-the-fly when it's first needed.
 
-(defun* retrieve-instruction (code-store (address code-index))
+(defun retrieve-instruction (code-store address)
   "Return the full instruction at the given address in the code store."
   (make-array (instruction-size (aref code-store address))
     :displaced-to code-store
@@ -717,30 +621,24 @@
     :element-type 'code-word))
 
 
-(defun* wam-code-label ((wam wam) (functor fname) (arity arity))
+(defun wam-code-label (wam functor arity)
   (let ((atable (aref (wam-code-labels wam) arity)))
     (when atable
       (values (gethash functor atable)))))
 
-(defun* (setf wam-code-label) ((new-value code-index)
-                               (wam wam)
-                               (functor fname)
-                               (arity arity))
+(defun (setf wam-code-label) (new-value wam functor arity)
   (setf (gethash functor (aref-or-init (wam-code-labels wam) arity
                                        (make-hash-table :test 'eq)))
         new-value))
 
-(defun* wam-code-label-remove! ((wam wam)
-                                (functor fname)
-                                (arity arity))
+(defun wam-code-label-remove! (wam functor arity)
   (let ((atable (aref (wam-code-labels wam) arity)))
     (when atable
       ;; todo: remove the table entirely when empty?
       (remhash functor atable))))
 
 
-(defun* wam-load-query-code! ((wam wam)
-                              (query-code query-code-holder))
+(defun wam-load-query-code! (wam query-code)
   (setf (subseq (wam-code wam) 0) query-code)
   (values))
 
@@ -765,34 +663,34 @@
   (predicates (make-hash-table :test 'equal) :type hash-table))
 
 
-(defun* wam-logic-pool-release ((wam wam) (frame logic-frame))
+(defun wam-logic-pool-release (wam frame)
   (with-slots (start final predicates) frame
     (clrhash predicates)
     (setf start 0 final nil))
   (push frame (wam-logic-pool wam))
   (values))
 
-(defun* wam-logic-pool-request ((wam wam))
+(defun wam-logic-pool-request (wam)
   (or (pop (wam-logic-pool wam))
       (make-logic-frame)))
 
 
-(defun* wam-current-logic-frame ((wam wam))
+(defun wam-current-logic-frame (wam)
   (first (wam-logic-stack wam)))
 
-(defun* wam-logic-stack-empty-p ((wam wam))
+(defun wam-logic-stack-empty-p (wam)
   (not (wam-current-logic-frame wam)))
 
 
-(defun* wam-logic-open-p ((wam wam))
+(defun wam-logic-open-p (wam)
   (let ((frame (wam-current-logic-frame wam)))
     (and frame (not (logic-frame-final frame)))))
 
-(defun* wam-logic-closed-p ((wam wam))
+(defun wam-logic-closed-p (wam)
   (not (wam-logic-open-p wam)))
 
 
-(defun* wam-push-logic-frame! ((wam wam))
+(defun wam-push-logic-frame! (wam)
   (assert (wam-logic-closed-p wam) ()
     "Cannot push logic frame unless the logic stack is closed.")
   (let ((frame (wam-logic-pool-request wam)))
@@ -815,7 +713,7 @@
                 (not (logic-frame-final (first logic-stack))))
         (error "Cannot pop logic frame.")))))
 
-(defun* wam-pop-logic-frame! ((wam wam))
+(defun wam-pop-logic-frame! (wam)
   (with-slots (logic-stack) wam
     (assert-logic-frame-poppable wam)
     (let ((frame (pop logic-stack)))
@@ -828,13 +726,13 @@
   (values))
 
 
-(defun* assert-label-not-already-compiled ((wam wam) clause functor arity)
+(defun assert-label-not-already-compiled (wam clause functor arity)
   (assert (not (wam-code-label wam functor arity))
       ()
     "Cannot add clause ~S because its predicate has preexisting compiled code."
     clause))
 
-(defun* wam-logic-frame-add-clause! ((wam wam) clause)
+(defun wam-logic-frame-add-clause! (wam clause)
   (assert (wam-logic-open-p wam) ()
     "Cannot add clause ~S without an open logic stack frame."
     clause)
@@ -848,7 +746,7 @@
   (values))
 
 
-(defun* wam-finalize-logic-frame! ((wam wam))
+(defun wam-finalize-logic-frame! (wam)
   (assert (wam-logic-open-p wam) ()
     "There is no logic frame waiting to be finalized.")
   (with-slots (predicates final)
@@ -936,50 +834,40 @@
                  wam-stack-register-address))
 
 
-(defun* wam-local-register-address ((wam wam) (register register-index))
+(defun wam-local-register-address (wam register)
   (declare (ignore wam))
   register)
 
-(defun* wam-stack-register-address ((wam wam) (register register-index))
+(defun wam-stack-register-address (wam register)
   (wam-stack-frame-argument-address wam register))
 
 
-(defun* wam-local-register-type ((wam wam) (register register-index))
+(defun wam-local-register-type (wam register)
   (wam-store-type wam (wam-local-register-address wam register)))
 
-(defun* wam-stack-register-type ((wam wam) (register register-index))
+(defun wam-stack-register-type (wam register)
   (wam-store-type wam (wam-stack-register-address wam register)))
 
 
-(defun* wam-local-register-value ((wam wam) (register register-index))
+(defun wam-local-register-value (wam register)
   (wam-store-value wam (wam-local-register-address wam register)))
 
-(defun* wam-stack-register-value ((wam wam) (register register-index))
+(defun wam-stack-register-value (wam register)
   (wam-store-value wam (wam-stack-register-address wam register)))
 
 
-(defun* wam-set-local-register! ((wam wam)
-                                 (address register-index)
-                                 (type cell-type)
-                                 (value cell-value))
+(defun wam-set-local-register! (wam address type value)
   (wam-set-store-cell! wam (wam-local-register-address wam address)
                        type value))
 
-(defun* wam-set-stack-register! ((wam wam)
-                                 (address register-index)
-                                 (type cell-type)
-                                 (value cell-value))
+(defun wam-set-stack-register! (wam address type value)
   (wam-set-stack-frame-argument! wam address type value))
 
 
-(defun* wam-copy-to-local-register! ((wam wam)
-                                     (destination register-index)
-                                     (source store-index))
+(defun wam-copy-to-local-register! (wam destination source)
   (wam-copy-store-cell! wam (wam-local-register-address wam destination) source))
 
-(defun* wam-copy-to-stack-register! ((wam wam)
-                                     (destination register-index)
-                                     (source store-index))
+(defun wam-copy-to-stack-register! (wam destination source)
   (wam-copy-store-cell! wam (wam-stack-register-address wam destination) source))
 
 
@@ -989,15 +877,12 @@
                  wam-unification-stack-empty-p))
 
 
-(defun* wam-unification-stack-push!
-    ((wam wam)
-     (address1 store-index)
-     (address2 store-index))
+(defun wam-unification-stack-push! (wam address1 address2)
   (vector-push-extend address1 (wam-unification-stack wam))
   (vector-push-extend address2 (wam-unification-stack wam)))
 
-(defun* wam-unification-stack-pop! ((wam wam))
+(defun wam-unification-stack-pop! (wam)
   (vector-pop (wam-unification-stack wam)))
 
-(defun* wam-unification-stack-empty-p ((wam wam))
+(defun wam-unification-stack-empty-p (wam)
   (zerop (length (wam-unification-stack wam))))