# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1463667217 0
# Node ID 83f309e6e33a3523541c98c3d90496d1f97f5811
# Parent  95d0602ff36b1cc41421727255bfc6764caf2b8a
Try out actual PAIPROLOG

diff -r 95d0602ff36b -r 83f309e6e33a examples/bench.lisp
--- a/examples/bench.lisp	Sun May 15 00:06:53 2016 +0000
+++ b/examples/bench.lisp	Thu May 19 14:13:37 2016 +0000
@@ -1,4 +1,5 @@
 (ql:quickload 'bones)
+(ql:quickload 'paiprolog)
 
 (load "examples/ggp-paip.lisp")
 (load "examples/ggp.lisp")
@@ -10,13 +11,16 @@
         (*debug-io* (make-broadcast-stream))
         (*terminal-io* (make-broadcast-stream))
         (*error-output* (make-broadcast-stream)))
-    (asdf:load-system 'bones :force t)))
+    (asdf:load-system 'bones :force t)
+    (asdf:load-system 'paiprolog :force t)
+    (load "examples/ggp-paip.lisp")
+    (load "examples/ggp.lisp")))
 
 (defun run-test ()
   (reload)
 
   (format t "PAIP ------------------------------~%")
-  (time (bones.paip::dfs-exhaust))
+  (time (paiprolog-test::dfs-exhaust))
 
   (format t "WAM -------------------------------~%")
   (time (bones.wam::dfs-exhaust)))
@@ -26,15 +30,15 @@
 ; (declaim (optimize (speed 0) (safety 3) (debug 3)))
 ; (run-test)
 
-; (format t "~%~%====================================~%")
-; (format t "(speed 3) (safety 1) (debug 1)~%")
-; (declaim (optimize (speed 3) (safety 1) (debug 1)))
-; (run-test)
+(format t "~%~%====================================~%")
+(format t "(speed 3) (safety 1) (debug 1)~%")
+(declaim (optimize (speed 3) (safety 1) (debug 1)))
+(run-test)
 
-(format t "~%~%====================================~%")
-(format t "(speed 3) (safety 1) (debug 0)~%")
-(declaim (optimize (speed 3) (safety 1) (debug 0)))
-(run-test)
+; (format t "~%~%====================================~%")
+; (format t "(speed 3) (safety 1) (debug 0)~%")
+; (declaim (optimize (speed 3) (safety 1) (debug 0)))
+; (run-test)
 
 (format t "~%~%====================================~%")
 (format t "(speed 3) (safety 0) (debug 0)~%")
diff -r 95d0602ff36b -r 83f309e6e33a examples/ggp-paip.lisp
--- a/examples/ggp-paip.lisp	Sun May 15 00:06:53 2016 +0000
+++ b/examples/ggp-paip.lisp	Thu May 19 14:13:37 2016 +0000
@@ -1,209 +1,209 @@
-(in-package #:bones.paip)
+(defpackage #:paiprolog-test
+  (:use #:cl #:paiprolog))
 
-(clear-db)
+(in-package #:paiprolog-test)
+
 
-(rule (member ?thing (cons ?thing ?rest)))
+(defvar *state* nil)
+(defvar *actions* nil)
 
-(rule (member ?thing (cons ?other ?rest))
-      (member ?thing ?rest))
+(defun paiprolog::true/1 (?thing cont)
+  (loop :with tr = (fill-pointer paiprolog::*trail*)
+        :for item :in *state*
+        :when (paiprolog::unify! ?thing item)
+        :do
+        (funcall cont)
+        (paiprolog::undo-bindings! tr)))
 
-(rule (true ?state ?thing)
-      (member ?thing ?state))
-
-(rule (does ?performed ?role ?move)
-      (member (does ?role ?move) ?performed))
+(defun paiprolog::does/1 (?action cont)
+  (loop :with tr = (fill-pointer paiprolog::*trail*)
+        :for action :in *actions*
+        :when (paiprolog::unify! ?action action)
+        :do
+        (funcall cont)
+        (paiprolog::undo-bindings! tr)))
 
-(rule (role robot))
+(<-- (member ?x (?x . ?)))
+(<- (member ?x (?y . ?rest))
+    (member ?x ?rest))
+
+(<-- (role robot))
 
-(rule (init (off p)))
-(rule (init (off q)))
-(rule (init (off r)))
-(rule (init (off s)))
-(rule (init (step num1)))
+(<-- (init (off p)))
+(<- (init (off q)))
+(<- (init (off r)))
+(<- (init (off s)))
+(<- (init (step num1)))
 
-(rule (next ?state ?performed (on p))
-      (does ?performed robot a)
-      (true ?state (off p)))
-(rule (next ?state ?performed (on q))
-      (does ?performed robot a)
-      (true ?state (on q)))
-(rule (next ?state ?performed (on r))
-      (does ?performed robot a)
-      (true ?state (on r)))
-(rule (next ?state ?performed (off p))
-      (does ?performed robot a)
-      (true ?state (on p)))
-(rule (next ?state ?performed (off q))
-      (does ?performed robot a)
-      (true ?state (off q)))
-(rule (next ?state ?performed (off r))
-      (does ?performed robot a)
-      (true ?state (off r)))
+(<-- (next (on p))
+     (does (robot a))
+     (true (off p)))
+(<- (next (on q))
+    (does (robot a))
+    (true (on q)))
+(<- (next (on r))
+    (does (robot a))
+    (true (on r)))
+(<- (next (off p))
+    (does (robot a))
+    (true (on p)))
+(<- (next (off q))
+    (does (robot a))
+    (true (off q)))
+(<- (next (off r))
+    (does (robot a))
+    (true (off r)))
 
-(rule (next ?state ?performed (on p))
-      (does ?performed robot b)
-      (true ?state (on q)))
-(rule (next ?state ?performed (on q))
-      (does ?performed robot b)
-      (true ?state (on p)))
-(rule (next ?state ?performed (on r))
-      (does ?performed robot b)
-      (true ?state (on r)))
-(rule (next ?state ?performed (off p))
-      (does ?performed robot b)
-      (true ?state (off q)))
-(rule (next ?state ?performed (off q))
-      (does ?performed robot b)
-      (true ?state (off p)))
-(rule (next ?state ?performed (off r))
-      (does ?performed robot b)
-      (true ?state (off r)))
-
-(rule (next ?state ?performed (on p))
-      (does ?performed robot c)
-      (true ?state (on p)))
-(rule (next ?state ?performed (on q))
-      (does ?performed robot c)
-      (true ?state (on r)))
-(rule (next ?state ?performed (on r))
-      (does ?performed robot c)
-      (true ?state (on q)))
-(rule (next ?state ?performed (off p))
-      (does ?performed robot c)
-      (true ?state (off p)))
-(rule (next ?state ?performed (off q))
-      (does ?performed robot c)
-      (true ?state (off r)))
-(rule (next ?state ?performed (off r))
-      (does ?performed robot c)
-      (true ?state (off q)))
+(<- (next (on p))
+    (does (robot b))
+    (true (on q)))
+(<- (next (on q))
+    (does (robot b))
+    (true (on p)))
+(<- (next (on r))
+    (does (robot b))
+    (true (on r)))
+(<- (next (off p))
+    (does (robot b))
+    (true (off q)))
+(<- (next (off q))
+    (does (robot b))
+    (true (off p)))
+(<- (next (off r))
+    (does (robot b))
+    (true (off r)))
 
-(rule (next ?state ?performed (off s))
-      (does ?performed robot a)
-      (true ?state (off s)))
-(rule (next ?state ?performed (off s))
-      (does ?performed robot b)
-      (true ?state (off s)))
-(rule (next ?state ?performed (off s))
-      (does ?performed robot c)
-      (true ?state (off s)))
-(rule (next ?state ?performed (on s))
-      (does ?performed robot a)
-      (true ?state (on s)))
-(rule (next ?state ?performed (on s))
-      (does ?performed robot b)
-      (true ?state (on s)))
-(rule (next ?state ?performed (on s))
-      (does ?performed robot c)
-      (true ?state (on s)))
-(rule (next ?state ?performed (off s))
-      (does ?performed robot d)
-      (true ?state (on s)))
-(rule (next ?state ?performed (on s))
-      (does ?performed robot d)
-      (true ?state (off s)))
+(<- (next (on p))
+    (does (robot c))
+    (true (on p)))
+(<- (next (on q))
+    (does (robot c))
+    (true (on r)))
+(<- (next (on r))
+    (does (robot c))
+    (true (on q)))
+(<- (next (off p))
+    (does (robot c))
+    (true (off p)))
+(<- (next (off q))
+    (does (robot c))
+    (true (off r)))
+(<- (next (off r))
+    (does (robot c))
+    (true (off q)))
 
-(rule (next ?state ?performed (on p))
-      (does ?performed robot d)
-      (true ?state (on p)))
-(rule (next ?state ?performed (off p))
-      (does ?performed robot d)
-      (true ?state (off p)))
+(<- (next (off s))
+    (does (robot a))
+    (true (off s)))
+(<- (next (off s))
+    (does (robot b))
+    (true (off s)))
+(<- (next (off s))
+    (does (robot c))
+    (true (off s)))
+(<- (next (on s))
+    (does (robot a))
+    (true (on s)))
+(<- (next (on s))
+    (does (robot b))
+    (true (on s)))
+(<- (next (on s))
+    (does (robot c))
+    (true (on s)))
+(<- (next (off s))
+    (does (robot d))
+    (true (on s)))
+(<- (next (on s))
+    (does (robot d))
+    (true (off s)))
 
-(rule (next ?state ?performed (on q))
-      (does ?performed robot d)
-      (true ?state (on q)))
-(rule (next ?state ?performed (off q))
-      (does ?performed robot d)
-      (true ?state (off q)))
+(<- (next (on p))
+    (does (robot d))
+    (true (on p)))
+(<- (next (off p))
+    (does (robot d))
+    (true (off p)))
 
-(rule (next ?state ?performed (on r))
-      (does ?performed robot d)
-      (true ?state (on r)))
-(rule (next ?state ?performed (off r))
-      (does ?performed robot d)
-      (true ?state (off r)))
+(<- (next (on q))
+    (does (robot d))
+    (true (on q)))
+(<- (next (off q))
+    (does (robot d))
+    (true (off q)))
 
-(rule (next ?state ?performed (step ?y))
-      (true ?state (step ?x))
-      (succ ?x ?y))
+(<- (next (on r))
+    (does (robot d))
+    (true (on r)))
+(<- (next (off r))
+    (does (robot d))
+    (true (off r)))
 
-(rule (succ num1 num2))
-(rule (succ num2 num3))
-(rule (succ num3 num4))
-(rule (succ num4 num5))
-(rule (succ num5 num6))
-(rule (succ num6 num7))
-(rule (succ num7 num8))
+(<- (next (step ?y))
+    (true (step ?x))
+    (succ ?x ?y))
+
+(<-- (succ num1 num2))
+(<- (succ num2 num3))
+(<- (succ num3 num4))
+(<- (succ num4 num5))
+(<- (succ num5 num6))
+(<- (succ num6 num7))
+(<- (succ num7 num8))
 
-(rule (legal robot a))
-(rule (legal robot b))
-(rule (legal robot c))
-(rule (legal robot d))
+(<-- (legal robot a))
+(<- (legal robot b))
+(<- (legal robot c))
+(<- (legal robot d))
 
-(rule (goal ?state robot num100)
-      (true ?state (on p))
-      (true ?state (on q))
-      (true ?state (on r))
-      (true ?state (on s)))
-(rule (goal ?state robot num0)
-      (true ?state (off p)))
-(rule (goal ?state robot num0)
-      (true ?state (off q)))
-(rule (goal ?state robot num0)
-      (true ?state (off r)))
-(rule (goal ?state robot num0)
-      (true ?state (off s)))
+(<-- (goal robot num100)
+     (true (on p))
+     (true (on q))
+     (true (on r))
+     (true (on s)))
+(<- (goal robot num0)
+    (true (off p)))
+(<- (goal robot num0)
+    (true (off q)))
+(<- (goal robot num0)
+    (true (off r)))
+(<- (goal robot num0)
+    (true (off s)))
 
-(rule (terminal ?state)
-      (true ?state (step num8)))
-(rule (terminal ?state)
-      (true ?state (on p))
-      (true ?state (on q))
-      (true ?state (on r))
-      (true ?state (on s)))
+(<-- (terminal)
+     (true (step num8)))
+(<- (terminal)
+    (true (on p))
+    (true (on q))
+    (true (on r))
+    (true (on s)))
+
+(<-- (lol 1))
 
 
 (defvar *count* 0)
 
-(defun extract (key results)
-  (mapcar (lambda (result) (cdr (assoc key result))) results))
-
-(defun to-fake-list (l)
-  (if (null l)
-    'nil
-    `(cons ,(car l) ,(to-fake-list (cdr l)))))
+(defun initial-state ()
+  (prolog-collect (?what) (init ?what)))
 
 
-(defun initial-state ()
-  (to-fake-list
-    (extract '?what (return-all (init ?what)))))
-
-(defun terminalp (state)
-  (raw-provable-p `(terminal ,state)))
+(defun terminalp ()
+  (not (null (prolog-first (?lol)
+                           (terminal)
+                           (lol ?lol)))))
 
 (defun legal-moves (state)
   (declare (ignore state))
-  (return-all (legal ?role ?move)))
+  (prolog-collect (?role ?move) (legal ?role ?move)))
 
 (defun roles ()
-  (extract '?role (return-all (role ?role))))
-
-(defun goal-value (state role)
-  (cdr (assoc '?goal
-              (raw-return-one `(goal ,state ,role ?goal)))))
-
-(defun goal-values (state)
-  (raw-return-all `(goal ,state ?role ?goal)))
+  (prolog-collect (?role) (role ?role)))
 
-(defun next-state (current-state move)
-  (let ((does (to-fake-list `((does
-                                ,(cdr (assoc '?role move))
-                                ,(cdr (assoc '?move move)))))))
-    (to-fake-list
-      (extract
-        '?what
-        (raw-return-all `(next ,current-state ,does ?what))))))
+(defun goal-value ()
+  (prolog-first (?goal) (goal robot ?goal)))
+
+(defun next-state (move)
+  (setf *actions* (list move))
+  (prolog-collect (?what) (next ?what)))
 
 
 (defstruct search-path state (path nil) (previous nil))
@@ -227,16 +227,17 @@
 
 
 (defun buttons-goal-p (search-path)
-  (let ((state (search-path-state search-path)))
-    (and (terminalp state)
-         (eql (goal-value state 'robot) 'num100))))
+  (setf *state* (search-path-state search-path))
+  (and (terminalp)
+       (eql (goal-value) 'num100)))
 
 (defun buttons-children (search-path)
   (let ((state (search-path-state search-path))
         (path (search-path-path search-path)))
-    (when (not (terminalp state))
+    (setf *state* state)
+    (when (not (terminalp))
       (loop :for move :in (legal-moves state)
-            :collect (make-search-path :state (next-state state move)
+            :collect (make-search-path :state (next-state move)
                                        :path (cons move path)
                                        :previous search-path)))))
 
@@ -257,7 +258,7 @@
                      #'never
                      #'buttons-children
                      #'append)
-        (format t "Searched ~D nodes.~%" *count*))))
+      (format t "Searched ~D nodes.~%" *count*))))
 
 (defun bfs ()
   (tree-search (list (make-search-path :state (initial-state)))
@@ -266,9 +267,15 @@
                (lambda (x y)
                  (append y x))))
 
-; (sb-sprof:with-profiling
-;     (:report :flat
-;      :sample-interval 0.001
-;      :loop nil)
-;   (dfs-exhaust)
-;   )
+
+(declaim (sb-ext:muffle-conditions sb-ext:compiler-note))
+
+#+no
+(progn
+  (require :sb-sprof)
+  (sb-sprof:with-profiling (:max-samples 10000
+                            :sample-interval 0.01
+                            :loop nil)
+    (dfs-exhaust))
+
+  (sb-sprof:report :type :flat :max 100))