# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1471974783 0
# Node ID 837374f5256daf28d727e06735947b93874edc44
# Parent  38d5c4302e124f19135fb4e4f5ed6a5a8428a669
Make all the UI functions take a database parameter

Fixes https://github.com/sjl/temperance/issues/2

diff -r 38d5c4302e12 -r 837374f5256d .lispwords
--- a/.lispwords	Tue Aug 23 13:10:01 2016 +0000
+++ b/.lispwords	Tue Aug 23 17:53:03 2016 +0000
@@ -4,8 +4,9 @@
 (1 with-database)
 (1 recursively)
 (1 when-let)
-(1 rule)
-(0 push-logic-frame-with)
+(2 rule)
+(1 fact facts)
+(1 push-logic-frame-with)
 (1 cell-typecase)
 (1 opcode-case)
 (2 define-invocation)
diff -r 38d5c4302e12 -r 837374f5256d package.lisp
--- a/package.lisp	Tue Aug 23 13:10:01 2016 +0000
+++ b/package.lisp	Tue Aug 23 17:53:03 2016 +0000
@@ -1,3 +1,23 @@
+(defpackage #:temperance.internal
+  (:use #:cl))
+
+(in-package #:temperance.internal)
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun external-symbols (package)
+    (let ((symbols nil))
+      (do-external-symbols (s (find-package package) symbols)
+        (push s symbols)))))
+
+(defmacro defpackage-inheriting (name parent-packages &rest args)
+  `(defpackage ,name
+     ,@args
+     ,@(loop :for parent-package :in parent-packages
+             :collect `(:use ,parent-package)
+             :collect `(:export ,@(external-symbols parent-package)))))
+
+
 (defpackage #:temperance.utils
   (:use
     #:cl
@@ -64,8 +84,8 @@
     #:temperance.utils)
   (:export
     #:make-database
-    #:reset-database
-    #:with-database
+    #:reset-standard-database
+
     #:with-fresh-database
 
     #:invoke-rule
@@ -99,42 +119,6 @@
     #:?
     #:!))
 
-(defpackage #:temperance
-  (:use #:cl #:temperance.wam)
-  (:export
-    #:make-database
-    #:with-database
-    #:with-fresh-database
 
-    #:invoke-rule
-    #:invoke-fact
-    #:invoke-facts
-
-    #:rule
-    #:fact
-    #:facts
-
-    #:push-logic-frame
-    #:pop-logic-frame
-    #:finalize-logic-frame
-    #:push-logic-frame-with
-
-    #:invoke-query
-    #:invoke-query-all
-    #:invoke-query-map
-    #:invoke-query-do
-    #:invoke-query-find
-    #:invoke-prove
-
-    #:query
-    #:query-all
-    #:query-map
-    #:query-do
-    #:query-find
-    #:prove
-
-    #:call
-    #:?
-    #:!
-
-    ))
+(defpackage-inheriting #:temperance (#:temperance.wam)
+  (:use #:cl))
diff -r 38d5c4302e12 -r 837374f5256d src/ui.lisp
--- a/src/ui.lisp	Tue Aug 23 13:10:01 2016 +0000
+++ b/src/ui.lisp	Tue Aug 23 17:53:03 2016 +0000
@@ -2,13 +2,18 @@
 
 
 ;;;; Database
-(defvar *standard-database* nil)
+(defvar *standard-database* (make-wam))
+
+(defun ensure-database (database-designator)
+  (etypecase database-designator
+    ((eql t) *standard-database*)
+    (wam database-designator)))
 
 
 (defun make-database ()
   (make-wam))
 
-(defun reset-database ()
+(defun reset-standard-database ()
   (setf *standard-database* (make-database)))
 
 
@@ -39,77 +44,76 @@
 
 
 ;;;; Assertion
-(defun invoke-rule (head &rest body)
-  (assert *standard-database* (*standard-database*) "No database.")
-  (wam-logic-frame-add-clause! *standard-database*
+(defun invoke-rule (database head &rest body)
+  (wam-logic-frame-add-clause! (ensure-database database)
                                (list* (normalize-term head)
                                       (mapcar #'normalize-term body)))
   nil)
 
-(defun invoke-fact (fact)
-  (invoke-rule fact)
+(defun invoke-fact (database fact)
+  (invoke-rule database fact)
   nil)
 
-(defun invoke-facts (&rest facts)
-  (mapc #'invoke-fact facts)
+(defun invoke-facts (database &rest facts)
+  (loop :for fact :in facts
+        :do (invoke-fact database fact))
   nil)
 
 
-(defmacro rule (head &body body)
-  `(invoke-rule ',head ,@(loop :for term :in body :collect `',term)))
+(defmacro rule (database head &body body)
+  `(invoke-rule ,database
+                ',head ,@(loop :for term :in body :collect `',term)))
 
-(defmacro fact (fact)
-  `(invoke-fact ',fact))
+(defmacro fact (database fact)
+  `(invoke-fact ,database ',fact))
 
-(defmacro facts (&body facts)
-  `(progn
-     ,@(loop :for f :in facts :collect `(fact ,f))))
+(defmacro facts (database &body facts)
+  (once-only (database)
+    `(progn
+      ,@(loop :for f :in facts :collect `(fact ,database ,f)))))
 
 
 ;;;; Logic Frames
-(defun push-logic-frame ()
-  (assert *standard-database* (*standard-database*) "No database.")
-  (wam-push-logic-frame! *standard-database*))
+(defun push-logic-frame (database)
+  (wam-push-logic-frame! (ensure-database database)))
 
-(defun pop-logic-frame ()
-  (assert *standard-database* (*standard-database*) "No database.")
-  (wam-pop-logic-frame! *standard-database*))
+(defun pop-logic-frame (database)
+  (wam-pop-logic-frame! (ensure-database database)))
 
-(defun finalize-logic-frame ()
-  (assert *standard-database* (*standard-database*) "No database.")
-  (wam-finalize-logic-frame! *standard-database*))
+(defun finalize-logic-frame (database)
+  (wam-finalize-logic-frame! (ensure-database database)))
 
-(defmacro push-logic-frame-with (&body body)
-  `(prog2
-     (push-logic-frame)
-     (progn ,@body)
-     (finalize-logic-frame)))
+(defmacro push-logic-frame-with (database &body body)
+  (once-only (database)
+    `(prog2
+      (push-logic-frame ,database)
+      (progn ,@body)
+      (finalize-logic-frame ,database))))
 
 
 ;;;; Querying
-(defun perform-aot-query (code size vars result-function)
-  (assert *standard-database* (*standard-database*) "No database.")
-  (run-aot-compiled-query *standard-database* code size vars
+(defun perform-aot-query (database code size vars result-function)
+  (run-aot-compiled-query (ensure-database database) code size vars
                           :result-function result-function))
 
-(defun perform-query (terms result-function)
-  (assert *standard-database* (*standard-database*) "No database.")
-  (run-query *standard-database* (mapcar #'normalize-term terms)
+(defun perform-query (database terms result-function)
+  (run-query (ensure-database database)
+             (mapcar #'normalize-term terms)
              :result-function result-function))
 
 
 (defmacro define-invocation ((name aot-name) arglist &body body)
-  (with-gensyms (terms data code size vars)
+  (with-gensyms (code size vars)
     `(progn
-      (defun ,name ,(append arglist `(&rest ,terms))
+      (defun ,name (database ,@arglist &rest terms)
         (macrolet ((invoke (result-function)
-                     `(perform-query ,',terms ,result-function)))
+                     `(perform-query database terms ,result-function)))
           ,@body))
-      (defun ,aot-name ,(append arglist `(,data))
-        (destructuring-bind (,code ,size ,vars) ,data
+      (defun ,aot-name (database ,@arglist data)
+        (destructuring-bind (,code ,size ,vars) data
           (macrolet ((invoke (result-function)
-                       `(perform-aot-query ,',code ,',size ,',vars
-                                           ,result-function)))
+                       `(perform-aot-query database ,',code ,',size ,',vars
+                         ,result-function)))
             ,@body))))))
 
 
@@ -165,23 +169,23 @@
 (defun quote-terms (terms)
   (loop :for term :in terms :collect `',term))
 
-(defmacro query (&rest terms)
-  `(invoke-query ,@(quote-terms terms)))
+(defmacro query (database &rest terms)
+  `(invoke-query ,database ,@(quote-terms terms)))
 
-(defmacro query-all (&rest terms)
-  `(invoke-query-all ,@(quote-terms terms)))
+(defmacro query-all (database &rest terms)
+  `(invoke-query-all ,database ,@(quote-terms terms)))
 
-(defmacro query-map (function &rest terms)
-  `(invoke-query-map ,function ,@(quote-terms terms)))
+(defmacro query-map (database function &rest terms)
+  `(invoke-query-map ,database ,function ,@(quote-terms terms)))
 
-(defmacro query-do (function &rest terms)
-  `(invoke-query-do ,function ,@(quote-terms terms)))
+(defmacro query-do (database function &rest terms)
+  `(invoke-query-do ,database ,function ,@(quote-terms terms)))
 
-(defmacro query-find (predicate &rest terms)
-  `(invoke-query-find ,predicate ,@(quote-terms terms)))
+(defmacro query-find (database predicate &rest terms)
+  `(invoke-query-find ,database ,predicate ,@(quote-terms terms)))
 
-(defmacro prove (&rest terms)
-  `(invoke-prove ,@(quote-terms terms)))
+(defmacro prove (database &rest terms)
+  `(invoke-prove ,database ,@(quote-terms terms)))
 
 
 ;;;; Chili Dogs
@@ -209,12 +213,17 @@
       form)))
 
 
-(define-invocation-compiler-macro invoke-query      invoke-query-aot ())
-(define-invocation-compiler-macro invoke-query-all  invoke-query-all-aot ())
-(define-invocation-compiler-macro invoke-query-map  invoke-query-map-aot (function))
-(define-invocation-compiler-macro invoke-query-do   invoke-query-do-aot (function))
-(define-invocation-compiler-macro invoke-query-find invoke-query-find-aot (predicate))
-(define-invocation-compiler-macro invoke-prove      invoke-prove-aot ())
+(define-invocation-compiler-macro invoke-query invoke-query-aot (database))
+
+(define-invocation-compiler-macro invoke-query-all invoke-query-all-aot (database))
+
+(define-invocation-compiler-macro invoke-query-map invoke-query-map-aot (database function))
+
+(define-invocation-compiler-macro invoke-query-do invoke-query-do-aot (database function))
+
+(define-invocation-compiler-macro invoke-query-find invoke-query-find-aot (database predicate))
+
+(define-invocation-compiler-macro invoke-prove invoke-prove-aot (database))
 
 
 ;;;; Debugging
diff -r 38d5c4302e12 -r 837374f5256d test/99.lisp
--- a/test/99.lisp	Tue Aug 23 13:10:01 2016 +0000
+++ b/test/99.lisp	Tue Aug 23 17:53:03 2016 +0000
@@ -9,9 +9,9 @@
 (define-test p1
   ;; Find the last element of a list.
   (with-fresh-database
-    (push-logic-frame-with
-      (fact (last ?x (list ?x)))
-      (rule (last ?x (list* ? ?tail))
+    (push-logic-frame-with t
+      (fact t (last ?x (list ?x)))
+      (rule t (last ?x (list* ? ?tail))
         (last ?x ?tail)))
 
     (should-return
@@ -33,9 +33,9 @@
 (define-test p2
   ;; Find the last but one element of a list.
   (with-fresh-database
-    (push-logic-frame-with
-      (fact (last-but-one ?x (list ?x ?)))
-      (rule (last-but-one ?x (list* ? ?tail))
+    (push-logic-frame-with t
+      (fact t (last-but-one ?x (list ?x ?)))
+      (rule t (last-but-one ?x (list* ? ?tail))
         (last-but-one ?x ?tail)))
 
     (should-return
@@ -57,12 +57,12 @@
 
 
 (defun %reverse ()
-  (push-logic-frame-with
-    (fact (reverse-acc nil ?acc ?acc))
-    (rule (reverse-acc (list* ?x ?tail) ?acc ?reversed)
+  (push-logic-frame-with t
+    (fact t (reverse-acc nil ?acc ?acc))
+    (rule t (reverse-acc (list* ?x ?tail) ?acc ?reversed)
       (reverse-acc ?tail (list* ?x ?acc) ?reversed))
 
-    (rule (reverse ?l ?r)
+    (rule t (reverse ?l ?r)
       (reverse-acc ?l nil ?r))))
 
 (define-test p5
@@ -87,8 +87,8 @@
   ;; Find out whether a list is a palindrome.
   (with-fresh-database
     (%reverse)
-    (push-logic-frame-with
-      (rule (palindrome ?l)
+    (push-logic-frame-with t
+      (rule t (palindrome ?l)
         (reverse ?l ?l)))
 
     (should-return
@@ -107,18 +107,18 @@
     (%not)
     (%append)
 
-    (push-logic-frame-with
-      (fact (is-list nil))
-      (fact (is-list (list* ? ?)))
+    (push-logic-frame-with t
+      (fact t (is-list nil))
+      (fact t (is-list (list* ? ?)))
 
-      (fact (flatten nil nil))
+      (fact t (flatten nil nil))
 
-      (rule (flatten (list* ?atom ?tail)
-                     (list* ?atom ?flat-tail))
+      (rule t (flatten (list* ?atom ?tail)
+                       (list* ?atom ?flat-tail))
         (not (is-list ?atom))
         (flatten ?tail ?flat-tail))
 
-      (rule (flatten (list* ?head ?tail) ?flattened)
+      (rule t (flatten (list* ?head ?tail) ?flattened)
         (is-list ?head)
         (flatten ?head ?flat-head)
         (flatten ?tail ?flat-tail)
@@ -150,14 +150,14 @@
     (%=)
     (%not)
 
-    (push-logic-frame-with
-      (fact (compress nil nil))
-      (fact (compress (list ?x) (list ?x)))
+    (push-logic-frame-with t
+      (fact t (compress nil nil))
+      (fact t (compress (list ?x) (list ?x)))
 
-      (rule (compress (list* ?x ?x ?rest) ?result)
+      (rule t (compress (list* ?x ?x ?rest) ?result)
         (compress (list* ?x ?rest) ?result))
 
-      (rule (compress (list* ?x ?y ?rest) (list* ?x ?result))
+      (rule t (compress (list* ?x ?y ?rest) (list* ?x ?result))
         (not (= ?x ?y))
         (compress (list* ?y ?rest) ?result)))
 
@@ -185,17 +185,17 @@
 ;     (%=)
 ;     (%not)
 
-;     (push-logic-frame-with
-;       (fact (pack nil nil))
-;       (fact (pack (list ?x) (list (list ?x))))
+;     (push-logic-frame-with t
+;       (fact t (pack nil nil))
+;       (fact t (pack (list ?x) (list (list ?x))))
 
-;       (rule (pack (list* ?x ?tail)
+;       (rule t (pack (list* ?x ?tail)
 ;                   (list* (list ?x) ?ptail))
 ;         (pack ?tail ?ptail)
 ;         (= ?ptail (list* (list* ?y ?) ?))
 ;         (not (= ?x ?y)))
 
-;       (rule (pack (list* ?h ?tail)
+;       (rule t (pack (list* ?h ?tail)
 ;                   (list* (list* ?h ?h ?hs) ?more))
 ;         (pack ?tail (list* (list* ?h ?hs) ?more))))
 
@@ -214,9 +214,9 @@
 (define-test p14
   ;; Duplicate the elements of a list.
   (with-fresh-database
-    (push-logic-frame-with
-      (fact (duplicate nil nil))
-      (rule (duplicate (list* ?x ?rest) (list* ?x ?x ?rest-dup))
+    (push-logic-frame-with t
+      (fact t (duplicate nil nil))
+      (rule t (duplicate (list* ?x ?rest) (list* ?x ?x ?rest-dup))
         (duplicate ?rest ?rest-dup)))
 
     (should-return
diff -r 38d5c4302e12 -r 837374f5256d test/taop.lisp
--- a/test/taop.lisp	Tue Aug 23 13:10:01 2016 +0000
+++ b/test/taop.lisp	Tue Aug 23 17:53:03 2016 +0000
@@ -6,83 +6,84 @@
   (with-fresh-database
     (%=)
     (%not)
-    (push-logic-frame-with
-      (facts (father abraham isaac)
-             (father haran lot)
-             (father haran milcah)
-             (father haran yiscah)
-             (father terach abraham)
-             (father terach nachor)
-             (father terach haran)
-             (mother sarah isaac)
-             (male isaac)
-             (male lot)
-             (male terach)
-             (male nachor)
-             (male haran)
-             (male abraham)
-             (female sarah)
-             (female milcah)
-             (female yiscah))
+    (push-logic-frame-with t
+      (facts t
+        (father abraham isaac)
+        (father haran lot)
+        (father haran milcah)
+        (father haran yiscah)
+        (father terach abraham)
+        (father terach nachor)
+        (father terach haran)
+        (mother sarah isaac)
+        (male isaac)
+        (male lot)
+        (male terach)
+        (male nachor)
+        (male haran)
+        (male abraham)
+        (female sarah)
+        (female milcah)
+        (female yiscah))
 
-      (rule (parent ?person ?kid) (father ?person ?kid))
-      (rule (parent ?person ?kid) (mother ?person ?kid))
+      (rule t (parent ?person ?kid) (father ?person ?kid))
+      (rule t (parent ?person ?kid) (mother ?person ?kid))
 
-      (rule (father ?person) (father ?person ?))
-      (rule (mother ?person) (mother ?person ?))
-      (rule (parent ?person) (father ?person))
-      (rule (parent ?person) (mother ?person))
+      (rule t (father ?person) (father ?person ?))
+      (rule t (mother ?person) (mother ?person ?))
+      (rule t (parent ?person) (father ?person))
+      (rule t (parent ?person) (mother ?person))
 
-      (rule (grandparent ?person ?grandkid)
+      (rule t (grandparent ?person ?grandkid)
         (parent ?person ?kid)
         (parent ?kid ?grandkid))
 
-      (rule (grandmother ?person ?grandkid)
+      (rule t (grandmother ?person ?grandkid)
         (grandparent ?person ?grandkid)
         (female ?person))
 
-      (rule (grandfather ?person ?grandkid)
+      (rule t (grandfather ?person ?grandkid)
         (grandparent ?person ?grandkid)
         (male ?person))
 
-      (rule (son ?parent ?kid)
+      (rule t (son ?parent ?kid)
         (parent ?parent ?kid)
         (male ?kid))
 
-      (rule (daughter ?parent ?kid)
+      (rule t (daughter ?parent ?kid)
         (parent ?parent ?kid)
         (female ?kid))
 
-      (rule (siblings ?x ?y)
+      (rule t (siblings ?x ?y)
         (parent ?p ?x)
         (parent ?p ?y)
         (not (= ?x ?y)))
 
-      (rule (brother ?bro ?person)
+      (rule t (brother ?bro ?person)
         (siblings ?bro ?person)
         (male ?bro))
 
-      (rule (sister ?sis ?person)
+      (rule t (sister ?sis ?person)
         (siblings ?sis ?person)
         (female ?sis))
 
-      (rule (uncle ?unc ?kid)
+      (rule t (uncle ?unc ?kid)
         (brother ?unc ?parent)
         (parent ?parent ?kid))
 
-      (rule (aunt ?unc ?kid)
+      (rule t (aunt ?unc ?kid)
         (sister ?unc ?parent)
         (parent ?parent ?kid))
 
-      (rule (cousins ?x ?y)
+      (rule t (cousins ?x ?y)
         (parent ?px ?x)
         (parent ?py ?y)
         (siblings ?px ?py))
 
-      (rule (ancestor ?old ?young)
+      (rule t (ancestor ?old ?young)
         (parent ?old ?young))
 
-      (rule (ancestor ?old ?young)
+      (rule t (ancestor ?old ?young)
         (parent ?old ?p)
         (ancestor ?p ?young)))
 
@@ -119,28 +120,30 @@
     (%=)
     (%not)
 
-    (push-logic-frame-with
+    (push-logic-frame-with t
       ;; and gate
 
       ;; (resistor name node-1 node-2)
-      (facts (resistor r1 power n1)
-             (resistor r2 power n2))
+      (facts t
+        (resistor r1 power n1)
+        (resistor r2 power n2))
 
       ;; (transistor name gate source drain)
-      (facts (transistor t1 n2 ground n1)
-             (transistor t2 n3 n4 n2)
-             (transistor t3 n5 ground n4))
+      (facts t
+        (transistor t1 n2 ground n1)
+        (transistor t2 n3 n4 n2)
+        (transistor t3 n5 ground n4))
 
-      (rule (inverter (inverter ?t ?r) ?input ?output)
+      (rule t (inverter (inverter ?t ?r) ?input ?output)
         (transistor ?t ?input ground ?output)
         (resistor ?r power ?output))
 
-      (rule (nand (nand ?t1 ?t2 ?r) ?a ?b ?output)
+      (rule t (nand (nand ?t1 ?t2 ?r) ?a ?b ?output)
         (transistor ?t1 ?a ?x ?output)
         (transistor ?t2 ?b ground ?x)
         (resistor ?r power ?output))
 
-      (rule (and (and ?n ?i) ?a ?b ?output)
+      (rule t (and (and ?n ?i) ?a ?b ?output)
         (nand ?n ?a ?b ?x)
         (inverter ?i ?x ?output)))
 
@@ -149,27 +152,28 @@
        (?a n3 ?b n5 ?out n1 ?g (and (nand t2 t3 r2)
                                     (inverter t1 r1)))))
 
-    (pop-logic-frame)
+    (pop-logic-frame t)
 
-    (push-logic-frame-with
+    (push-logic-frame-with t
       ;; nor gate
-      (facts (resistor r1 power o)
-             (transistor t1 i1 ground o)
-             (transistor t2 i2 ground o)
-             (resistor r2 power no)
-             (transistor t3 o ground no))
+      (facts t
+        (resistor r1 power o)
+        (transistor t1 i1 ground o)
+        (transistor t2 i2 ground o)
+        (resistor r2 power no)
+        (transistor t3 o ground no))
 
-      (rule (inverter (inverter ?t ?r) ?input ?output)
+      (rule t (inverter (inverter ?t ?r) ?input ?output)
         (transistor ?t ?input ground ?output)
         (resistor ?r power ?output))
 
-      (rule (or (or ?t1 ?t2 ?r) ?a ?b ?output)
+      (rule t (or (or ?t1 ?t2 ?r) ?a ?b ?output)
         (transistor ?t1 ?a ground ?output)
         (transistor ?t2 ?b ground ?output)
         (not (= ?a ?b))
         (resistor ?r power ?output))
 
-      (rule (nor (nor ?o ?i) ?a ?b ?output)
+      (rule t (nor (nor ?o ?i) ?a ?b ?output)
         (or ?o ?a ?b ?x)
         (inverter ?i ?x ?output)))
 
@@ -185,38 +189,39 @@
 
 (define-test courses
   (with-fresh-database
-    (push-logic-frame-with
-      (facts (course complexity
-                     (time monday 9 11)
-                     (lecturer david harel)
-                     (location feinberg a))
-             (course lisp
-                     (time monday 10 12)
-                     (lecturer alyssa p hacker)
-                     (location main-hall))
-             (course scheme
-                     (time monday 12 15)
-                     (lecturer alyssa p hacker)
-                     (location online))
-             (course prolog
-                     (time tuesday 12 15)
-                     (lecturer ben bitdiddle)
-                     (location feinberg b))
-             (course haskell
-                     (time wednesday 12 15)
-                     (lecturer ben bitdiddle)
-                     (location online)))
+    (push-logic-frame-with t
+      (facts t
+        (course complexity
+                (time monday 9 11)
+                (lecturer david harel)
+                (location feinberg a))
+        (course lisp
+                (time monday 10 12)
+                (lecturer alyssa p hacker)
+                (location main-hall))
+        (course scheme
+                (time monday 12 15)
+                (lecturer alyssa p hacker)
+                (location online))
+        (course prolog
+                (time tuesday 12 15)
+                (lecturer ben bitdiddle)
+                (location feinberg b))
+        (course haskell
+                (time wednesday 12 15)
+                (lecturer ben bitdiddle)
+                (location online)))
 
-      (rule (lecturer ?who ?course)
+      (rule t (lecturer ?who ?course)
         (course ?course ? ?who ?))
 
-      (rule (teaches-on ?who ?day)
+      (rule t (teaches-on ?who ?day)
         (course ? (time ?day ? ?) ?who ?))
 
-      (rule (teaches-in ?who ?location)
+      (rule t (teaches-in ?who ?location)
         (course ? ? ?who ?location))
 
-      (rule (location-of ?course ?location)
+      (rule t (location-of ?course ?location)
         (course ?course ? ? ?location)))
 
     (should-return
@@ -239,17 +244,18 @@
 (define-test books
   (with-fresh-database
     (%member)
-    (push-logic-frame-with
-      (facts (book paip (list norvig) 1992)
-             (book sicp (list abelson sussman) 1996)
-             (book lol (list hoyte) 2008)
-             (book clos (list keene) 1988))
+    (push-logic-frame-with t
+      (facts t
+        (book paip (list norvig) 1992)
+        (book sicp (list abelson sussman) 1996)
+        (book lol (list hoyte) 2008)
+        (book clos (list keene) 1988))
 
-      (rule (wrote ?who ?title)
+      (rule t (wrote ?who ?title)
         (book ?title ?authors ?)
         (member ?who ?authors))
 
-      (rule (published-in ?who ?year)
+      (rule t (published-in ?who ?year)
         (book ? ?authors ?year)
         (member ?who ?authors)))
 
@@ -264,16 +270,17 @@
 
 (define-test graph
   (with-fresh-database
-    (push-logic-frame-with
-      (facts (edge a b)
-             (edge c d)
-             (edge a c)
-             (edge d e)
-             (edge b d)
-             (edge f g))
+    (push-logic-frame-with t
+      (facts t
+        (edge a b)
+        (edge c d)
+        (edge a c)
+        (edge d e)
+        (edge b d)
+        (edge f g))
 
-      (fact (connected ?node ?node))
-      (rule (connected ?node-1 ?node-2)
+      (fact t (connected ?node ?node))
+      (rule t (connected ?node-1 ?node-2)
         (edge ?node-1 ?link)
         (connected ?link ?node-2)))
 
diff -r 38d5c4302e12 -r 837374f5256d test/utils.lisp
--- a/test/utils.lisp	Tue Aug 23 13:10:01 2016 +0000
+++ b/test/utils.lisp	Tue Aug 23 17:53:03 2016 +0000
@@ -25,7 +25,7 @@
 (defmacro should-fail (&body queries)
   `(progn
      ,@(loop :for query :in queries :collect
-             `(is (results= nil (query-all ,query))))))
+             `(is (results= nil (query-all t ,query))))))
 
 (defmacro should-return (&body queries)
   `(progn
@@ -37,26 +37,27 @@
                                ((equal results '(fail))
                                 nil)
                                (t results))
-                           (query-all ,query))))))
+                           (query-all t ,query))))))
 
 
 ;;;; Prolog
 (defun %= ()
-  (push-logic-frame-with
-    (fact (= ?x ?x))))
+  (push-logic-frame-with t
+    (fact t (= ?x ?x))))
 
 (defun %not ()
-  (push-logic-frame-with
-    (rule (not ?x) (call ?x) ! fail)
-    (fact (not ?x))))
+  (push-logic-frame-with t
+    (rule t (not ?x) (call ?x) ! fail)
+    (fact t (not ?x))))
+
 (defun %append ()
-  (push-logic-frame-with
-    (fact (append nil ?l ?l))
-    (rule (append (list* ?x ?rest) ?l (list* ?x ?result))
+  (push-logic-frame-with t
+    (fact t (append nil ?l ?l))
+    (rule t (append (list* ?x ?rest) ?l (list* ?x ?result))
       (append ?rest ?l ?result))))
 
 (defun %member ()
-  (push-logic-frame-with
-    (fact (member ?x (list* ?x ?)))
-    (rule (member ?x (list* ? ?rest))
+  (push-logic-frame-with t
+    (fact t (member ?x (list* ?x ?)))
+    (rule t (member ?x (list* ? ?rest))
       (member ?x ?rest))))
diff -r 38d5c4302e12 -r 837374f5256d test/wam.lisp
--- a/test/wam.lisp	Tue Aug 23 13:10:01 2016 +0000
+++ b/test/wam.lisp	Tue Aug 23 17:53:03 2016 +0000
@@ -3,53 +3,52 @@
 ;;;; Setup
 (defun make-test-database ()
   (let ((db (make-database)))
-    (with-database db
-      (push-logic-frame-with
+    (push-logic-frame-with db
 
-        (facts (always)
+      (facts db
+        (always)
 
-               (drinks tom ?anything)
-               (drinks kim water)
-               (drinks alice bourbon)
-               (drinks bob genny-cream)
-               (drinks candace birch-beer)
+        (drinks tom ?anything)
+        (drinks kim water)
+        (drinks alice bourbon)
+        (drinks bob genny-cream)
+        (drinks candace birch-beer)
 
-               (listens alice blues)
-               (listens alice jazz)
-               (listens bob blues)
-               (listens bob rock)
-               (listens candace blues)
+        (listens alice blues)
+        (listens alice jazz)
+        (listens bob blues)
+        (listens bob rock)
+        (listens candace blues)
 
-               (fuzzy cats)
+        (fuzzy cats)
 
-               (cute cats)
-               (cute snakes))
+        (cute cats)
+        (cute snakes))
 
-        (rule (pets alice ?what)
-          (cute ?what))
+      (rule db (pets alice ?what)
+        (cute ?what))
 
-        (rule (pets bob ?what)
-          (cute ?what)
-          (fuzzy ?what))
+      (rule db (pets bob ?what)
+        (cute ?what)
+        (fuzzy ?what))
 
-        (rule (pets candace ?bird)
-          (flies ?bird))
+      (rule db (pets candace ?bird)
+        (flies ?bird))
 
-        (rule (likes sally ?who)
-          (likes ?who cats)
-          (drinks ?who beer))
-
-        (facts (likes tom cats)
-               (likes alice cats)
-               (likes kim cats))
+      (rule db (likes sally ?who)
+        (likes ?who cats)
+        (drinks ?who beer))
 
-        (rule (likes kim ?who)
-          (likes ?who cats))
+      (facts db (likes tom cats)
+        (likes alice cats)
+        (likes kim cats))
 
-        (rule (narcissist ?person)
-          (likes ?person ?person)))
+      (rule db (likes kim ?who)
+        (likes ?who cats))
 
-      )
+      (rule db (narcissist ?person)
+        (likes ?person ?person)))
+
     db))
 
 (defparameter *test-database* (make-test-database))
@@ -83,21 +82,24 @@
 (define-test facts-conjunctions
   (with-database *test-database*
     (is (results= '((?who alice))
-                  (query-all (listens ?who blues)
+                  (query-all t
+                             (listens ?who blues)
                              (listens ?who jazz))))
     (is (results= '((?who alice))
-                  (query-all (listens ?who blues)
+                  (query-all t
+                             (listens ?who blues)
                              (drinks ?who bourbon))))
     (is (results= '((?what bourbon ?who alice)
                     (?what genny-cream ?who bob)
                     (?what birch-beer ?who candace))
-                  (query-all (listens ?who blues)
+                  (query-all t
+                             (listens ?who blues)
                              (drinks ?who ?what))))))
 
 (define-test simple-unification
   (with-fresh-database
-    (push-logic-frame-with
-      (rule (= ?x ?x)))
+    (push-logic-frame-with t
+      (rule t (= ?x ?x)))
     (should-return
       ((= x x) empty)
       ((= x y) fail)
@@ -110,12 +112,12 @@
 
 (define-test dynamic-call
   (with-fresh-database
-    (push-logic-frame-with
-      (facts (g cats)
-             (g (f dogs)))
-      (rule (normal ?x)
+    (push-logic-frame-with t
+      (facts t (g cats)
+        (g (f dogs)))
+      (rule t (normal ?x)
         (g ?x))
-      (rule (dynamic ?struct)
+      (rule t (dynamic ?struct)
         (call ?struct)))
     (should-return
       ((normal foo) fail)
@@ -136,11 +138,11 @@
 
 (define-test negation
   (with-fresh-database
-    (push-logic-frame-with
-      (fact (yes ?anything))
+    (push-logic-frame-with t
+      (fact t (yes ?anything))
 
-      (rule (not ?x) (call ?x) ! fail)
-      (rule (not ?x)))
+      (rule t (not ?x) (call ?x) ! fail)
+      (rule t (not ?x)))
     (should-return
       ((yes x) empty)
       ((no x) fail)
@@ -149,57 +151,57 @@
 
 (define-test backtracking
   (with-fresh-database
-    (push-logic-frame-with
-      (facts (b))
-      (facts (c))
-      (facts (d))
-      (rule (f ?x) (a))
-      (rule (f ?x) (b) (c))
-      (rule (f ?x) (d)))
+    (push-logic-frame-with t
+      (facts t (b))
+      (facts t (c))
+      (facts t (d))
+      (rule t (f ?x) (a))
+      (rule t (f ?x) (b) (c))
+      (rule t (f ?x) (d)))
     (should-return
       ((f foo) empty)))
   (with-fresh-database
-    (push-logic-frame-with
-      ; (facts (a))
-      (facts (b))
-      (facts (c))
-      (facts (d))
-      (rule (f ?x) (a))
-      (rule (f ?x) (b) (c))
-      (rule (f ?x) (d)))
+    (push-logic-frame-with t
+      ; (facts t (a))
+      (facts t (b))
+      (facts t (c))
+      (facts t (d))
+      (rule t (f ?x) (a))
+      (rule t (f ?x) (b) (c))
+      (rule t (f ?x) (d)))
     (should-return
       ((f foo) empty)))
   (with-fresh-database
-    (push-logic-frame-with
-      ; (facts (a))
-      (facts (b))
-      (facts (c))
-      ; (facts (d))
-      (rule (f ?x) (a))
-      (rule (f ?x) (b) (c))
-      (rule (f ?x) (d)))
+    (push-logic-frame-with t
+      ; (facts t (a))
+      (facts t (b))
+      (facts t (c))
+      ; (facts t (d))
+      (rule t (f ?x) (a))
+      (rule t (f ?x) (b) (c))
+      (rule t (f ?x) (d)))
     (should-return
       ((f foo) empty)))
   (with-fresh-database
-    (push-logic-frame-with
-      ; (facts (a))
-      ; (facts (b))
-      (facts (c))
-      ; (facts (d))
-      (rule (f ?x) (a))
-      (rule (f ?x) (b) (c))
-      (rule (f ?x) (d)))
+    (push-logic-frame-with t
+      ; (facts t (a))
+      ; (facts t (b))
+      (facts t (c))
+      ; (facts t (d))
+      (rule t (f ?x) (a))
+      (rule t (f ?x) (b) (c))
+      (rule t (f ?x) (d)))
     (should-return
       ((f foo) fail)))
   (with-fresh-database
-    (push-logic-frame-with
-      ; (facts (a))
-      (facts (b))
-      ; (facts (c))
-      ; (facts (d))
-      (rule (f ?x) (a))
-      (rule (f ?x) (b) (c))
-      (rule (f ?x) (d)))
+    (push-logic-frame-with t
+      ; (facts t (a))
+      (facts t (b))
+      ; (facts t (c))
+      ; (facts t (d))
+      (rule t (f ?x) (a))
+      (rule t (f ?x) (b) (c))
+      (rule t (f ?x) (d)))
     (should-return
       ((f foo) fail))))
 
@@ -234,12 +236,12 @@
 (define-test register-allocation
   ;; test for tricky register allocation bullshit
   (with-fresh-database
-    (push-logic-frame-with
-      (fact (a fact-a fact-a))
-      (fact (b fact-b fact-b))
-      (fact (c fact-c fact-c))
+    (push-logic-frame-with t
+      (fact t (a fact-a fact-a))
+      (fact t (b fact-b fact-b))
+      (fact t (c fact-c fact-c))
 
-      (rule (foo ?x)
+      (rule t (foo ?x)
         (a ?a ?a)
         (b ?b ?b)
         (c ?c ?c)))
@@ -249,9 +251,9 @@
 
 (define-test lists
   (with-fresh-database
-    (push-logic-frame-with
-      (rule (member ?x (list* ?x ?)))
-      (rule (member ?x (list* ?y ?rest))
+    (push-logic-frame-with t
+      (rule t (member ?x (list* ?x ?)))
+      (rule t (member ?x (list* ?y ?rest))
         (member ?x ?rest)))
 
     (should-fail
@@ -276,22 +278,22 @@
     ;; Check that we can unify against unbound vars that turn into lists
     (is ((lambda (result)
            (eql (car (getf result '?anything)) 'a))
-         (query (member a ?anything))))))
+         (query t (member a ?anything))))))
 
 (define-test cut
   (with-fresh-database
-    (push-logic-frame-with
-      (facts (a))
-      (facts (b))
-      (facts (c))
-      (facts (d))
+    (push-logic-frame-with t
+      (facts t (a))
+      (facts t (b))
+      (facts t (c))
+      (facts t (d))
 
-      (rule (f a) (a))
-      (rule (f bc) (b) ! (c))
-      (rule (f d) (d))
+      (rule t (f a) (a))
+      (rule t (f bc) (b) ! (c))
+      (rule t (f d) (d))
 
-      (rule (g ?what) (never))
-      (rule (g ?what) (f ?what)))
+      (rule t (g ?what) (never))
+      (rule t (g ?what) (f ?what)))
     (should-return
       ((f ?what)
        (?what a)
@@ -301,18 +303,18 @@
        (?what bc))))
 
   (with-fresh-database
-    (push-logic-frame-with
-      ; (facts (a))
-      (facts (b))
-      (facts (c))
-      (facts (d))
+    (push-logic-frame-with t
+      ; (facts t (a))
+      (facts t (b))
+      (facts t (c))
+      (facts t (d))
 
-      (rule (f a) (a))
-      (rule (f bc) (b) ! (c))
-      (rule (f d) (d))
+      (rule t (f a) (a))
+      (rule t (f bc) (b) ! (c))
+      (rule t (f d) (d))
 
-      (rule (g ?what) (never))
-      (rule (g ?what) (f ?what)))
+      (rule t (g ?what) (never))
+      (rule t (g ?what) (f ?what)))
     (should-return
       ((f ?what)
        (?what bc))
@@ -320,18 +322,18 @@
        (?what bc))))
 
   (with-fresh-database
-    (push-logic-frame-with
-      ; (facts (a))
-      ; (facts (b))
-      (facts (c))
-      (facts (d))
+    (push-logic-frame-with t
+      ; (facts t (a))
+      ; (facts t (b))
+      (facts t (c))
+      (facts t (d))
 
-      (rule (f a) (a))
-      (rule (f bc) (b) ! (c))
-      (rule (f d) (d))
+      (rule t (f a) (a))
+      (rule t (f bc) (b) ! (c))
+      (rule t (f d) (d))
 
-      (rule (g ?what) (never))
-      (rule (g ?what) (f ?what)))
+      (rule t (g ?what) (never))
+      (rule t (g ?what) (f ?what)))
     (should-return
       ((f ?what)
        (?what d))
@@ -339,50 +341,50 @@
        (?what d))))
 
   (with-fresh-database
-    (push-logic-frame-with
-      ; (facts (a))
-      (facts (b))
-      ; (facts (c))
-      (facts (d))
+    (push-logic-frame-with t
+      ; (facts t (a))
+      (facts t (b))
+      ; (facts t (c))
+      (facts t (d))
 
-      (rule (f a) (a))
-      (rule (f bc) (b) ! (c))
-      (rule (f d) (d))
+      (rule t (f a) (a))
+      (rule t (f bc) (b) ! (c))
+      (rule t (f d) (d))
 
-      (rule (g ?what) (never))
-      (rule (g ?what) (f ?what)))
+      (rule t (g ?what) (never))
+      (rule t (g ?what) (f ?what)))
     (should-fail
       (f ?what)
       (g ?what)))
 
   (with-fresh-database
-    (push-logic-frame-with
-      ; (facts (a))
-      ; (facts (b))
-      (facts (c))
-      ; (facts (d))
+    (push-logic-frame-with t
+      ; (facts t (a))
+      ; (facts t (b))
+      (facts t (c))
+      ; (facts t (d))
 
-      (rule (f a) (a))
-      (rule (f bc) (b) ! (c))
-      (rule (f d) (d))
+      (rule t (f a) (a))
+      (rule t (f bc) (b) ! (c))
+      (rule t (f d) (d))
 
-      (rule (g ?what) (never))
-      (rule (g ?what) (f ?what)))
+      (rule t (g ?what) (never))
+      (rule t (g ?what) (f ?what)))
     (should-fail
       (f ?what)
       (g ?what))))
 
 (define-test anonymous-variables
   (with-fresh-database
-    (push-logic-frame-with
-      (fact (following (s ? ? ? a)))
-      (fact (foo x))
-      (rule (bar (baz ?x ?y ?z ?thing))
+    (push-logic-frame-with t
+      (fact t (following (s ? ? ? a)))
+      (fact t (foo x))
+      (rule t (bar (baz ?x ?y ?z ?thing))
         (foo ?thing))
-      (fact (wild ? ? ?))
+      (fact t (wild ? ? ?))
 
-      (fact (does x move))
-      (rule (next z)
+      (fact t (does x move))
+      (rule t (next z)
         (does ? move)))
     (should-return
       ((following (s x x x a)) empty)
@@ -394,11 +396,11 @@
 
 (define-test normalization-ui
   (with-fresh-database
-    (push-logic-frame-with
-      (fact a)
-      (facts (b)
-             c)
-      (rule dogs
+    (push-logic-frame-with t
+      (fact t a)
+      (facts t (b)
+        c)
+      (rule t dogs
         a b (c)))
     (should-return
       (a empty)
@@ -414,8 +416,8 @@
 
 (define-test nested-constants
   (with-fresh-database
-    (push-logic-frame-with
-      (fact (foo (s a b c))))
+    (push-logic-frame-with t
+      (fact t (foo (s a b c))))
     (should-return
       ((foo (s ?x ?y ?z))
        (?x a ?y b ?z c)))))
@@ -429,27 +431,28 @@
   (let* ((big-ass-list (loop :repeat 1000 :collect 'a))
          (big-ass-result (reverse (cons 'x big-ass-list))))
     (with-fresh-database
-      (push-logic-frame-with
-        (invoke-fact `(big-ass-list (list ,@big-ass-list)))
+      (push-logic-frame-with t
+        (invoke-fact t `(big-ass-list (list ,@big-ass-list)))
 
-        (fact (append nil ?l ?l))
-        (rule (append (list* ?i ?tail) ?other (list* ?i ?l))
+        (fact t (append nil ?l ?l))
+        (rule t (append (list* ?i ?tail) ?other (list* ?i ?l))
           (append ?tail ?other ?l)))
 
       (is (results= `((?bal ,big-ass-list ?bar ,big-ass-result))
-                    (query-all (big-ass-list ?bal)
+                    (query-all t
+                               (big-ass-list ?bal)
                                (append ?bal (list x) ?bar)))))))
 
 (define-test hanoi
   ;; From The Art of Prolog
   (with-fresh-database
-    (push-logic-frame-with
-      (fact (append nil ?l ?l))
-      (rule (append (list* ?i ?tail) ?other (list* ?i ?l))
+    (push-logic-frame-with t
+      (fact t (append nil ?l ?l))
+      (rule t (append (list* ?i ?tail) ?other (list* ?i ?l))
         (append ?tail ?other ?l))
 
-      (fact (hanoi zero ?a ?b ?c nil))
-      (rule (hanoi (s ?n) ?a ?b ?c ?moves)
+      (fact t (hanoi zero ?a ?b ?c nil))
+      (rule t (hanoi (s ?n) ?a ?b ?c ?moves)
         (hanoi ?n ?a ?c ?b ?moves1)
         (hanoi ?n ?c ?b ?a ?moves2)
         (append ?moves1 (list* (move ?a ?b) ?moves2) ?moves)))
@@ -467,13 +470,13 @@
 
 (define-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)
+    (push-logic-frame-with t
+      (rule t (= ?x ?x))
+      (fact t (foo 1))
+      (fact t (bar 2))
+      (rule t (baz ?x) (foo ?x))
+      (rule t (baz ?x) (bar ?x))
+      (rule t (lol ?x)
         (foo ?x)
         (bar ?x)))