55019395ba93

--- a/examples/ggp-wam.lisp	Wed Jul 06 20:08:27 2016 +0000
+++ b/examples/ggp-wam.lisp	Wed Jul 06 20:41:56 2016 +0000
@@ -204,13 +204,13 @@
 (defun apply-state (state)
   (push-logic-frame)
   (loop :for fact :in state
-        :do (add-fact `(true ,fact)))
+        :do (invoke-fact `(true ,fact)))
   (finalize-logic-frame))
 
 (defun apply-moves (moves)
   (push-logic-frame)
   (loop :for (role . action) :in moves
-        :do (add-fact `(does ,role ,action)))
+        :do (invoke-fact `(does ,role ,action)))
   (finalize-logic-frame))
 
 

--- a/src/wam/ui.lisp	Wed Jul 06 20:08:27 2016 +0000
+++ b/src/wam/ui.lisp	Wed Jul 06 20:41:56 2016 +0000
@@ -16,9 +16,28 @@
   `(with-database (make-database) ,@body))
 
 
+;;;; Normalization
+(defun normalize-term (term)
+  ;; Normally a rule consists of a head terms and multiple body terms, like so:
+  ;;
+  ;;     (likes sally ?who) (likes ?who cats)
+  ;;
+  ;; But sometimes people are lazy and don't include the parens around
+  ;; zero-arity predicates:
+  ;;
+  ;;     (happy steve) sunny
+  (if (and (not (variablep term))
+           (symbolp term)
+           (not (eq term '!))) ; jesus
+    (list term)
+    term))
+
+
 ;;;; Assertion
 (defun invoke-rule (head &rest body)
-  (wam-logic-frame-add-clause! *database* (list* head body))
+  (wam-logic-frame-add-clause! *database*
+                               (list* (normalize-term head)
+                                      (mapcar #'normalize-term body)))
   (values))
 
 (defun invoke-fact (fact)
@@ -26,7 +45,7 @@
   (values))
 
 (defun invoke-facts (&rest facts)
-  (mapc #'add-fact facts)
+  (mapc #'invoke-fact facts)
   (values))
 
 
@@ -59,58 +78,57 @@
 
 
 ;;;; Querying
+(defun perform-query (terms result-function)
+  (run-query *database* (mapcar #'normalize-term terms)
+             :result-function result-function))
+
+
 (defun invoke-query (&rest terms)
   (let ((result nil)
         (succeeded nil))
-    (run-query *database* terms
-               :result-function (lambda (r)
-                                  (setf result r
-                                        succeeded t)
-                                  t))
+    (perform-query terms (lambda (r)
+                           (setf result r
+                                 succeeded t)
+                           t))
     (values result succeeded)))
 
 (defun invoke-query-all (&rest terms)
   (let ((results nil))
-    (run-query *database* terms
-               :result-function (lambda (result)
-                                  (push result results)
-                                  nil))
+    (perform-query terms (lambda (result)
+                           (push result results)
+                           nil))
     (nreverse results)))
 
 (defun invoke-query-map (function &rest terms)
   (let ((results nil))
-    (run-query *database* terms
-               :result-function (lambda (result)
-                                  (push (funcall function result) results)
-                                  nil))
+    (perform-query terms (lambda (result)
+                           (push (funcall function result) results)
+                           nil))
     (nreverse results)))
 
 (defun invoke-query-do (function &rest terms)
-  (run-query *database* terms
-             :result-function (lambda (result)
-                                (funcall function result)
-                                nil))
+  (perform-query terms (lambda (result)
+                         (funcall function result)
+                         nil))
   (values))
 
 (defun invoke-query-find (predicate &rest terms)
   (let ((results nil)
         (succeeded nil))
-    (run-query *database* terms
-               :result-function (lambda (result)
-                                  (if (funcall predicate result)
-                                    (progn (setf results result
-                                                 succeeded t)
-                                           t)
-                                    nil)))
+    (perform-query terms (lambda (result)
+                           (if (funcall predicate result)
+                             (progn (setf results result
+                                          succeeded t)
+                                    t)
+                             nil)))
     (values results succeeded)))
 
 (defun invoke-prove (&rest terms)
   (let ((succeeded nil))
-    (run-query *database* terms
-               :result-function (lambda (result)
-                                  (declare (ignore result))
-                                  (setf succeeded t)
-                                  t))
+    (perform-query terms (lambda (result)
+                           (declare (ignore result))
+                           (setf succeeded t)
+                           t))
     succeeded))
 
 

--- a/test/wam.lisp	Wed Jul 06 20:08:27 2016 +0000
+++ b/test/wam.lisp	Wed Jul 06 20:41:56 2016 +0000
@@ -68,14 +68,11 @@
 (defun results= (r1 r2)
   (set-equal r1 r2 :test #'result=))
 
-(defmacro q (&body query)
-  `(query-all ,@query))
-
 
 (defmacro should-fail (&body queries)
   `(progn
      ,@(loop :for query :in queries :collect
-             `(is (results= nil (q ,query))))))
+             `(is (results= nil (query-all ,query))))))
 
 (defmacro should-return (&body queries)
   `(progn
@@ -87,43 +84,47 @@
                                ((equal results '(fail))
                                 nil)
                                (t results))
-                           (q ,query))))))
+                           (query-all ,query))))))
 
 
 ;;;; Tests
 (test facts-literal
   (with-database *test-database*
-    (is (results= '(nil) (q (always))))
-    (is (results= '(nil) (q (fuzzy cats))))
-    (is (results= nil (q (fuzzy snakes))))))
+    (should-return
+      ((always) empty)
+      ((fuzzy cats) empty)
+      ((fuzzy snakes) fail))))
 
 (test facts-variables
   (with-database *test-database*
-    (is (results= '((?what cats))
-                  (q (fuzzy ?what))))
-    (is (results= '((?what blues)
-                    (?what rock))
-                  (q (listens bob ?what))))
-    (is (results= '((?who alice)
-                    (?who bob)
-                    (?who candace))
-                  (q (listens ?who blues))))
-    (is (results= '()
-                  (q (listens ?who metal))))))
+    (should-return
+      ((fuzzy ?what)
+       (?what cats))
+
+      ((listens bob ?what)
+       (?what blues)
+       (?what rock))
+
+      ((listens ?who blues)
+       (?who alice)
+       (?who bob)
+       (?who candace))
+
+      ((listens ?who metal) fail))))
 
 (test facts-conjunctions
   (with-database *test-database*
     (is (results= '((?who alice))
-                  (q (listens ?who blues)
-                     (listens ?who jazz))))
+                  (query-all (listens ?who blues)
+                             (listens ?who jazz))))
     (is (results= '((?who alice))
-                  (q (listens ?who blues)
-                     (drinks ?who bourbon))))
+                  (query-all (listens ?who blues)
+                             (drinks ?who bourbon))))
     (is (results= '((?what bourbon ?who alice)
                     (?what genny-cream ?who bob)
                     (?what birch-beer ?who candace))
-                  (q (listens ?who blues)
-                     (drinks ?who ?what))))))
+                  (query-all (listens ?who blues)
+                             (drinks ?who ?what))))))
 
 (test simple-unification
   (with-fresh-database
@@ -414,3 +415,23 @@
       ((bar (baz a b c no)) fail)
       ((bar (baz a b c ?what)) (?what x))
       ((wild a b c) empty))))
+
+(test normalization-ui
+  (with-fresh-database
+    (push-logic-frame-with
+      (fact a)
+      (facts (b)
+             c)
+      (rule dogs
+        a b (c)))
+    (should-return
+      (a empty)
+      (b empty)
+      (c empty)
+      (d fail)
+      (dogs empty)
+      ((a) empty)
+      ((b) empty)
+      ((c) empty)
+      ((d) fail)
+      (dogs empty))))