07e1d5f315f5

Fix constant unification

How did I not notice this til now?  Jesus.  This is a mistake in the book that
the erratum pointed out and I read but somehow just ignored because I'm an
idiot.
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 09 Jul 2016 21:51:02 +0000
parents 92c590f78133
children ba205f6b2875 4d17e3cb6fa2
branches/tags (none)
files src/circle.lisp src/wam/vm.lisp test/wam.lisp

Changes

--- a/src/circle.lisp	Sat Jul 09 21:03:01 2016 +0000
+++ b/src/circle.lisp	Sat Jul 09 21:51:02 2016 +0000
@@ -45,7 +45,7 @@
 (defparameter *circle-sentinel* 'circle-sentinel)
 
 
-(declaim (inline circle-prev circle-value circle-next))
+(declaim (inline circle-prev circle-value circle-next make-circle))
 
 (defstruct circle prev value next)
 
--- a/src/wam/vm.lisp	Sat Jul 09 21:03:01 2016 +0000
+++ b/src/wam/vm.lisp	Sat Jul 09 21:51:02 2016 +0000
@@ -662,13 +662,15 @@
 
 (define-instruction %set-constant ((wam wam)
                                    (constant functor-index))
-  (wam-heap-push! wam (make-cell-constant constant)))
+  (wam-heap-push! wam (make-cell-constant constant))
+  (incf (wam-subterm wam)))
 
 (define-instruction %unify-constant ((wam wam)
                                      (constant functor-index))
   (ecase (wam-mode wam)
     (:read (%%match-constant wam constant (wam-subterm wam)))
-    (:write (wam-heap-push! wam (make-cell-constant constant)))))
+    (:write (wam-heap-push! wam (make-cell-constant constant))))
+  (incf (wam-subterm wam)))
 
 
 ;;;; Running
--- a/test/wam.lisp	Sat Jul 09 21:03:01 2016 +0000
+++ b/test/wam.lisp	Sat Jul 09 21:51:02 2016 +0000
@@ -435,3 +435,11 @@
       ((c) empty)
       ((d) fail)
       (dogs empty))))
+
+(test nested-constants
+  (with-fresh-database
+    (push-logic-frame-with
+      (fact (foo (s a b c))))
+    (should-return
+      ((foo (s ?x ?y ?z))
+       (?x a ?y b ?z c)))))