# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1458302976 0
# Node ID ae2b13a9a629dfd85d87e1c5838a63ed24fc712e
# Parent  d280326feecc5be3cde19be762ff801e709b227c
Improve the testing infrastructure, rename find-all

diff -r d280326feecc -r ae2b13a9a629 examples/zebra.lisp
--- a/examples/zebra.lisp	Mon Mar 14 23:01:26 2016 +0000
+++ b/examples/zebra.lisp	Fri Mar 18 12:09:36 2016 +0000
@@ -50,5 +50,5 @@
  (member (house ?water-drinker ? ? water ?) ?houses)
  (member (house ?zebra-owner zebra ? ? ?) ?houses))
 
-(time
-  (query-all (zebra ?houses ?water ?zebra)))
+(time (query-all (zebra ?houses ?water ?zebra)))
+; (declaim (optimize (speed 3) (safety 0)))
diff -r d280326feecc -r ae2b13a9a629 package.lisp
--- a/package.lisp	Mon Mar 14 23:01:26 2016 +0000
+++ b/package.lisp	Fri Mar 18 12:09:36 2016 +0000
@@ -4,10 +4,25 @@
 
 (defpackage #:bones.paip
   (:use #:cl #:defstar #:bones.utils)
-  (:export #:unify
-           #:fail #:no-bindings
-           #:*check-occurs*
-           #:clear-db
-           #:fact #:rule
-           #:find-all #:query))
+  (:export
+
+   ;; Unification, constants
+   #:unify
+   #:fail #:no-bindings
+   #:*check-occurs*
 
+   ;; Database management
+   #:clear-db
+   #:fact
+   #:rule
+
+   ;; Lisp data structures as results
+   #:return-one
+   #:return-all
+
+   ;; Interactive queries
+   #:query
+   #:query-one
+   #:query-all
+   ))
+
diff -r d280326feecc -r ae2b13a9a629 src/paip.lisp
--- a/src/paip.lisp	Mon Mar 14 23:01:26 2016 +0000
+++ b/src/paip.lisp	Fri Mar 18 12:09:36 2016 +0000
@@ -221,6 +221,8 @@
   (cond
    ((wildcard-variable-p form) (gensym "?"))
    ((atom form) form)
+   ((consp form) (cons (replace-wildcard-variables (car form))
+                       (replace-wildcard-variables (cdr form))))
    (t (mapcar #'replace-wildcard-variables form))))
 
 
@@ -312,10 +314,10 @@
   (case (read-char)
     (#\; t)
     (#\. nil)
-    (#\newline (continue-p))
+    (#\newline (continue-ask))
     (otherwise
       (format t " Type ; to see more or . to stop")
-      (continue-p))))
+      (continue-ask))))
 
 
 (defun show-prolog-vars (variables bindings other-goals continue-p)
@@ -369,17 +371,17 @@
 (defparameter *results* nil)
 
 
-(defun find-one-result (variables bindings other-goals)
+(defun return-one-result (variables bindings other-goals)
   (setf *results* (clean-variables variables bindings))
   (prove-all other-goals bindings))
 
-(defun find-all-results (variables bindings other-goals)
+(defun return-all-results (variables bindings other-goals)
   (declare (ignore other-goals))
   (push (clean-variables variables bindings) *results*)
   fail)
 
-(setf (get 'find-one-result clause-key) 'find-one-result)
-(setf (get 'find-all-results clause-key) 'find-all-results)
+(setf (get 'return-one-result clause-key) 'return-one-result)
+(setf (get 'return-all-results clause-key) 'return-all-results)
 
 
 (defun top-level-find (goals primitive)
@@ -391,9 +393,9 @@
     *results*))
 
 
-(defmacro find-one (&rest goals)
-  `(top-level-find ',goals 'find-one-result))
+(defmacro return-one (&rest goals)
+  `(top-level-find ',goals 'return-one-result))
 
-(defmacro find-all (&rest goals)
-  `(top-level-find ',goals 'find-all-results))
+(defmacro return-all (&rest goals)
+  `(top-level-find ',goals 'return-all-results))
 
diff -r d280326feecc -r ae2b13a9a629 test/paip.lisp
--- a/test/paip.lisp	Mon Mar 14 23:01:26 2016 +0000
+++ b/test/paip.lisp	Fri Mar 18 12:09:36 2016 +0000
@@ -26,15 +26,16 @@
 
 
 (defmacro proves (query)
-  `(is-true (find-all ,query)))
+  `(is-true (return-all ,query)))
 
 (defmacro not-proves (query)
-  `(is-false (find-all ,query)))
+  `(is-false (return-all ,query)))
 
 (defmacro proves-with (query results)
-  `(is (set-equal ',results (find-all ,query)
+  `(is (set-equal ',results (return-all ,query)
                   :test #'alist-equal)))
 
+
 ;;;; Unification
 (test constant-unification
   (unifies 1 1 no-bindings)
diff -r d280326feecc -r ae2b13a9a629 test/run.lisp
--- a/test/run.lisp	Mon Mar 14 23:01:26 2016 +0000
+++ b/test/run.lisp	Fri Mar 18 12:09:36 2016 +0000
@@ -2,5 +2,15 @@
   (ql:quickload "bones-test"))
 
 
-(5am:run! :bones)
-(5am:run! :bones.paip)
+(defvar *passed* t)
+
+(defun test (spec)
+  (let ((result (5am:run spec)))
+    (5am:explain! result)
+    (when (not (5am:results-status result))
+      (setf *passed* nil))))
+
+(test :bones)
+(test :bones.paip)
+
+(sb-ext:exit :code (if *passed* 0 1))