# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1468690637 0
# Node ID 5593ae4bcb5c047eaced6c07afb7059c7693aad5
# Parent  2a2765e8f0f50c061952b67d943a2a88c3e54b93
Remove return declarations

diff -r 2a2765e8f0f5 -r 5593ae4bcb5c examples/ggp-paip-interpreted.lisp
--- a/examples/ggp-paip-interpreted.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/examples/ggp-paip-interpreted.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -8,34 +8,28 @@
 
 
 (defun* queue-contents ((q queue))
-  (:returns list)
   (cdr q))
 
 (defun* make-queue ()
-  (:returns queue)
   (let ((q (cons nil nil)))
     (setf (car q) q)))
 
 (defun* enqueue ((item t) (q queue))
-  (:returns queue)
   (setf (car q)
         (setf (rest (car q))
               (cons item nil)))
   q)
 
 (defun* dequeue ((q queue))
-  (:returns t)
   (prog1
       (pop (cdr q))
     (if (null (cdr q))
       (setf (car q) q))))
 
 (defun* queue-empty-p ((q queue))
-  (:returns boolean)
   (null (queue-contents q)))
 
 (defun* queue-append ((q queue) (l list))
-  (:returns queue)
   (when l
     (setf (car q)
           (last (setf (rest (car q))
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/circle.lisp
--- a/src/circle.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/circle.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -58,7 +58,6 @@
 
 
 (defun* make-empty-circle ()
-  (:returns circle)
   "Create an empty circle.
 
   It will still contain a sentinel.
@@ -71,7 +70,6 @@
 
 (defun* make-circle-with ((list list))
   "Create a circle whose nodes contain the values in `list`."
-  (:returns circle)
   (let ((sentinel (make-empty-circle)))
     (loop :with prev = sentinel
           :for value :in list
@@ -94,26 +92,22 @@
 
 
 (defun* circle-sentinel-p ((circle circle))
-  (:returns boolean)
   "Return whether this circle node is the sentinel."
   (eq (circle-value circle) +circle-sentinel+))
 
 (defun* circle-empty-p ((circle circle))
-  (:returns boolean)
   "Return whether this circle is empty."
   (and (circle-sentinel-p circle)
        (eql circle (circle-next circle))))
 
 
 (defun* circle-rotate ((circle circle) (n integer))
-  (:returns circle)
   (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))
-  (:returns circle)
   (when (not (circle-sentinel-p circle))
     (error "Can only call circle-nth on the sentinel."))
   (circle-rotate circle
@@ -179,13 +173,11 @@
 
 
 (defun* circle-forward ((circle circle))
-  (:returns (or circle null))
   (let ((next (circle-next circle)))
     (when (not (circle-sentinel-p next))
       next)))
 
 (defun* circle-backward ((circle circle))
-  (:returns (or circle null))
   (let ((prev (circle-prev circle)))
     (when (not (circle-sentinel-p prev))
       prev)))
@@ -200,20 +192,17 @@
     (circle-tie l r)))
 
 (defun* circle-backward-remove ((circle circle))
-  (:returns (or circle null))
   (prog1
       (circle-backward circle)
     (circle-remove circle)))
 
 (defun* circle-forward-remove ((circle circle))
-  (:returns (or circle null))
   (prog1
       (circle-forward circle)
     (circle-remove circle)))
 
 
 (defun* circle-replace ((circle circle) value)
-  (:returns circle)
   (when (circle-sentinel-p circle)
     (error "Cannot replace sentinel."))
   ;; L new R
@@ -222,13 +211,11 @@
     (make-circle-between l value r)))
 
 (defun* circle-backward-replace ((circle circle) value)
-  (:returns (or circle null))
   (prog1
       (circle-backward circle)
     (circle-replace circle value)))
 
 (defun* circle-forward-replace ((circle circle) value)
-  (:returns (or circle null))
   (prog1
       (circle-forward circle)
     (circle-replace circle value)))
@@ -248,20 +235,17 @@
         (circle-tie (circle-prev new) r)))))
 
 (defun* circle-backward-splice ((circle circle) values)
-  (:returns (or circle null))
   (prog1
       (circle-backward circle)
     (circle-splice circle values)))
 
 (defun* circle-forward-splice ((circle circle) values)
-  (:returns (or circle null))
   (prog1
       (circle-forward circle)
     (circle-splice circle values)))
 
 
 (defun* circle-to-list ((circle circle) &optional include-sentinel-p)
-  (:returns list)
   (loop
     :with node = circle
     :when (or include-sentinel-p
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/paip-compiled.lisp
--- a/src/paip-compiled.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/paip-compiled.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -59,7 +59,6 @@
     (write var :stream stream)))
 
 (defun* bound-p ((var var))
-  (:returns boolean)
   "Return whether the given variable has been bound."
   (not (eq (var-binding var) unbound)))
 
@@ -76,7 +75,6 @@
   "The trail of variable bindings performed so far.")
 
 (defun* set-binding! ((var var) value)
-  (:returns (eql t))
   "Set `var`'s binding to `value` after saving it in the trail.
 
   Always returns `t` (success).
@@ -88,7 +86,6 @@
   t)
 
 (defun* undo-bindings! ((old-trail integer))
-  (:returns :void)
   "Undo all bindings back to a given point in the trail.
 
   The point is specified by giving the desired fill pointer.
@@ -101,7 +98,6 @@
 
 ;;;; Unification
 (defun* unify! (x y)
-  (:returns boolean)
   "Destructively unify two expressions, returning whether it was successful.
 
   Any variables in `x` and `y` may have their bindings set.
@@ -156,7 +152,6 @@
 
 
 (defun* relation-arity ((relation relation))
-  (:returns non-negative-integer)
   "Return the number of arguments of the given relation.
 
   For example: `(relation-arity '(likes sally cats))` => `2`
@@ -165,7 +160,6 @@
   (length (relation-arguments relation)))
 
 (defun* relation-arguments ((relation relation))
-  (:returns list)
   "Return the arguments of the given relation.
 
   For example:
@@ -193,14 +187,12 @@
                       clauses)))))))
 
 (defun* make-parameters ((arity non-negative-integer))
-  (:returns (trivial-types:proper-list symbol))
   "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))
-  (:returns symbol)
   "Returns (and interns) the symbol with the Prolog-style name symbol/arity."
   (values (interned-symbol symbol '/ arity)))
 
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/paip.lisp
--- a/src/paip.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/paip.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -25,7 +25,6 @@
 
 ;;;; Unification
 (defun* variable-p (term)
-  (:returns boolean)
   "Return whether the given term is a logic variable."
   (and (symbolp term)
        (equal (char (symbol-name term) 0)
@@ -34,18 +33,15 @@
 
 (defun* get-binding ((variable logic-variable)
                      (bindings binding-list))
-  (:returns (or binding null))
   "Return the binding (var . val) for the given variable, or nil."
   (assoc variable bindings))
 
 (defun* has-binding ((variable logic-variable)
                      (bindings binding-list))
-  (:returns boolean)
   (not (null (get-binding variable bindings))))
 
 
 (defun* binding-variable ((binding binding))
-  (:returns logic-variable)
   "Return the variable part of a binding."
   (car binding))
 
@@ -62,7 +58,6 @@
 (defun* extend-bindings ((variable logic-variable)
                          (value t)
                          (bindings binding-list))
-  (:returns binding-list)
   "Add a binding (var . val) to the binding list (nondestructively)."
   (cons (cons variable value)
         (if (and (equal bindings no-bindings))
@@ -73,7 +68,6 @@
 (defun* check-occurs ((variable logic-variable)
                       (target t)
                       (bindings binding-list))
-  (:returns boolean)
   "Check whether the variable occurs somewhere in the target.
 
   Takes the bindings into account.  This is expensive.
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/utils.lisp
--- a/src/utils.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/utils.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -159,15 +159,12 @@
 
 
 (defun* make-queue ()
-  (:returns queue)
   (make-queue%))
 
 (defun* queue-empty-p ((q queue))
-  (:returns boolean)
   (zerop (queue-size q)))
 
 (defun* enqueue ((item t) (q queue))
-  (:returns fixnum)
   (let ((cell (cons item nil)))
     (setf (queue-last q)
           (if (queue-empty-p q)
@@ -176,13 +173,11 @@
   (incf (queue-size q)))
 
 (defun* dequeue ((q queue))
-  (:returns t)
   (when (zerop (decf (queue-size q)))
     (setf (queue-last q) nil))
   (pop (queue-contents q)))
 
 (defun* queue-append ((q queue) (l list))
-  (:returns fixnum) ; todo make a structure sharing version of this
   (loop :for item :in l
         :for size = (enqueue item q)
         :finally (return size)))
@@ -234,9 +229,8 @@
           :test (lambda (x y) (declare (ignore x y)) t)) ; what could go wrong
         (declaim (inline ,name))
         (defun* ,name ((,key ,key-type))
-          (:returns ,value-type)
           ,documentation
-          (aref ,table ,key))))))
+          (the ,value-type (aref ,table ,key)))))))
 
 
 ;;;; ecase/tree
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/bytecode.lisp
--- a/src/wam/bytecode.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/bytecode.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -3,7 +3,6 @@
 
 ;;;; Opcodes
 (defun* opcode-name ((opcode opcode))
-  (:returns string)
   (eswitch (opcode)
     (+opcode-noop+ "NOOP")
 
@@ -49,7 +48,6 @@
     (+opcode-put-lisp-object+ "PUT-LISP-OBJECT")))
 
 (defun* opcode-short-name ((opcode opcode))
-  (:returns string)
   (eswitch (opcode)
     (+opcode-noop+ "NOOP")
 
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/compiler/0-data.lisp
--- a/src/wam/compiler/0-data.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/compiler/0-data.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -13,7 +13,6 @@
 (declaim (inline variablep))
 
 (defun* variablep (term)
-  (:returns boolean)
   (and (symbolp term)
        (char= (char (symbol-name term) 0) #\?)))
 
@@ -46,16 +45,13 @@
 
 
 (defun* make-temporary-register ((number register-number) (arity arity))
-  (:returns register)
   (make-register (if (< number arity) :argument :local)
                  number))
 
 (defun* make-permanent-register ((number register-number))
-  (:returns register)
   (make-register :permanent number))
 
 (defun* make-anonymous-register ()
-  (:returns register)
   (make-register :anonymous 0))
 
 
@@ -76,24 +72,19 @@
 
 
 (defun* register-argument-p ((register register))
-  (:returns boolean)
   (eq (register-type register) :argument))
 
 (defun* register-temporary-p ((register register))
-  (:returns boolean)
   (and (member (register-type register) '(:argument :local)) t))
 
 (defun* register-permanent-p ((register register))
-  (:returns boolean)
   (eq (register-type register) :permanent))
 
 (defun* register-anonymous-p ((register register))
-  (:returns boolean)
   (eq (register-type register) :anonymous))
 
 
 (defun* register= ((r1 register) (r2 register))
-  (:returns boolean)
   (and (eq (register-type r1)
            (register-type r2))
        (= (register-number r1)
@@ -182,7 +173,6 @@
 
 
 (defun* determine-clause-properties (head body)
-  (:returns clause-properties)
   (let* ((clause
            (cons head body))
          (permanent-vars
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/compiler/1-parsing.lisp
--- a/src/wam/compiler/1-parsing.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/compiler/1-parsing.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -49,7 +49,6 @@
 
 
 (defgeneric* node-children (node)
-  (:returns list)
   "Return the children of the given node.
 
   Presumably these will need to be traversed when allocating registers.")
@@ -68,7 +67,6 @@
 
 
 (defun* nil-node-p ((node node))
-  (:returns boolean)
   "Return whether the given node is the magic nil/0 constant."
   (and (typep node 'structure-node)
        (eql (node-functor node) nil)
@@ -148,7 +146,6 @@
 
 
 (defun* parse-list ((contents list))
-  (:returns node)
   (if contents
     (make-list-node :head (parse (car contents))
                     :tail (parse-list (cdr contents)))
@@ -157,7 +154,6 @@
                          :arguments ())))
 
 (defun* parse-list* ((contents list))
-  (:returns node)
   (destructuring-bind (next . remaining) contents
     (if (null remaining)
       (parse next)
@@ -165,7 +161,6 @@
                       :tail (parse-list* remaining)))))
 
 (defun* parse (term &optional top-level-argument)
-  (:returns node)
   (cond
     ((variablep term)
      (if top-level-argument
@@ -190,7 +185,6 @@
     (t (error "Cannot parse term ~S into a Prolog term." term))))
 
 (defun* parse-top-level (term)
-  (:returns top-level-node)
   (typecase term
     (symbol (parse-top-level (list term))) ; c/0 -> (c/0)
     (cons (destructuring-bind (functor . arguments) term
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/compiler/2-register-allocation.lisp
--- a/src/wam/compiler/2-register-allocation.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/compiler/2-register-allocation.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -150,7 +150,6 @@
 
 
 (defun* find-variable ((state allocation-state) (variable symbol))
-  (:returns (or register null))
   "Return the register that already contains this variable, or `nil` otherwise."
   (or (when-let (r (position variable
                              (queue-contents
@@ -162,7 +161,6 @@
       nil))
 
 (defun* store-variable ((state allocation-state) (variable symbol))
-  (:returns register)
   "Assign `variable` to the next available local register.
 
   It is assumed that `variable` is not already assigned to another register
@@ -177,7 +175,6 @@
     (1- (enqueue variable (allocation-state-local-registers state)))))
 
 (defun* ensure-variable ((state allocation-state) (variable symbol))
-  (:returns register)
   (or (find-variable state variable)
       (store-variable state variable)))
 
@@ -189,19 +186,16 @@
 
 
 (defun* variable-anonymous-p ((state allocation-state) (variable symbol))
-  (:returns boolean)
   "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))
-  (:returns register)
   (if (variable-anonymous-p state variable)
     (make-anonymous-register)
     (ensure-variable state variable)))
 
 (defun* allocate-nonvariable-register ((state allocation-state))
-  (:returns register)
   "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
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/compiler/3-flattening.lisp
--- a/src/wam/compiler/3-flattening.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/compiler/3-flattening.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -80,8 +80,7 @@
             (lisp-object-to-string (assignment-object assignment)))))
 
 
-(defgeneric* node-flatten (node)
-  (:returns (or null register-assignment)))
+(defgeneric* node-flatten (node))
 
 (defmethod node-flatten (node)
   nil)
@@ -111,7 +110,6 @@
 
 
 (defun* flatten-breadth-first ((tree top-level-node))
-  (:returns list)
   (let ((results nil))
     (recursively ((node tree))
       (when-let (assignment (node-flatten node))
@@ -120,7 +118,6 @@
     (nreverse results)))
 
 (defun* flatten-depth-first-post-order ((tree top-level-node))
-  (:returns list)
   (let ((results nil))
     (recursively ((node tree))
       (mapcar #'recur (node-children node))
@@ -130,11 +127,9 @@
 
 
 (defun* flatten-query ((tree top-level-node))
-  (:returns list)
   (flatten-depth-first-post-order tree))
 
 (defun* flatten-program ((tree top-level-node))
-  (:returns list)
   (flatten-breadth-first tree))
 
 
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/compiler/4-tokenization.lisp
--- a/src/wam/compiler/4-tokenization.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/compiler/4-tokenization.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -49,7 +49,6 @@
 
 
 (defun* make-register-token ((register register))
-  (:returns register-token)
   (values (make-instance 'register-token :register register)))
 
 
@@ -97,7 +96,6 @@
 
 
 (defgeneric* tokenize-assignment ((assignment register-assignment))
-  (:returns list)
   "Tokenize `assignment` into a flat list of tokens.")
 
 (defmethod tokenize-assignment ((assignment structure-assignment))
@@ -123,13 +121,11 @@
                        :object (assignment-object assignment))))
 
 (defun* tokenize-assignments ((assignments list))
-  (:returns list)
   "Tokenize a flattened set of register assignments into a stream."
   (mapcan #'tokenize-assignment assignments))
 
 
 (defun* tokenize-program-term (term (clause-props clause-properties))
-  (:returns list)
   "Tokenize `term` as a program term, returning its tokens."
   (let ((tree (parse-top-level term)))
     (allocate-registers tree clause-props :nead t)
@@ -138,7 +134,6 @@
 (defun* tokenize-query-term (term
                              (clause-props clause-properties)
                              &key in-nead is-tail)
-  (:returns list)
   "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 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/compiler/5-precompilation.lisp
--- a/src/wam/compiler/5-precompilation.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/compiler/5-precompilation.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -105,7 +105,6 @@
 
 
 (defun* find-opcode-register ((first-seen boolean) (register register))
-  (:returns keyword)
   (let ((register-variant (when register
                             (ecase (register-type register)
                               ((:local :argument) :local)
@@ -122,19 +121,16 @@
         (:void :subterm-void)))))
 
 (defun* find-opcode-list ((mode keyword))
-  (:returns keyword)
   (ecase mode
     (:program :get-list)
     (:query :put-list)))
 
 (defun* find-opcode-lisp-object ((mode keyword))
-  (:returns keyword)
   (ecase mode
     (:program :get-lisp-object)
     (:query :put-lisp-object)))
 
 (defun* find-opcode-structure ((mode keyword))
-  (:returns keyword)
   (ecase mode
     (:program :get-structure)
     (:query :put-structure)))
@@ -142,7 +138,6 @@
 (defun* find-opcode-argument ((first-seen boolean)
                               (mode keyword)
                               (register register))
-  (:returns keyword)
   (let ((register-variant (ecase (register-type register)
                             ((:local :argument) :local)
                             ((:permanent) :stack))))
@@ -164,7 +159,6 @@
 
 
 (defun* precompile-tokens ((head-tokens list) (body-tokens list))
-  (:returns circle)
   "Generate a series of machine instructions from a stream of head and body
   tokens.
 
@@ -277,7 +271,6 @@
 
 
 (defun* precompile-clause (head body)
-  (:returns (values circle clause-properties))
   "Precompile the clause.
 
   `head` should be the head of the clause for program clauses, or `nil` for
@@ -356,7 +349,6 @@
 
 
 (defun* precompile-query ((query list))
-  (:returns (values circle list))
   "Compile `query`, returning the instructions and permanent variables.
 
   `query` should be a list of goal terms.
@@ -369,7 +361,6 @@
 
 
 (defun* find-predicate ((clause cons))
-  (:returns (values t arity))
   "Return the functor and arity of the predicate of `clause`."
   ;; ( (f ?x ?y)   | head     ||| clause
   ;;   (foo ?x)      || body  |||
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/compiler/6-optimization.lisp
--- a/src/wam/compiler/6-optimization.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/compiler/6-optimization.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -61,7 +61,6 @@
     (return (circle-backward-remove node))))
 
 (defun* optimize-constants ((instructions circle))
-  (:returns circle)
   ;; From the book and the erratum, there are four optimizations we can do for
   ;; constants (0-arity structures).
 
@@ -86,7 +85,6 @@
 
 
 (defun* optimize-void-runs ((instructions circle))
-  (:returns circle)
   ;; We can optimize runs of N (:[unify/set]-void 1) instructions into a single
   ;; one that does all N at once.
   (loop
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/compiler/7-rendering.lisp
--- a/src/wam/compiler/7-rendering.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/compiler/7-rendering.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -33,7 +33,6 @@
   Returns how many words were pushed.
 
   "
-  (:returns instruction-size)
   (check-instruction opcode arguments)
   (setf (aref store address) opcode
         (subseq store (1+ address)) arguments)
@@ -41,7 +40,6 @@
 
 
 (defun* render-opcode ((opcode-designator keyword))
-  (:returns opcode)
   (ecase opcode-designator
     (:get-structure          +opcode-get-structure+)
     (:get-variable-local     +opcode-get-variable-local+)
@@ -79,7 +77,6 @@
     (:cut                    +opcode-cut+)))
 
 (defun* render-argument (argument)
-  (:returns code-word)
   (cond
     ;; Ugly choice point args that'll be filled later...
     ((eq +choice-point-placeholder+ argument) 0)
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/vm.lisp
--- a/src/wam/vm.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/vm.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -10,12 +10,10 @@
 
 
 (defun* push-unbound-reference! ((wam wam))
-  (:returns heap-index)
   "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))
-  (:returns heap-index)
   "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
@@ -25,7 +23,6 @@
   (wam-heap-push! wam +cell-type-structure+ (1+ (wam-heap-pointer wam))))
 
 (defun* push-new-list! ((wam wam))
-  (:returns heap-index)
   "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
@@ -35,32 +32,27 @@
   (wam-heap-push! wam +cell-type-list+ (1+ (wam-heap-pointer wam))))
 
 (defun* push-new-functor! ((wam wam) (functor fname) (arity arity))
-  (:returns heap-index)
   "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))
-  (:returns heap-index)
   "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))
-  (:returns boolean)
   "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))
-  (:returns boolean)
   "Return whether the two constant cell values unify."
   (eq c1 c2))
 
 (defun* lisp-objects-match-p ((o1 t) (o2 t))
-  (:returns boolean)
   "Return whether the two lisp object cells unify."
   (eql o1 o2))
 
@@ -123,7 +115,6 @@
           (decf tr))))))
 
 (defun* deref ((wam wam) (address store-index))
-  (:returns store-index)
   "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
@@ -741,7 +732,6 @@
 
 ;;;; Running
 (defun* extract-things ((wam wam) (addresses list))
-  (:returns list)
   "Extract the things at the given store addresses.
 
   The things will be returned in the same order as the addresses were given.
@@ -778,7 +768,6 @@
       (mapcar #'recur addresses))))
 
 (defun* extract-query-results ((wam wam) (vars list))
-  (:returns list)
   (let* ((addresses (loop :for var :in vars
                           ;; TODO: make this suck less
                           :for i :from (+ (wam-environment-pointer wam) 4)
diff -r 2a2765e8f0f5 -r 5593ae4bcb5c src/wam/wam.lisp
--- a/src/wam/wam.lisp	Sat Jul 16 13:47:55 2016 +0000
+++ b/src/wam/wam.lisp	Sat Jul 16 17:37:17 2016 +0000
@@ -107,7 +107,6 @@
 (defun* make-wam (&key
                   (store-size (megabytes 10))
                   (code-size (megabytes 1)))
-  (:returns wam)
   (make-wam% :code (allocate-wam-code code-size)
              :type-store (allocate-wam-type-store store-size)
              :value-store (allocate-wam-value-store store-size)
@@ -157,12 +156,10 @@
 
 
 (defun* wam-store-type ((wam wam) (address store-index))
-  (:returns cell-type)
   "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))
-  (:returns cell-value)
   "Return the value of the cell at the given address."
   (aref (wam-value-store wam) address))
 
@@ -193,8 +190,7 @@
              `(progn
                (declaim (inline ,name))
                (defun* ,name ((wam wam) (address store-index))
-                 (:returns ,return-type)
-                 (aref (wam-value-store 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)
   (define-unsafe %unsafe-reference-value   store-index)
@@ -308,12 +304,10 @@
 
 
 (defun* wam-heap-pointer-unset-p ((wam wam) (address heap-index))
-  (:returns boolean)
   (declare (ignore wam))
   (= address +heap-start+))
 
 (defun* wam-heap-push! ((wam wam) (type cell-type) (value cell-value))
-  (:returns heap-index)
   "Push the cell onto the WAM heap and increment the heap pointer.
 
   Returns the address it was pushed to.
@@ -336,7 +330,6 @@
 
 
 (defun* wam-trail-pointer ((wam wam))
-  (:returns trail-index)
   "Return the current trail pointer of the WAM."
   (fill-pointer (wam-trail wam)))
 
@@ -346,7 +339,6 @@
 
 
 (defun* wam-trail-push! ((wam wam) (address store-index))
-  (:returns (values store-index trail-index))
   "Push `address` onto the trail.
 
   Returns the address and the trail address it was pushed to.
@@ -358,14 +350,12 @@
       (values address (vector-push-extend address trail)))))
 
 (defun* wam-trail-pop! ((wam wam))
-  (:returns store-index)
   "Pop the top address off the trail and return it."
   (vector-pop (wam-trail wam)))
 
 (defun* wam-trail-value ((wam wam) (address trail-index))
   ;; TODO: can we really not just pop, or is something else gonna do something
   ;; fucky with the trail?
-  (:returns store-index)
   "Return the element (a heap index) in the WAM trail at `address`."
   (aref (wam-trail wam) address))
 
@@ -390,7 +380,6 @@
 
 
 (defun* assert-inside-stack ((wam wam) (address store-index))
-  (:returns :void)
   (declare (ignorable wam address))
   (policy-cond:policy-cond
     ((>= debug 2)
@@ -407,14 +396,12 @@
   (values))
 
 (defun* wam-stack-ensure-size ((wam wam) (address stack-index))
-  (:returns :void)
   "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))
-  (:returns stack-word)
   "Return the stack word at the given address."
   (assert-inside-stack wam address)
   (%unsafe-stack-value wam address))
@@ -431,7 +418,6 @@
    &optional
    ((backtrack-pointer backtrack-pointer)
     (wam-backtrack-pointer wam)))
-  (:returns boolean)
   (= backtrack-pointer +stack-start+))
 
 (defun* wam-environment-pointer-unset-p
@@ -439,7 +425,6 @@
    &optional
    ((environment-pointer environment-pointer)
     (wam-environment-pointer wam)))
-  (:returns boolean)
   (= environment-pointer +stack-start+))
 
 
@@ -469,7 +454,6 @@
      &optional
      ((e environment-pointer)
       (wam-environment-pointer wam)))
-  (:returns environment-pointer)
   (wam-stack-word wam e))
 
 (defun* wam-stack-frame-cp
@@ -477,7 +461,6 @@
      &optional
      ((e environment-pointer)
       (wam-environment-pointer wam)))
-  (:returns continuation-pointer)
   (wam-stack-word wam (1+ e)))
 
 (defun* wam-stack-frame-cut
@@ -485,7 +468,6 @@
      &optional
      ((e environment-pointer)
       (wam-environment-pointer wam)))
-  (:returns backtrack-pointer)
   (wam-stack-word wam (+ 2 e)))
 
 (defun* wam-stack-frame-n
@@ -493,7 +475,6 @@
      &optional
      ((e environment-pointer)
       (wam-environment-pointer wam)))
-  (:returns stack-frame-argcount)
   (wam-stack-word wam (+ 3 e)))
 
 
@@ -503,7 +484,6 @@
      &optional
      ((e environment-pointer)
       (wam-environment-pointer wam)))
-  (:returns stack-index)
   (+ 4 n e))
 
 (defun* wam-set-stack-frame-argument!
@@ -531,7 +511,6 @@
      &optional
      ((e environment-pointer)
       (wam-environment-pointer wam)))
-  (:returns stack-frame-size)
   "Return the size of the stack frame starting at environment pointer `e`."
   (+ (wam-stack-frame-n wam e) 4))
 
@@ -574,7 +553,6 @@
      &optional
      ((b backtrack-pointer)
       (wam-backtrack-pointer wam)))
-  (:returns arity)
   (wam-stack-word wam b))
 
 (defun* wam-stack-choice-ce
@@ -582,7 +560,6 @@
      &optional
      ((b backtrack-pointer)
       (wam-backtrack-pointer wam)))
-  (:returns environment-pointer)
   (wam-stack-word wam (+ b 1)))
 
 (defun* wam-stack-choice-cp
@@ -590,7 +567,6 @@
      &optional
      ((b backtrack-pointer)
       (wam-backtrack-pointer wam)))
-  (:returns continuation-pointer)
   (wam-stack-word wam (+ b 2)))
 
 (defun* wam-stack-choice-cb
@@ -598,7 +574,6 @@
      &optional
      ((b backtrack-pointer)
       (wam-backtrack-pointer wam)))
-  (:returns backtrack-pointer)
   (wam-stack-word wam (+ b 3)))
 
 (defun* wam-stack-choice-bp
@@ -606,7 +581,6 @@
      &optional
      ((b backtrack-pointer)
       (wam-backtrack-pointer wam)))
-  (:returns continuation-pointer)
   (wam-stack-word wam (+ b 4)))
 
 (defun* wam-stack-choice-tr
@@ -614,7 +588,6 @@
      &optional
      ((b backtrack-pointer)
       (wam-backtrack-pointer wam)))
-  (:returns trail-index)
   (wam-stack-word wam (+ b 5)))
 
 (defun* wam-stack-choice-h
@@ -622,7 +595,6 @@
      &optional
      ((b backtrack-pointer)
       (wam-backtrack-pointer wam)))
-  (:returns heap-index)
   (wam-stack-word wam (+ b 6)))
 
 (defun* wam-stack-choice-cc
@@ -630,7 +602,6 @@
      &optional
      ((b backtrack-pointer)
       (wam-backtrack-pointer wam)))
-  (:returns backtrack-pointer)
   (wam-stack-word wam (+ b 7)))
 
 
@@ -639,7 +610,6 @@
      (n register-index)
      &optional ((b backtrack-pointer)
                 (wam-backtrack-pointer wam)))
-  (:returns stack-index)
   (+ 8 n b))
 
 (defun* wam-set-stack-choice-argument!
@@ -666,13 +636,11 @@
     ((wam wam)
      &optional ((b backtrack-pointer)
                 (wam-backtrack-pointer wam)))
-  (:returns stack-choice-size)
   "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))
-  (:returns stack-index)
   "Return the top of the stack.
 
   This is the first place it's safe to overwrite in the stack.
@@ -750,7 +718,6 @@
 
 
 (defun* wam-code-label ((wam wam) (functor fname) (arity arity))
-  (:returns (or null code-index))
   (let ((atable (aref (wam-code-labels wam) arity)))
     (when atable
       (values (gethash functor atable)))))
@@ -774,7 +741,6 @@
 
 (defun* wam-load-query-code! ((wam wam)
                               (query-code query-code-holder))
-  (:returns :void)
   (setf (subseq (wam-code wam) 0) query-code)
   (values))
 
@@ -800,7 +766,6 @@
 
 
 (defun* wam-logic-pool-release ((wam wam) (frame logic-frame))
-  (:returns :void)
   (with-slots (start final predicates) frame
     (clrhash predicates)
     (setf start 0 final nil))
@@ -808,32 +773,26 @@
   (values))
 
 (defun* wam-logic-pool-request ((wam wam))
-  (:returns logic-frame)
   (or (pop (wam-logic-pool wam))
       (make-logic-frame)))
 
 
 (defun* wam-current-logic-frame ((wam wam))
-  (:returns (or null logic-frame))
   (first (wam-logic-stack wam)))
 
 (defun* wam-logic-stack-empty-p ((wam wam))
-  (:returns boolean)
   (not (wam-current-logic-frame wam)))
 
 
 (defun* wam-logic-open-p ((wam wam))
-  (:returns boolean)
   (let ((frame (wam-current-logic-frame wam)))
     (and frame (not (logic-frame-final frame)))))
 
 (defun* wam-logic-closed-p ((wam wam))
-  (:returns boolean)
   (not (wam-logic-open-p wam)))
 
 
 (defun* wam-push-logic-frame! ((wam wam))
-  (:returns :void)
   (assert (wam-logic-closed-p wam) ()
     "Cannot push logic frame unless the logic stack is closed.")
   (let ((frame (wam-logic-pool-request wam)))
@@ -857,7 +816,6 @@
         (error "Cannot pop logic frame.")))))
 
 (defun* wam-pop-logic-frame! ((wam wam))
-  (:returns :void)
   (with-slots (logic-stack) wam
     (assert-logic-frame-poppable wam)
     (let ((frame (pop logic-stack)))
@@ -979,30 +937,24 @@
 
 
 (defun* wam-local-register-address ((wam wam) (register register-index))
-  (:returns store-index)
   (declare (ignore wam))
   register)
 
 (defun* wam-stack-register-address ((wam wam) (register register-index))
-  (:returns store-index)
   (wam-stack-frame-argument-address wam register))
 
 
 (defun* wam-local-register-type ((wam wam) (register register-index))
-  (:returns cell-type)
   (wam-store-type wam (wam-local-register-address wam register)))
 
 (defun* wam-stack-register-type ((wam wam) (register register-index))
-  (:returns cell-type)
   (wam-store-type wam (wam-stack-register-address wam register)))
 
 
 (defun* wam-local-register-value ((wam wam) (register register-index))
-  (:returns cell-value)
   (wam-store-value wam (wam-local-register-address wam register)))
 
 (defun* wam-stack-register-value ((wam wam) (register register-index))
-  (:returns cell-value)
   (wam-store-value wam (wam-stack-register-address wam register)))
 
 
@@ -1045,9 +997,7 @@
   (vector-push-extend address2 (wam-unification-stack wam)))
 
 (defun* wam-unification-stack-pop! ((wam wam))
-  (:returns store-index)
   (vector-pop (wam-unification-stack wam)))
 
 (defun* wam-unification-stack-empty-p ((wam wam))
-  (:returns boolean)
   (zerop (length (wam-unification-stack wam))))