# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1468609941 0
# Node ID 5edeeac89e031d2e5905645b36dc4c8ed56d89ac
# Parent  1411666a60f8998375966b6380a7c736592688bf
Add numbers

Really though this is adding support for arbitrary Lisp objects (finally!).

diff -r 1411666a60f8 -r 5edeeac89e03 examples/ggp-wam.lisp
--- a/examples/ggp-wam.lisp	Fri Jul 15 15:03:01 2016 +0000
+++ b/examples/ggp-wam.lisp	Fri Jul 15 19:12:21 2016 +0000
@@ -11,7 +11,7 @@
        (init (off q))
        (init (off r))
        (init (off s))
-       (init (step num1)))
+       (init (step 1)))
 
 
 (rule (next (on p))
@@ -122,13 +122,13 @@
   (succ ?x ?y))
 
 
-(facts (succ num1 num2)
-       (succ num2 num3)
-       (succ num3 num4)
-       (succ num4 num5)
-       (succ num5 num6)
-       (succ num6 num7)
-       (succ num7 num8))
+(facts (succ 1 2)
+       (succ 2 3)
+       (succ 3 4)
+       (succ 4 5)
+       (succ 5 6)
+       (succ 6 7)
+       (succ 7 8))
 
 (facts (legal robot a)
        (legal robot b)
@@ -136,23 +136,23 @@
        (legal robot d))
 
 
-(rule (goal robot num100)
+(rule (goal robot 100)
   (true (on p))
   (true (on q))
   (true (on r))
   (true (on s)))
-(rule (goal robot num0)
+(rule (goal robot 0)
   (true (off p)))
-(rule (goal robot num0)
+(rule (goal robot 0)
   (true (off q)))
-(rule (goal robot num0)
+(rule (goal robot 0)
   (true (off r)))
-(rule (goal robot num0)
+(rule (goal robot 0)
   (true (off s)))
 
 
 (rule (terminal)
-  (true (step num8)))
+  (true (step 8)))
 (rule (terminal)
   (true (on p))
   (true (on q))
@@ -247,7 +247,7 @@
           ; (format t "Searching: ~S (~D remaining)~%" state (length remaining))
           (if (terminalp)
             (prog1
-                (if (and (not exhaust) (eq 'num100 (goal-value *role*)))
+                (if (and (not exhaust) (= 100 (goal-value *role*)))
                   (list state (reverse path))
                   nil)
               (clear-state))
diff -r 1411666a60f8 -r 5edeeac89e03 src/wam/bytecode.lisp
--- a/src/wam/bytecode.lisp	Fri Jul 15 15:03:01 2016 +0000
+++ b/src/wam/bytecode.lisp	Fri Jul 15 19:12:21 2016 +0000
@@ -43,7 +43,10 @@
     (+opcode-subterm-constant+ "SUBTERM-CONSTANT")
 
     (+opcode-get-list+ "GET-LIST")
-    (+opcode-put-list+ "PUT-LIST")))
+    (+opcode-put-list+ "PUT-LIST")
+
+    (+opcode-get-lisp-object+ "GET-LISP-OBJECT")
+    (+opcode-put-lisp-object+ "PUT-LISP-OBJECT")))
 
 (defun* opcode-short-name ((opcode opcode))
   (:returns string)
@@ -86,7 +89,10 @@
     (+opcode-subterm-constant+ "UCON")
 
     (+opcode-get-list+ "GLST")
-    (+opcode-put-list+ "PLST")))
+    (+opcode-put-list+ "PLST")
+
+    (+opcode-get-lisp-object+ "GLOB")
+    (+opcode-put-lisp-object+ "PLOB")))
 
 
 ;;;; Instructions
@@ -134,7 +140,10 @@
   (#.+opcode-subterm-constant+ 2)
 
   (#.+opcode-get-list+ 2)
-  (#.+opcode-put-list+ 2))
+  (#.+opcode-put-list+ 2)
+
+  (#.+opcode-get-lisp-object+ 3)
+  (#.+opcode-put-lisp-object+ 3))
 
 
 ;;;; Cells
@@ -146,6 +155,7 @@
   (#.+cell-type-functor+ "FUNCTOR")
   (#.+cell-type-constant+ "CONSTANT")
   (#.+cell-type-list+ "LIST")
+  (#.+cell-type-lisp-object+ "LISP-OBJECT")
   (#.+cell-type-stack+ "STACK"))
 
 (define-lookup cell-type-short-name (type cell-type string "")
@@ -156,5 +166,6 @@
   (#.+cell-type-functor+ "FUN")
   (#.+cell-type-constant+ "CON")
   (#.+cell-type-list+ "LIS")
+  (#.+cell-type-lisp-object+ "OBJ")
   (#.+cell-type-stack+ "STK"))
 
diff -r 1411666a60f8 -r 5edeeac89e03 src/wam/compiler.lisp
--- a/src/wam/compiler.lisp	Fri Jul 15 15:03:01 2016 +0000
+++ b/src/wam/compiler.lisp	Fri Jul 15 19:12:21 2016 +0000
@@ -10,6 +10,10 @@
   (and (symbolp term)
        (char= (char (symbol-name term) 0) #\?)))
 
+(defun lisp-object-to-string (o)
+  (with-output-to-string (str)
+    (print-unreadable-object (o str :type t :identity t))))
+
 
 ;;;; Registers
 (declaim (inline register-type register-number make-register register=
@@ -133,6 +137,9 @@
   ((head :accessor node-head :type node :initarg :head)
    (tail :accessor node-tail :type node :initarg :tail)))
 
+(defclass lisp-object-node (vanilla-node)
+  ((object :accessor node-object :type t :initarg :object)))
+
 
 ; todo functor -> fname
 (defun* make-top-level-node ((functor symbol) (arity arity) (arguments list))
@@ -161,6 +168,10 @@
   (:returns list-node)
   (values (make-instance 'list-node :head head :tail tail)))
 
+(defun* make-lisp-object-node ((object t))
+  (:returns lisp-object-node)
+  (values (make-instance 'lisp-object-node :object object)))
+
 
 (defgeneric* node-children (node)
   (:returns list)
@@ -242,6 +253,11 @@
                      (dump-node element))))
   (format t ">"))
 
+(defmethod dump-node ((node lisp-object-node))
+  (format t "~VA#<LISP OBJECT " *dump-node-indent* "")
+  (print-node-register node t)
+  (format t "~A>" (lisp-object-to-string (node-object node))))
+
 (defmethod dump-node ((node top-level-node))
   (format t "#<~A/~D" (node-functor node) (node-arity node))
   (let ((*dump-node-indent* 4))
@@ -283,7 +299,7 @@
      (destructuring-bind (functor . arguments) term
        (when (not (symbolp functor))
          (error
-           "Cannot parse top-level term ~S because ~S is not a valid functor."
+           "Cannot parse term ~S because ~S is not a valid functor."
            term functor))
        (case functor
          (list (parse-list arguments))
@@ -291,7 +307,9 @@
          (t (make-structure-node functor
                                  (length arguments)
                                  (mapcar #'parse arguments))))))
-    (t (error "Cannot parse form ~S into a Prolog term." term))))
+    ((numberp term)
+     (make-lisp-object-node term))
+    (t (error "Cannot parse term ~S into a Prolog term." term))))
 
 (defun* parse-top-level (term)
   (:returns top-level-node)
@@ -636,6 +654,10 @@
   (set-when-unbound node 'register
     (allocate-nonvariable-register state)))
 
+(defmethod allocate-register ((node lisp-object-node) state)
+  (set-when-unbound node 'register
+    (allocate-nonvariable-register state)))
+
 
 (defun* allocate-argument-registers ((node top-level-node))
   (loop :for argument :in (node-arguments node)
@@ -729,6 +751,9 @@
   ((head :accessor assignment-head :type register :initarg :head)
    (tail :accessor assignment-tail :type register :initarg :tail)))
 
+(defclass lisp-object-assignment (register-assignment)
+  ((object :accessor assignment-object :type t :initarg :object)))
+
 
 (defmethod print-object ((assignment structure-assignment) stream)
   (print-unreadable-object (assignment stream :type nil :identity nil)
@@ -751,6 +776,12 @@
             (register-to-string (assignment-head assignment))
             (register-to-string (assignment-tail assignment)))))
 
+(defmethod print-object ((assignment lisp-object-assignment) stream)
+  (print-unreadable-object (assignment stream :type nil :identity nil)
+    (format stream "~A = ~A"
+            (register-to-string (assignment-register assignment))
+            (lisp-object-to-string (assignment-object assignment)))))
+
 
 (defgeneric* node-flatten (node)
   (:returns (or null register-assignment)))
@@ -776,6 +807,11 @@
                          :head (node-register (node-head node))
                          :tail (node-register (node-tail node)))))
 
+(defmethod node-flatten ((node lisp-object-node))
+  (values (make-instance 'lisp-object-assignment
+                         :register (node-register node)
+                         :object (node-object node))))
+
 
 (defun* flatten-breadth-first ((tree top-level-node))
   (:returns list)
@@ -834,6 +870,8 @@
 
 (defclass list-token (register-token) ())
 
+(defclass lisp-object-token (register-token)
+  ((object :accessor token-object :type t :initarg :object)))
 
 (defclass procedure-call-token ()
   ((functor :accessor token-functor :type symbol :initarg :functor)
@@ -871,6 +909,12 @@
   (print-unreadable-object (token stream :identity nil :type nil)
     (format stream "~A = LIST" (register-to-string (token-register token)))))
 
+(defmethod print-object ((token lisp-object-token) stream)
+  (print-unreadable-object (token stream :identity nil :type nil)
+    (format stream "~A = ~A"
+            (register-to-string (token-register token))
+            (lisp-object-to-string (token-object token)))))
+
 (defmethod print-object ((token call-token) stream)
   (print-unreadable-object (token stream :identity nil :type nil)
     (format stream "CALL ~A/~D"
@@ -909,6 +953,10 @@
         (make-register-token (assignment-head assignment))
         (make-register-token (assignment-tail assignment))))
 
+(defmethod tokenize-assignment ((assignment lisp-object-assignment))
+  (list (make-instance 'lisp-object-token
+                       :register (assignment-register assignment)
+                       :object (assignment-object assignment))))
 
 (defun* tokenize-assignments ((assignments list))
   (:returns list)
@@ -1059,6 +1107,12 @@
     (: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
@@ -1133,6 +1187,10 @@
            (push register seen)
            (push-instruction (find-opcode-list mode)
                              register))
+         (handle-lisp-object (register object)
+           ;; OP object register
+           (push register seen)
+           (push-instruction (find-opcode-lisp-object mode) object register))
          (handle-cut ()
            (push-instruction :cut))
          (handle-procedure-call (functor arity is-jump)
@@ -1174,6 +1232,9 @@
                                  (token-arity token)))
              (list-token
                (handle-list (token-register token)))
+             (lisp-object-token
+               (handle-lisp-object (token-register token)
+                                   (token-object token)))
              (cut-token
                (handle-cut))
              (jump-token
@@ -1505,9 +1566,11 @@
     (:subterm-void           +opcode-subterm-void+)
     (:put-constant           +opcode-put-constant+)
     (:get-constant           +opcode-get-constant+)
+    (:subterm-constant       +opcode-subterm-constant+)
     (:get-list               +opcode-get-list+)
     (:put-list               +opcode-put-list+)
-    (:subterm-constant       +opcode-subterm-constant+)
+    (:get-lisp-object        +opcode-get-lisp-object+)
+    (:put-lisp-object        +opcode-put-lisp-object+)
     (:jump                   +opcode-jump+)
     (:call                   +opcode-call+)
     (:dynamic-jump           +opcode-dynamic-jump+)
@@ -1524,11 +1587,9 @@
 (defun* render-argument (argument)
   (:returns code-word)
   (etypecase argument
-    ;; todo: simplify this to a single `if` once the store is fully split
     (null 0) ; ugly choice point args that'll be filled later...
     (register (register-number argument)) ; bytecode just needs register numbers
-    (functor argument) ; functors just get literally included
-    (number argument))) ; just a numeric argument, e.g. alloc 0
+    (t argument))) ; everything else just gets shoved right into the array
 
 (defun* render-bytecode ((store generic-code-store)
                          (instructions circle)
diff -r 1411666a60f8 -r 5edeeac89e03 src/wam/constants.lisp
--- a/src/wam/constants.lisp	Fri Jul 15 15:03:01 2016 +0000
+++ b/src/wam/constants.lisp	Fri Jul 15 19:12:21 2016 +0000
@@ -26,6 +26,7 @@
   +cell-type-functor+
   +cell-type-constant+
   +cell-type-list+
+  +cell-type-lisp-object+
   +cell-type-stack+)
 
 
@@ -136,7 +137,11 @@
 
   ;; Lists
   +opcode-get-list+
-  +opcode-put-list+)
+  +opcode-put-list+
+
+  ;; Lisp Objects
+  +opcode-get-lisp-object+
+  +opcode-put-lisp-object+)
 
 
 ;;;; Debug Config
diff -r 1411666a60f8 -r 5edeeac89e03 src/wam/vm.lisp
--- a/src/wam/vm.lisp	Fri Jul 15 15:03:01 2016 +0000
+++ b/src/wam/vm.lisp	Fri Jul 15 19:12:21 2016 +0000
@@ -45,18 +45,21 @@
   (wam-heap-push! wam +cell-type-constant+ constant))
 
 
-(defun* functors-match-p ((f1 functor)
-                          (f2 functor))
+(defun* functors-match-p ((f1 functor) (f2 functor))
   (:returns boolean)
   "Return whether the two functor cell values represent the same functor."
   (eq f1 f2))
 
-(defun* constants-match-p ((c1 functor)
-                           (c2 functor))
+(defun* constants-match-p ((c1 functor) (c2 functor))
   (:returns boolean)
-  "Return whether the two constant cells represent the same functor."
+  "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))
+
 
 ;;;; "Ancillary" Functions
 (declaim (inline deref unbind! trail!))
@@ -174,63 +177,72 @@
     (t (error "At least one cell must be an unbound reference when binding."))))
 
 (defun* unify! ((wam wam) (a1 store-index) (a2 store-index))
-  (wam-unification-stack-push! wam a1)
-  (wam-unification-stack-push! wam a2)
   (setf (wam-fail wam) nil)
-  ;; TODO: refactor this horror show.
+  (wam-unification-stack-push! wam a1 a2)
+
   (until (or (wam-fail wam)
              (wam-unification-stack-empty-p wam))
     (let* ((d1 (deref wam (wam-unification-stack-pop! wam)))
            (d2 (deref wam (wam-unification-stack-pop! wam)))
            (t1 (wam-store-type wam d1))
            (t2 (wam-store-type wam d2)))
-      (when (not (= d1 d2))
-        (cond
-          ;; If at least one is a reference, bind them.
-          ;;
-          ;; We know that any references we see here will be unbound because
-          ;; we deref'ed them above.
-          ((or (cell-type= t1 :reference)
-               (cell-type= t2 :reference))
-           (bind! wam d1 d2))
+      (macrolet ((both (cell-type-designator)
+                   `(and
+                     (cell-type= t1 ,cell-type-designator)
+                     (cell-type= t2 ,cell-type-designator)))
+                 (either (cell-type-designator)
+                   `(or
+                     (cell-type= t1 ,cell-type-designator)
+                     (cell-type= t2 ,cell-type-designator))))
+        (flet ((match-values (predicate)
+                 (when (not (funcall predicate
+                                     (wam-store-value wam d1)
+                                     (wam-store-value wam d2)))
+                   (backtrack! wam))))
+          (when (not (= d1 d2))
+            (cond
+              ;; If at least one is a reference, bind them.
+              ;;
+              ;; We know that any references we see here will be unbound because
+              ;; we deref'ed them above.
+              ((either :reference)
+               (bind! wam d1 d2))
 
-          ;; Otherwise if they're both constants, make sure they match.
-          ((and (cell-type= t1 :constant)
-                (cell-type= t2 :constant))
-           (let ((c1 (wam-store-value wam d1))
-                 (c2 (wam-store-value wam d2)))
-             (when (not (constants-match-p c1 c2))
-               (backtrack! wam))))
+              ;; Otherwise if they're both constants or lisp objects, make sure
+              ;; they match exactly.
+              ((both :constant) (match-values #'constants-match-p))
+              ((both :lisp-object) (match-values #'lisp-objects-match-p))
 
-          ;; Otherwise if they're both lists, unify their contents.
-          ((and (cell-type= t1 :list)
-                (cell-type= t2 :list))
-           (wam-unification-stack-push! wam (wam-store-value wam d1))
-           (wam-unification-stack-push! wam (wam-store-value wam d2))
-           (wam-unification-stack-push! wam (1+ (wam-store-value wam d1)))
-           (wam-unification-stack-push! wam (1+ (wam-store-value wam d2))))
+              ;; Otherwise if they're both lists, unify their contents.
+              ((both :list)
+               (wam-unification-stack-push! wam
+                                            (wam-store-value wam d1)
+                                            (wam-store-value wam d2))
+               (wam-unification-stack-push! wam
+                                            (1+ (wam-store-value wam d1))
+                                            (1+ (wam-store-value wam d2))))
 
-          ;; Otherwise if they're both structures, make sure they match and
-          ;; then schedule their subterms to be unified.
-          ((and (cell-type= t1 :structure)
-                (cell-type= t2 :structure))
-           (let* ((s1 (wam-store-value wam d1)) ; find where they
-                  (s2 (wam-store-value wam d2)) ; start on the heap
-                  (f1 (wam-store-value wam s1)) ; grab the
-                  (f2 (wam-store-value wam s2))) ; functors
-             (if (functors-match-p f1 f2)
-               ;; If the functors match, push their pairs of arguments onto
-               ;; the stack to be unified.
-               (loop :with arity = (cdr f1)
-                     :for i :from 1 :to arity :do
-                     (wam-unification-stack-push! wam (+ s1 i))
-                     (wam-unification-stack-push! wam (+ s2 i)))
-               ;; Otherwise we're hosed.
-               (backtrack! wam))))
+              ;; Otherwise if they're both structures, make sure they match and
+              ;; then schedule their subterms to be unified.
+              ((both :structure)
+               (let* ((s1 (wam-store-value wam d1)) ; find where they
+                      (s2 (wam-store-value wam d2)) ; start on the heap
+                      (f1 (wam-store-value wam s1)) ; grab the
+                      (f2 (wam-store-value wam s2))) ; functors
+                 (if (functors-match-p f1 f2)
+                   ;; If the functors match, push their pairs of arguments onto
+                   ;; the stack to be unified.
+                   (loop :with arity = (cdr f1)
+                         :repeat arity
+                         :for subterm1 :from (1+ s1)
+                         :for subterm2 :from (1+ s2)
+                         :do (wam-unification-stack-push! wam subterm1 subterm2))
+                   ;; Otherwise we're hosed.
+                   (backtrack! wam))))
 
-          ;; Otherwise we're looking at two different kinds of cells, and are
-          ;; just totally hosed.  Backtrack.
-          (t (backtrack! wam)))))))
+              ;; Otherwise we're looking at two different kinds of cells, and are
+              ;; just totally hosed.  Backtrack.
+              (t (backtrack! wam)))))))))
 
 
 ;;;; Instruction Definition
@@ -338,6 +350,7 @@
                            (wam-heap-pointer wam))
   (setf (wam-mode wam) :write))
 
+
 (define-instructions (%put-variable-local %put-variable-stack)
     ((wam wam)
      (register register-index)
@@ -427,6 +440,7 @@
     ;; Otherwise we can't unify.
     (t (backtrack! wam))))
 
+
 (define-instructions (%get-variable-local %get-variable-stack)
     ((wam wam)
      (register register-index)
@@ -638,6 +652,42 @@
       (tidy-trail! wam))))
 
 
+;;;; Lisp Object Instructions
+(declaim (inline %%match-lisp-object))
+
+
+(defun* %%match-lisp-object ((wam wam)
+                             (object t)
+                             (address store-index))
+  (cell-typecase (wam (deref wam address) address)
+    ;; If the thing points at a reference (unbound, because we deref'ed) we just
+    ;; bind it.
+    (:reference
+     (wam-set-store-cell! wam address +cell-type-lisp-object+ object)
+     (trail! wam address))
+
+    ;; If this is a lisp object, "unify" them with eql.
+    ((:lisp-object contents)
+     (when (not (lisp-objects-match-p object contents))
+       (backtrack! wam)))
+
+    ;; Otherwise we can't unify.
+    (t (backtrack! wam))))
+
+
+(define-instruction (%get-lisp-object)
+    ((wam wam)
+     (object t)
+     (register register-index))
+  (%%match-lisp-object wam object register))
+
+(define-instruction (%put-lisp-object)
+    ((wam wam)
+     (object t)
+     (register register-index))
+  (wam-set-local-register! wam register +cell-type-lisp-object+ object))
+
+
 ;;;; Constant Instructions
 (declaim (inline %%match-constant))
 
@@ -652,7 +702,7 @@
      (trail! wam address))
 
     ((:constant c)
-     (when (not (eq constant c))
+     (when (not (constants-match-p constant c))
        (backtrack! wam)))
 
     (t (backtrack! wam))))
@@ -662,9 +712,7 @@
     ((wam wam)
      (constant functor)
      (register register-index))
-  (wam-set-local-register! wam register +cell-type-constant+ constant)
-  ; todo we can probably elide this because constants never have subterms...
-  (setf (wam-mode wam) :write))
+  (wam-set-local-register! wam register +cell-type-constant+ constant))
 
 (define-instruction (%get-constant)
     ((wam wam)
@@ -715,6 +763,7 @@
                        (loop :repeat arity
                              :for subterm :from (+ address 1)
                              :collect (recur subterm)))))
+             ((:lisp-object o) o)
              (t (error "What to heck is this?")))))
       (mapcar #'recur addresses))))
 
@@ -838,6 +887,9 @@
             (#.+opcode-put-constant+      :instruction %put-constant)
             (#.+opcode-get-constant+      :instruction %get-constant)
             (#.+opcode-subterm-constant+  :instruction %subterm-constant)
+            ;; Lisp Objects
+            (#.+opcode-put-lisp-object+   :instruction %put-lisp-object)
+            (#.+opcode-get-lisp-object+   :instruction %get-lisp-object)
             ;; List
             (#.+opcode-put-list+  :instruction %put-list)
             (#.+opcode-get-list+  :instruction %get-list)
diff -r 1411666a60f8 -r 5edeeac89e03 src/wam/wam.lisp
--- a/src/wam/wam.lisp	Fri Jul 15 15:03:01 2016 +0000
+++ b/src/wam/wam.lisp	Fri Jul 15 19:12:21 2016 +0000
@@ -147,6 +147,10 @@
 ;;; consecutive cells.  The first cell is the car of the list, the second one is
 ;;; the cdr.
 ;;;
+;;; LISP-OBJECT cell values are simply arbitrary objects in memory.  They are
+;;; compared with `eql` during the unification process, so we don't actually
+;;; care WHAT they are, exactly.
+;;;
 ;;; STACK cell values are special cases.  The WAM's main store is a combination
 ;;; of the heap, the stack, and registers.  Heap cells (and registers) are those
 ;;; detailed above, but stack cells can also hold numbers like the continuation
@@ -203,6 +207,7 @@
   (define-unsafe %unsafe-functor-value functor)
   (define-unsafe %unsafe-constant-value functor)
   (define-unsafe %unsafe-list-value store-index)
+  (define-unsafe %unsafe-lisp-object-value t)
   (define-unsafe %unsafe-stack-value stack-word))
 
 
@@ -214,6 +219,7 @@
     (:functor +cell-type-functor+)
     (:constant +cell-type-constant+)
     (:list +cell-type-list+)
+    (:lisp-object +cell-type-lisp-object+)
     ((t) t)))
 
 (defun %type-designator-accessor (designator)
@@ -223,7 +229,8 @@
     (:reference '%unsafe-reference-value)
     (:functor '%unsafe-functor-value)
     (:constant '%unsafe-constant-value)
-    (:list '%unsafe-list-value)))
+    (:list '%unsafe-list-value)
+    (:lisp-object '%unsafe-lisp-object-value)))
 
 
 (defmacro cell-typecase ((wam address &optional address-symbol) &rest clauses)
@@ -1007,8 +1014,12 @@
                  wam-unification-stack-empty-p))
 
 
-(defun* wam-unification-stack-push! ((wam wam) (address store-index))
-  (vector-push-extend address (wam-unification-stack wam)))
+(defun* wam-unification-stack-push!
+    ((wam wam)
+     (address1 store-index)
+     (address2 store-index))
+  (vector-push-extend address1 (wam-unification-stack wam))
+  (vector-push-extend address2 (wam-unification-stack wam)))
 
 (defun* wam-unification-stack-pop! ((wam wam))
   (:returns store-index)
diff -r 1411666a60f8 -r 5edeeac89e03 test/wam.lisp
--- a/test/wam.lisp	Fri Jul 15 15:03:01 2016 +0000
+++ b/test/wam.lisp	Fri Jul 15 19:12:21 2016 +0000
@@ -486,3 +486,28 @@
        (?what ((move a b) (move a c) (move b c)
                (move a b)
                (move c a) (move c b) (move a b)))))))
+
+(test numbers
+  (with-fresh-database
+    (push-logic-frame-with
+      (rule (= ?x ?x))
+      (fact (foo 1))
+      (fact (bar 2))
+      (rule (baz ?x) (foo ?x))
+      (rule (baz ?x) (bar ?x))
+      (rule (lol ?x)
+        (foo ?x)
+        (bar ?x)))
+
+    (should-return
+      ((foo ?what)
+       (?what 1))
+      ((bar ?what)
+       (?what 2))
+      ((baz ?what)
+       (?what 1)
+       (?what 2))
+      ((foo 0) fail)
+      ((lol ?anything) fail)
+      ((= 0 1) fail)
+      ((= 0 0) empty))))