# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1461331661 0
# Node ID 53d629a6aa6988a51dc4dd7e3c4c7ee0cecd215a
# Parent  79abff72987dfc9a8f4866a0f55d22b6388dc538
Add done-thunk and use it for query interaction

Also adds `fact` convenience wrappers.

diff -r 79abff72987d -r 53d629a6aa69 src/wam/ui.lisp
--- a/src/wam/ui.lisp	Fri Apr 22 12:39:36 2016 +0000
+++ b/src/wam/ui.lisp	Fri Apr 22 13:27:41 2016 +0000
@@ -8,25 +8,63 @@
      ,@body))
 
 
-
 (defun add-rules (rules)
   (compile-rules *database* rules))
 
-(defun perform-query (query step)
-  (run-query *database* query step))
-
 
 (defmacro rule (&body body)
   `(add-rules '(,body)))
 
+(defmacro fact (&body body)
+  `(add-rules '(,body)))
+
 (defmacro rules (&body rules)
   `(add-rules ',rules))
 
-(defmacro query (&body body)
-  `(perform-query ',body nil))
+(defmacro facts (&body rules)
+  `(add-rules ',(mapcar #'list rules)))
+
+
+(defun display-results (results)
+  (format t "~%")
+  (loop :for (var . result) :in results :do
+        (format t "~S = ~S~%" var result)))
+
+(defun result-one (results)
+  (display-results results)
+  t)
+
+(defun result-all (results)
+  (display-results results)
+  nil)
 
-(defmacro query-step (&body body)
-  `(perform-query ',body t))
+(defun result-interactive (results)
+  (display-results results)
+  (format t "~%More? [Yn] ")
+  (force-output)
+  (switch ((read-line) :test #'string=)
+    ("y" nil)
+    ("" nil)
+    ("n" t)
+    (t t)))
+
+
+(defun perform-query (query mode)
+  (run-query *database* query
+             (ecase mode
+               (:interactive #'result-interactive)
+               (:all #'result-all)
+               (:one #'result-one))))
+
+
+(defmacro query (&body body)
+  `(perform-query ',body :interactive))
+
+(defmacro query-all (&body body)
+  `(perform-query ',body :all))
+
+(defmacro query-one (&body body)
+  `(perform-query ',body :one))
 
 
 (defun dump (&optional full-code)
diff -r 79abff72987d -r 53d629a6aa69 src/wam/vm.lisp
--- a/src/wam/vm.lisp	Fri Apr 22 12:39:36 2016 +0000
+++ b/src/wam/vm.lisp	Fri Apr 22 13:27:41 2016 +0000
@@ -3,6 +3,7 @@
 
 ;;;; Config
 (defparameter *break-on-fail* nil)
+(defparameter *step* nil)
 
 
 ;;;; Utilities
@@ -526,12 +527,8 @@
          (results (extract-things wam addresses)))
     (pairlis vars results)))
 
-(defun print-query-results (results)
-  (loop :for (var . result) :in results :do
-        (format t "~S = ~S~%" var result)))
 
-
-(defun run (wam &optional (step nil))
+(defun run (wam done-thunk)
   (with-slots (code program-counter fail backtrack) wam
     (macrolet ((instruction (inst args)
                  `(instruction-call wam ,inst code program-counter ,args)))
@@ -541,7 +538,7 @@
         :for opcode = (aref code program-counter)
         :do
         (block op
-          (when step
+          (when *step*
             (dump) ; todo: make this saner
             (break "About to execute instruction at ~4,'0X" program-counter))
           (eswitch (opcode)
@@ -583,7 +580,9 @@
               (instruction %call 1)
               (return-from op))
             (+opcode-done+
-              (return-from run)))
+              (if (funcall done-thunk)
+                (return-from run)
+                (backtrack! wam "done-function returned false"))))
           ;; Only increment the PC when we didn't backtrack
           (if (wam-backtracked wam)
             (setf (wam-backtracked wam) nil)
@@ -592,12 +591,12 @@
             (error "Fell off the end of the program code store!")))))
     (values)))
 
-(defun run-query (wam term &optional (step nil))
+(defun run-query (wam term result-function)
   "Compile query `term` and run the instructions on the `wam`.
 
   Resets the heap, etc before running.
 
-  When `step` is true, break into the debugger before calling the procedure and
+  When `*step*` is true, break into the debugger before calling the procedure and
   after each instruction.
 
   "
@@ -607,15 +606,15 @@
     (wam-load-query-code! wam code)
     (setf (wam-program-counter wam) 0
           (wam-continuation-pointer wam) +code-sentinal+)
-    (when step
+    (when *step*
       (format *debug-io* "Built query code:~%")
       (dump-code-store wam code))
-    (run wam step)
+    (run wam (lambda ()
+               (funcall result-function
+                        (extract-query-results wam vars))))
     (if (wam-fail wam)
       (princ "No.")
-      (progn
-        (print-query-results (extract-query-results wam vars))
-        (princ "Yes."))))
+      (princ "Yes.")))
   (values))