3325913a9b16

Add `put-void`

Not sure what I was thinking before -- we definitely need this instruction.
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 22 Jul 2016 20:32:51 +0000
parents 582f7076626b
children 4abb7eda96cb
branches/tags (none)
files src/wam/bytecode.lisp src/wam/compiler/5-precompilation.lisp src/wam/compiler/6-optimization.lisp src/wam/compiler/7-rendering.lisp src/wam/constants.lisp src/wam/vm.lisp test/wam.lisp

Changes

--- a/src/wam/bytecode.lisp	Sun Jul 17 16:59:50 2016 +0000
+++ b/src/wam/bytecode.lisp	Fri Jul 22 20:32:51 2016 +0000
@@ -17,6 +17,7 @@
     (+opcode-put-variable-stack+ "PUT-VARIABLE")
     (+opcode-put-value-local+ "PUT-VALUE")
     (+opcode-put-value-stack+ "PUT-VALUE")
+    (+opcode-put-void+ "PUT-VOID")
 
     (+opcode-subterm-variable-local+ "SUBTERM-VARIABLE")
     (+opcode-subterm-variable-stack+ "SUBTERM-VARIABLE")
@@ -62,6 +63,7 @@
     (+opcode-put-variable-stack+ "PVAR")
     (+opcode-put-value-local+ "PVLU")
     (+opcode-put-value-stack+ "PVLU")
+    (+opcode-put-void+ "PVOI")
 
     (+opcode-subterm-variable-local+ "SVAR")
     (+opcode-subterm-variable-stack+ "SVAR")
@@ -113,6 +115,7 @@
   (#.+opcode-put-variable-stack+ 3)
   (#.+opcode-put-value-local+ 3)
   (#.+opcode-put-value-stack+ 3)
+  (#.+opcode-put-void+ 2)
 
   (#.+opcode-subterm-variable-local+ 2)
   (#.+opcode-subterm-variable-stack+ 2)
--- a/src/wam/compiler/5-precompilation.lisp	Sun Jul 17 16:59:50 2016 +0000
+++ b/src/wam/compiler/5-precompilation.lisp	Fri Jul 22 20:32:51 2016 +0000
@@ -180,9 +180,13 @@
            (setf seen (remove-if #'register-temporary-p seen)))
          (handle-argument (argument-register source-register)
            (if (register-anonymous-p source-register)
-             ;; Crazy, but we can just drop argument-position anonymous
-             ;; variables on the floor at this point.
-             nil
+             (ecase mode
+               ;; Query terms need to put an unbound var into their argument
+               ;; register for each anonymous variable.
+               (:query (push-instruction :put-void argument-register))
+               ;; Crazy, but for program terms we can just drop
+               ;; argument-position anonymous variables on the floor.
+               (:program nil))
              ;; OP X_n A_i
              (let ((first-seen (push-if-new source-register seen :test #'register=)))
                (push-instruction
--- a/src/wam/compiler/6-optimization.lisp	Sun Jul 17 16:59:50 2016 +0000
+++ b/src/wam/compiler/6-optimization.lisp	Fri Jul 22 20:32:51 2016 +0000
@@ -79,14 +79,13 @@
 
 
 (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.
+  ;; We can optimize runs of N (:unify-void 1) instructions into a single one
+  ;; that does all N at once.
   (loop
     :for node = (circle-forward instructions) :then (circle-forward node)
     :while node
     :for opcode = (car (circle-value node))
-    :when (or (eq opcode :set-void)
-              (eq opcode :subterm-void))
+    :when (eq opcode :subterm-void)
     :do
     (loop
       :with beginning = (circle-backward node)
--- a/src/wam/compiler/7-rendering.lisp	Sun Jul 17 16:59:50 2016 +0000
+++ b/src/wam/compiler/7-rendering.lisp	Fri Jul 22 20:32:51 2016 +0000
@@ -48,6 +48,7 @@
     (:put-variable-stack     +opcode-put-variable-stack+)
     (:put-value-local        +opcode-put-value-local+)
     (:put-value-stack        +opcode-put-value-stack+)
+    (:put-void               +opcode-put-void+)
     (:subterm-variable-local +opcode-subterm-variable-local+)
     (:subterm-variable-stack +opcode-subterm-variable-stack+)
     (:subterm-value-local    +opcode-subterm-value-local+)
--- a/src/wam/constants.lisp	Sun Jul 17 16:59:50 2016 +0000
+++ b/src/wam/constants.lisp	Fri Jul 22 20:32:51 2016 +0000
@@ -108,6 +108,7 @@
   +opcode-put-variable-stack+
   +opcode-put-value-local+
   +opcode-put-value-stack+
+  +opcode-put-void+
 
   ;; Subterm
   +opcode-subterm-variable-local+
--- a/src/wam/vm.lisp	Sun Jul 17 16:59:50 2016 +0000
+++ b/src/wam/vm.lisp	Fri Jul 22 20:32:51 2016 +0000
@@ -353,6 +353,10 @@
   (setf (wam-mode wam) :write))
 
 
+(define-instruction (%put-void) (wam argument)
+  (wam-copy-to-local-register! wam argument (push-unbound-reference! wam)))
+
+
 ;;;; Program Instructions
 (define-instruction (%get-structure) (wam functor arity register)
   (cell-typecase (wam (deref wam register) address)
@@ -824,6 +828,7 @@
             (#.+opcode-put-variable-stack+  :instruction %put-variable-stack)
             (#.+opcode-put-value-local+     :instruction %put-value-local)
             (#.+opcode-put-value-stack+     :instruction %put-value-stack)
+            (#.+opcode-put-void+            :instruction %put-void)
             ;; Program
             (#.+opcode-get-structure+       :instruction %get-structure)
             (#.+opcode-get-variable-local+  :instruction %get-variable-local)
--- a/test/wam.lisp	Sun Jul 17 16:59:50 2016 +0000
+++ b/test/wam.lisp	Fri Jul 22 20:32:51 2016 +0000
@@ -379,12 +379,18 @@
       (fact (foo x))
       (rule (bar (baz ?x ?y ?z ?thing))
         (foo ?thing))
-      (fact (wild ? ? ?)))
+      (fact (wild ? ? ?))
+      
+      (fact (does x move))
+      (rule (next z)
+        (does ? move)))
     (should-return
       ((following (s x x x a)) empty)
       ((bar (baz a b c no)) fail)
       ((bar (baz a b c ?what)) (?what x))
-      ((wild a b c) empty))))
+      ((wild a b c) empty)
+      ((next z) empty)
+      )))
 
 (test normalization-ui
   (with-fresh-database
@@ -483,3 +489,4 @@
       ((lol ?anything) fail)
       ((= 0 1) fail)
       ((= 0 0) empty))))
+