# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1464863789 0
# Node ID a696be29e83002aece28b7249a14fc591e61f841
# Parent  83f309e6e33a3523541c98c3d90496d1f97f5811
Update benchmarks a bit

diff -r 83f309e6e33a -r a696be29e830 examples/bench.lisp
--- a/examples/bench.lisp	Thu May 19 14:13:37 2016 +0000
+++ b/examples/bench.lisp	Thu Jun 02 10:36:29 2016 +0000
@@ -1,8 +1,9 @@
 (ql:quickload 'bones)
 (ql:quickload 'paiprolog)
 
-(load "examples/ggp-paip.lisp")
-(load "examples/ggp.lisp")
+(load "examples/ggp-paip-compiled.lisp")
+(load "examples/ggp-paip-interpreted.lisp")
+(load "examples/ggp-wam.lisp")
 
 (in-package :bones)
 
@@ -13,34 +14,28 @@
         (*error-output* (make-broadcast-stream)))
     (asdf:load-system 'bones :force t)
     (asdf:load-system 'paiprolog :force t)
-    (load "examples/ggp-paip.lisp")
-    (load "examples/ggp.lisp")))
+    (load "examples/ggp-paip-compiled.lisp")
+    (load "examples/ggp-paip-interpreted.lisp")
+    (load "examples/ggp-wam.lisp")))
 
-(defun run-test ()
-  (reload)
-
-  (format t "PAIP ------------------------------~%")
+(defun run-test% ()
+  (format t "PAIP (Compiled) --------------------~%")
   (time (paiprolog-test::dfs-exhaust))
 
-  (format t "WAM -------------------------------~%")
+  (format t "PAIP (Interpreted) -----------------~%")
+  (time (bones.paip::dfs-exhaust))
+
+  (format t "WAM --------------------------------~%")
   (time (bones.wam::dfs-exhaust)))
 
-; (format t "~%~%====================================~%")
-; (format t "(speed 0) (safety 3) (debug 3)~%")
-; (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)
+(defmacro run-test (&rest settings)
+  `(progn
+    (declaim (optimize ,@settings))
+    (format t "~%~%========================================================~%")
+    (format t "~S~%" ',settings)
+    (format t "--------------------------------------------------------~%")
+    (reload)
+    (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)~%")
-(declaim (optimize (speed 3) (safety 0) (debug 0)))
-(run-test)
+(run-test (speed 3) (safety 1) (debug 1))
+(run-test (speed 3) (safety 0) (debug 0))
diff -r 83f309e6e33a -r a696be29e830 examples/ggp-paip-compiled.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/ggp-paip-compiled.lisp	Thu Jun 02 10:36:29 2016 +0000
@@ -0,0 +1,281 @@
+(defpackage #:paiprolog-test
+  (:use #:cl #:paiprolog))
+
+(in-package #:paiprolog-test)
+
+
+(defvar *state* nil)
+(defvar *actions* nil)
+
+(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)))
+
+(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)))
+
+(<-- (member ?x (?x . ?)))
+(<- (member ?x (?y . ?rest))
+    (member ?x ?rest))
+
+(<-- (role robot))
+
+(<-- (init (off p)))
+(<- (init (off q)))
+(<- (init (off r)))
+(<- (init (off s)))
+(<- (init (step num1)))
+
+(<-- (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)))
+
+(<- (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)))
+
+(<- (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)))
+
+(<- (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)))
+
+(<- (next (on p))
+    (does (robot d))
+    (true (on p)))
+(<- (next (off p))
+    (does (robot d))
+    (true (off p)))
+
+(<- (next (on q))
+    (does (robot d))
+    (true (on q)))
+(<- (next (off q))
+    (does (robot d))
+    (true (off q)))
+
+(<- (next (on r))
+    (does (robot d))
+    (true (on r)))
+(<- (next (off r))
+    (does (robot d))
+    (true (off r)))
+
+(<- (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))
+
+(<-- (legal robot a))
+(<- (legal robot b))
+(<- (legal robot c))
+(<- (legal robot d))
+
+(<-- (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)))
+
+(<-- (terminal)
+     (true (step num8)))
+(<- (terminal)
+    (true (on p))
+    (true (on q))
+    (true (on r))
+    (true (on s)))
+
+(<-- (lol 1))
+
+
+(defvar *count* 0)
+
+(defun initial-state ()
+  (prolog-collect (?what) (init ?what)))
+
+
+(defun terminalp ()
+  (not (null (prolog-first (?lol)
+                           (terminal)
+                           (lol ?lol)))))
+
+(defun legal-moves (state)
+  (declare (ignore state))
+  (prolog-collect (?role ?move) (legal ?role ?move)))
+
+(defun roles ()
+  (prolog-collect (?role) (role ?role)))
+
+(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))
+
+(defun tree-search (states goal-p children combine)
+  (labels
+      ((recur (states)
+         (if (null states)
+           nil
+           (destructuring-bind (state . remaining) states
+             (incf *count*)
+             ; (format t "Searching: ~S (~D remaining)~%" state (length remaining))
+             (if (funcall goal-p state)
+               state
+               (recur (funcall combine
+                               (funcall children state)
+                               remaining)))))))
+    (let ((result (recur states)))
+      (when result
+        (reverse (search-path-path result))))))
+
+
+(defun buttons-goal-p (search-path)
+  (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)))
+    (setf *state* state)
+    (when (not (terminalp))
+      (loop :for move :in (legal-moves state)
+            :collect (make-search-path :state (next-state move)
+                                       :path (cons move path)
+                                       :previous search-path)))))
+
+(defun never (&rest args)
+  (declare (ignore args))
+  nil)
+
+(defun dfs ()
+  (tree-search (list (make-search-path :state (initial-state)))
+               #'buttons-goal-p
+               #'buttons-children
+               #'append))
+
+(defun dfs-exhaust ()
+  (let ((*count* 0))
+    (prog1
+        (tree-search (list (make-search-path :state (initial-state)))
+                     #'never
+                     #'buttons-children
+                     #'append)
+      (format t "Searched ~D nodes.~%" *count*))))
+
+(defun bfs ()
+  (tree-search (list (make-search-path :state (initial-state)))
+               #'buttons-goal-p
+               #'buttons-children
+               (lambda (x y)
+                 (append y x))))
+
+
+(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))
diff -r 83f309e6e33a -r a696be29e830 examples/ggp-paip-interpreted.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/ggp-paip-interpreted.lisp	Thu Jun 02 10:36:29 2016 +0000
@@ -0,0 +1,274 @@
+(in-package #:bones.paip)
+
+(clear-db)
+
+(rule (member ?thing (cons ?thing ?rest)))
+
+(rule (member ?thing (cons ?other ?rest))
+      (member ?thing ?rest))
+
+(rule (true ?state ?thing)
+      (member ?thing ?state))
+
+(rule (does ?performed ?role ?move)
+      (member (does ?role ?move) ?performed))
+
+(rule (role robot))
+
+(rule (init (off p)))
+(rule (init (off q)))
+(rule (init (off r)))
+(rule (init (off s)))
+(rule (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)))
+
+(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)))
+
+(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)))
+
+(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)))
+
+(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)))
+
+(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)))
+
+(rule (next ?state ?performed (step ?y))
+      (true ?state (step ?x))
+      (succ ?x ?y))
+
+(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))
+
+(rule (legal robot a))
+(rule (legal robot b))
+(rule (legal robot c))
+(rule (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)))
+
+(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)))
+
+
+(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 ()
+  (to-fake-list
+    (extract '?what (return-all (init ?what)))))
+
+(defun terminalp (state)
+  (raw-provable-p `(terminal ,state)))
+
+(defun legal-moves (state)
+  (declare (ignore state))
+  (return-all (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)))
+
+(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))))))
+
+
+(defstruct search-path state (path nil) (previous nil))
+
+(defun tree-search (states goal-p children combine)
+  (labels
+      ((recur (states)
+         (if (null states)
+           nil
+           (destructuring-bind (state . remaining) states
+             (incf *count*)
+             ; (format t "Searching: ~S (~D remaining)~%" state (length remaining))
+             (if (funcall goal-p state)
+               state
+               (recur (funcall combine
+                               (funcall children state)
+                               remaining)))))))
+    (let ((result (recur states)))
+      (when result
+        (reverse (search-path-path result))))))
+
+
+(defun buttons-goal-p (search-path)
+  (let ((state (search-path-state search-path)))
+    (and (terminalp state)
+         (eql (goal-value state 'robot) 'num100))))
+
+(defun buttons-children (search-path)
+  (let ((state (search-path-state search-path))
+        (path (search-path-path search-path)))
+    (when (not (terminalp state))
+      (loop :for move :in (legal-moves state)
+            :collect (make-search-path :state (next-state state move)
+                                       :path (cons move path)
+                                       :previous search-path)))))
+
+(defun never (&rest args)
+  (declare (ignore args))
+  nil)
+
+(defun dfs ()
+  (tree-search (list (make-search-path :state (initial-state)))
+               #'buttons-goal-p
+               #'buttons-children
+               #'append))
+
+(defun dfs-exhaust ()
+  (let ((*count* 0))
+    (prog1
+        (tree-search (list (make-search-path :state (initial-state)))
+                     #'never
+                     #'buttons-children
+                     #'append)
+        (format t "Searched ~D nodes.~%" *count*))))
+
+(defun bfs ()
+  (tree-search (list (make-search-path :state (initial-state)))
+               #'buttons-goal-p
+               #'buttons-children
+               (lambda (x y)
+                 (append y x))))
+
+; (sb-sprof:with-profiling
+;     (:report :flat
+;      :sample-interval 0.001
+;      :loop nil)
+;   (dfs-exhaust)
+;   )
diff -r 83f309e6e33a -r a696be29e830 examples/ggp-paip.lisp
--- a/examples/ggp-paip.lisp	Thu May 19 14:13:37 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,281 +0,0 @@
-(defpackage #:paiprolog-test
-  (:use #:cl #:paiprolog))
-
-(in-package #:paiprolog-test)
-
-
-(defvar *state* nil)
-(defvar *actions* nil)
-
-(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)))
-
-(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)))
-
-(<-- (member ?x (?x . ?)))
-(<- (member ?x (?y . ?rest))
-    (member ?x ?rest))
-
-(<-- (role robot))
-
-(<-- (init (off p)))
-(<- (init (off q)))
-(<- (init (off r)))
-(<- (init (off s)))
-(<- (init (step num1)))
-
-(<-- (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)))
-
-(<- (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)))
-
-(<- (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)))
-
-(<- (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)))
-
-(<- (next (on p))
-    (does (robot d))
-    (true (on p)))
-(<- (next (off p))
-    (does (robot d))
-    (true (off p)))
-
-(<- (next (on q))
-    (does (robot d))
-    (true (on q)))
-(<- (next (off q))
-    (does (robot d))
-    (true (off q)))
-
-(<- (next (on r))
-    (does (robot d))
-    (true (on r)))
-(<- (next (off r))
-    (does (robot d))
-    (true (off r)))
-
-(<- (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))
-
-(<-- (legal robot a))
-(<- (legal robot b))
-(<- (legal robot c))
-(<- (legal robot d))
-
-(<-- (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)))
-
-(<-- (terminal)
-     (true (step num8)))
-(<- (terminal)
-    (true (on p))
-    (true (on q))
-    (true (on r))
-    (true (on s)))
-
-(<-- (lol 1))
-
-
-(defvar *count* 0)
-
-(defun initial-state ()
-  (prolog-collect (?what) (init ?what)))
-
-
-(defun terminalp ()
-  (not (null (prolog-first (?lol)
-                           (terminal)
-                           (lol ?lol)))))
-
-(defun legal-moves (state)
-  (declare (ignore state))
-  (prolog-collect (?role ?move) (legal ?role ?move)))
-
-(defun roles ()
-  (prolog-collect (?role) (role ?role)))
-
-(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))
-
-(defun tree-search (states goal-p children combine)
-  (labels
-      ((recur (states)
-         (if (null states)
-           nil
-           (destructuring-bind (state . remaining) states
-             (incf *count*)
-             ; (format t "Searching: ~S (~D remaining)~%" state (length remaining))
-             (if (funcall goal-p state)
-               state
-               (recur (funcall combine
-                               (funcall children state)
-                               remaining)))))))
-    (let ((result (recur states)))
-      (when result
-        (reverse (search-path-path result))))))
-
-
-(defun buttons-goal-p (search-path)
-  (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)))
-    (setf *state* state)
-    (when (not (terminalp))
-      (loop :for move :in (legal-moves state)
-            :collect (make-search-path :state (next-state move)
-                                       :path (cons move path)
-                                       :previous search-path)))))
-
-(defun never (&rest args)
-  (declare (ignore args))
-  nil)
-
-(defun dfs ()
-  (tree-search (list (make-search-path :state (initial-state)))
-               #'buttons-goal-p
-               #'buttons-children
-               #'append))
-
-(defun dfs-exhaust ()
-  (let ((*count* 0))
-    (prog1
-        (tree-search (list (make-search-path :state (initial-state)))
-                     #'never
-                     #'buttons-children
-                     #'append)
-      (format t "Searched ~D nodes.~%" *count*))))
-
-(defun bfs ()
-  (tree-search (list (make-search-path :state (initial-state)))
-               #'buttons-goal-p
-               #'buttons-children
-               (lambda (x y)
-                 (append y x))))
-
-
-(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))
diff -r 83f309e6e33a -r a696be29e830 examples/ggp-wam.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/ggp-wam.lisp	Thu Jun 02 10:36:29 2016 +0000
@@ -0,0 +1,285 @@
+(in-package #:bones.wam)
+
+(defparameter *d* (make-database))
+
+(with-database *d*
+  (rules ((member :thing (cons :thing :rest)))
+         ((member :thing (cons :other :rest))
+          (member :thing :rest)))
+
+  (rule (true :state :thing)
+        (member :thing :state))
+
+  (rule (does :performed :role :move)
+        (member (does :role :move) :performed))
+
+  (fact (role robot))
+
+  (facts (init (off p))
+         (init (off q))
+         (init (off r))
+         (init (off s))
+         (init (step num1))))
+
+(with-database *d*
+  (rules ((next :state :performed (on p))
+          (does :performed robot a)
+          (true :state (off p)))
+         ((next :state :performed (on q))
+          (does :performed robot a)
+          (true :state (on q)))
+         ((next :state :performed (on r))
+          (does :performed robot a)
+          (true :state (on r)))
+         ((next :state :performed (off p))
+          (does :performed robot a)
+          (true :state (on p)))
+         ((next :state :performed (off q))
+          (does :performed robot a)
+          (true :state (off q)))
+         ((next :state :performed (off r))
+          (does :performed robot a)
+          (true :state (off r)))
+
+         ((next :state :performed (on p))
+          (does :performed robot b)
+          (true :state (on q)))
+         ((next :state :performed (on q))
+          (does :performed robot b)
+          (true :state (on p)))
+         ((next :state :performed (on r))
+          (does :performed robot b)
+          (true :state (on r)))
+         ((next :state :performed (off p))
+          (does :performed robot b)
+          (true :state (off q)))
+         ((next :state :performed (off q))
+          (does :performed robot b)
+          (true :state (off p)))
+         ((next :state :performed (off r))
+          (does :performed robot b)
+          (true :state (off r)))
+
+         ((next :state :performed (on p))
+          (does :performed robot c)
+          (true :state (on p)))
+         ((next :state :performed (on q))
+          (does :performed robot c)
+          (true :state (on r)))
+         ((next :state :performed (on r))
+          (does :performed robot c)
+          (true :state (on q)))
+         ((next :state :performed (off p))
+          (does :performed robot c)
+          (true :state (off p)))
+         ((next :state :performed (off q))
+          (does :performed robot c)
+          (true :state (off r)))
+         ((next :state :performed (off r))
+          (does :performed robot c)
+          (true :state (off q)))
+
+         ((next :state :performed (off s))
+          (does :performed robot a)
+          (true :state (off s)))
+         ((next :state :performed (off s))
+          (does :performed robot b)
+          (true :state (off s)))
+         ((next :state :performed (off s))
+          (does :performed robot c)
+          (true :state (off s)))
+         ((next :state :performed (on s))
+          (does :performed robot a)
+          (true :state (on s)))
+         ((next :state :performed (on s))
+          (does :performed robot b)
+          (true :state (on s)))
+         ((next :state :performed (on s))
+          (does :performed robot c)
+          (true :state (on s)))
+         ((next :state :performed (off s))
+          (does :performed robot d)
+          (true :state (on s)))
+         ((next :state :performed (on s))
+          (does :performed robot d)
+          (true :state (off s)))
+
+         ((next :state :performed (on p))
+          (does :performed robot d)
+          (true :state (on p)))
+         ((next :state :performed (off p))
+          (does :performed robot d)
+          (true :state (off p)))
+
+         ((next :state :performed (on q))
+          (does :performed robot d)
+          (true :state (on q)))
+         ((next :state :performed (off q))
+          (does :performed robot d)
+          (true :state (off q)))
+
+         ((next :state :performed (on r))
+          (does :performed robot d)
+          (true :state (on r)))
+         ((next :state :performed (off r))
+          (does :performed robot d)
+          (true :state (off r)))
+
+         ((next :state :performed (step :y))
+          (true :state (step :x))
+          (succ :x :y))))
+
+(with-database *d*
+  (facts (succ num1 num2)
+         (succ num2 num3)
+         (succ num3 num4)
+         (succ num4 num5)
+         (succ num5 num6)
+         (succ num6 num7)
+         (succ num7 num8))
+
+  (facts (legal robot a)
+         (legal robot b)
+         (legal robot c)
+         (legal robot d)))
+
+(with-database *d*
+  (rules ((goal :state robot num100)
+          (true :state (on p))
+          (true :state (on q))
+          (true :state (on r))
+          (true :state (on s))
+          )
+         ((goal :state robot num0)
+          (true :state (off p)))
+         ((goal :state robot num0)
+          (true :state (off q)))
+         ((goal :state robot num0)
+          (true :state (off r)))
+         ((goal :state robot num0)
+          (true :state (off s)))
+         )
+
+  (rules ((terminal :state)
+          (true :state (step num8)))
+         ((terminal :state)
+          (true :state (on p))
+          (true :state (on q))
+          (true :state (on r))
+          (true :state (on s))
+          )))
+
+
+(defun extract (key results)
+  (mapcar (lambda (result) (getf result key)) results))
+
+(defun to-fake-list (l)
+  (if (null l)
+    'nil
+    `(cons ,(car l) ,(to-fake-list (cdr l)))))
+
+(defun initial-state ()
+  (to-fake-list
+    (with-database *d*
+      (extract :what (return-all (init :what))))))
+
+(defun terminalp (state)
+  (with-database *d*
+    (perform-prove `((terminal ,state)))))
+
+(defun legal-moves (state)
+  (declare (ignore state))
+  (with-database *d*
+    (return-all (legal :role :move))))
+
+(defun roles ()
+  (with-database *d*
+    (extract :role (return-all (role :role)))))
+
+(defun goal-value (state role)
+  (with-database *d*
+    (getf (perform-return `((goal ,state ,role :goal)) :one) :goal)))
+
+(defun goal-values (state)
+  (with-database *d*
+    (perform-return `((goal ,state :role :goal)) :all)))
+
+(defun next-state (current-state move)
+  (let ((does (to-fake-list `((does
+                                ,(getf move :role)
+                                ,(getf move :move))))))
+    (with-database *d*
+      (to-fake-list
+        (extract :what
+               (perform-return `((next ,current-state ,does :what)) :all))))))
+
+
+
+(defvar *count* 0)
+
+(defstruct search-path state (path nil) (previous nil))
+
+(defun tree-search (states goal-p children combine)
+  (labels
+      ((recur (states)
+         (if (null states)
+           nil
+           (destructuring-bind (state . remaining) states
+             (incf *count*)
+             ; (format t "Searching: ~S (~D remaining)~%" state (length remaining))
+             (if (funcall goal-p state)
+               state
+               (recur (funcall combine
+                               (funcall children state)
+                               remaining)))))))
+    (let ((result (recur states)))
+      (when result
+        (reverse (search-path-path result))))))
+
+
+(defun buttons-goal-p (search-path)
+  (let ((state (search-path-state search-path)))
+    (and (terminalp state)
+         (eql (goal-value state 'robot) 'num100))))
+
+(defun buttons-children (search-path)
+  (let ((state (search-path-state search-path))
+        (path (search-path-path search-path)))
+    (when (not (terminalp state))
+      (loop :for move :in (legal-moves state)
+            :collect (make-search-path :state (next-state state move)
+                                       :path (cons move path)
+                                       :previous search-path)))))
+
+(defun never (&rest args)
+  (declare (ignore args))
+  nil)
+
+(defun dfs ()
+  (tree-search (list (make-search-path :state (initial-state)))
+               #'buttons-goal-p
+               #'buttons-children
+               #'append))
+
+(defun dfs-exhaust ()
+  (let ((*count* 0))
+    (prog1
+        (tree-search (list (make-search-path :state (initial-state)))
+                     #'never
+                     #'buttons-children
+                     #'append)
+      (format t "Searched ~D nodes.~%" *count*))))
+
+(defun bfs ()
+  (tree-search (list (make-search-path :state (initial-state)))
+               #'buttons-goal-p
+               #'buttons-children
+               (lambda (x y)
+                 (append y x))))
+
+; (sb-sprof:with-profiling
+;     (:report :flat
+;      :sample-interval 0.001
+;      :loop nil)
+;   (dfs-exhaust)
+;   )
diff -r 83f309e6e33a -r a696be29e830 examples/ggp.lisp
--- a/examples/ggp.lisp	Thu May 19 14:13:37 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,285 +0,0 @@
-(in-package #:bones.wam)
-
-(defparameter *d* (make-database))
-
-(with-database *d*
-  (rules ((member :thing (cons :thing :rest)))
-         ((member :thing (cons :other :rest))
-          (member :thing :rest)))
-
-  (rule (true :state :thing)
-        (member :thing :state))
-
-  (rule (does :performed :role :move)
-        (member (does :role :move) :performed))
-
-  (fact (role robot))
-
-  (facts (init (off p))
-         (init (off q))
-         (init (off r))
-         (init (off s))
-         (init (step num1))))
-
-(with-database *d*
-  (rules ((next :state :performed (on p))
-          (does :performed robot a)
-          (true :state (off p)))
-         ((next :state :performed (on q))
-          (does :performed robot a)
-          (true :state (on q)))
-         ((next :state :performed (on r))
-          (does :performed robot a)
-          (true :state (on r)))
-         ((next :state :performed (off p))
-          (does :performed robot a)
-          (true :state (on p)))
-         ((next :state :performed (off q))
-          (does :performed robot a)
-          (true :state (off q)))
-         ((next :state :performed (off r))
-          (does :performed robot a)
-          (true :state (off r)))
-
-         ((next :state :performed (on p))
-          (does :performed robot b)
-          (true :state (on q)))
-         ((next :state :performed (on q))
-          (does :performed robot b)
-          (true :state (on p)))
-         ((next :state :performed (on r))
-          (does :performed robot b)
-          (true :state (on r)))
-         ((next :state :performed (off p))
-          (does :performed robot b)
-          (true :state (off q)))
-         ((next :state :performed (off q))
-          (does :performed robot b)
-          (true :state (off p)))
-         ((next :state :performed (off r))
-          (does :performed robot b)
-          (true :state (off r)))
-
-         ((next :state :performed (on p))
-          (does :performed robot c)
-          (true :state (on p)))
-         ((next :state :performed (on q))
-          (does :performed robot c)
-          (true :state (on r)))
-         ((next :state :performed (on r))
-          (does :performed robot c)
-          (true :state (on q)))
-         ((next :state :performed (off p))
-          (does :performed robot c)
-          (true :state (off p)))
-         ((next :state :performed (off q))
-          (does :performed robot c)
-          (true :state (off r)))
-         ((next :state :performed (off r))
-          (does :performed robot c)
-          (true :state (off q)))
-
-         ((next :state :performed (off s))
-          (does :performed robot a)
-          (true :state (off s)))
-         ((next :state :performed (off s))
-          (does :performed robot b)
-          (true :state (off s)))
-         ((next :state :performed (off s))
-          (does :performed robot c)
-          (true :state (off s)))
-         ((next :state :performed (on s))
-          (does :performed robot a)
-          (true :state (on s)))
-         ((next :state :performed (on s))
-          (does :performed robot b)
-          (true :state (on s)))
-         ((next :state :performed (on s))
-          (does :performed robot c)
-          (true :state (on s)))
-         ((next :state :performed (off s))
-          (does :performed robot d)
-          (true :state (on s)))
-         ((next :state :performed (on s))
-          (does :performed robot d)
-          (true :state (off s)))
-
-         ((next :state :performed (on p))
-          (does :performed robot d)
-          (true :state (on p)))
-         ((next :state :performed (off p))
-          (does :performed robot d)
-          (true :state (off p)))
-
-         ((next :state :performed (on q))
-          (does :performed robot d)
-          (true :state (on q)))
-         ((next :state :performed (off q))
-          (does :performed robot d)
-          (true :state (off q)))
-
-         ((next :state :performed (on r))
-          (does :performed robot d)
-          (true :state (on r)))
-         ((next :state :performed (off r))
-          (does :performed robot d)
-          (true :state (off r)))
-
-         ((next :state :performed (step :y))
-          (true :state (step :x))
-          (succ :x :y))))
-
-(with-database *d*
-  (facts (succ num1 num2)
-         (succ num2 num3)
-         (succ num3 num4)
-         (succ num4 num5)
-         (succ num5 num6)
-         (succ num6 num7)
-         (succ num7 num8))
-
-  (facts (legal robot a)
-         (legal robot b)
-         (legal robot c)
-         (legal robot d)))
-
-(with-database *d*
-  (rules ((goal :state robot num100)
-          (true :state (on p))
-          (true :state (on q))
-          (true :state (on r))
-          (true :state (on s))
-          )
-         ((goal :state robot num0)
-          (true :state (off p)))
-         ((goal :state robot num0)
-          (true :state (off q)))
-         ((goal :state robot num0)
-          (true :state (off r)))
-         ((goal :state robot num0)
-          (true :state (off s)))
-         )
-
-  (rules ((terminal :state)
-          (true :state (step num8)))
-         ((terminal :state)
-          (true :state (on p))
-          (true :state (on q))
-          (true :state (on r))
-          (true :state (on s))
-          )))
-
-
-(defun extract (key results)
-  (mapcar (lambda (result) (getf result key)) results))
-
-(defun to-fake-list (l)
-  (if (null l)
-    'nil
-    `(cons ,(car l) ,(to-fake-list (cdr l)))))
-
-(defun initial-state ()
-  (to-fake-list
-    (with-database *d*
-      (extract :what (return-all (init :what))))))
-
-(defun terminalp (state)
-  (with-database *d*
-    (perform-prove `((terminal ,state)))))
-
-(defun legal-moves (state)
-  (declare (ignore state))
-  (with-database *d*
-    (return-all (legal :role :move))))
-
-(defun roles ()
-  (with-database *d*
-    (extract :role (return-all (role :role)))))
-
-(defun goal-value (state role)
-  (with-database *d*
-    (getf (perform-return `((goal ,state ,role :goal)) :one) :goal)))
-
-(defun goal-values (state)
-  (with-database *d*
-    (perform-return `((goal ,state :role :goal)) :all)))
-
-(defun next-state (current-state move)
-  (let ((does (to-fake-list `((does
-                                ,(getf move :role)
-                                ,(getf move :move))))))
-    (with-database *d*
-      (to-fake-list
-        (extract :what
-               (perform-return `((next ,current-state ,does :what)) :all))))))
-
-
-
-(defvar *count* 0)
-
-(defstruct search-path state (path nil) (previous nil))
-
-(defun tree-search (states goal-p children combine)
-  (labels
-      ((recur (states)
-         (if (null states)
-           nil
-           (destructuring-bind (state . remaining) states
-             (incf *count*)
-             ; (format t "Searching: ~S (~D remaining)~%" state (length remaining))
-             (if (funcall goal-p state)
-               state
-               (recur (funcall combine
-                               (funcall children state)
-                               remaining)))))))
-    (let ((result (recur states)))
-      (when result
-        (reverse (search-path-path result))))))
-
-
-(defun buttons-goal-p (search-path)
-  (let ((state (search-path-state search-path)))
-    (and (terminalp state)
-         (eql (goal-value state 'robot) 'num100))))
-
-(defun buttons-children (search-path)
-  (let ((state (search-path-state search-path))
-        (path (search-path-path search-path)))
-    (when (not (terminalp state))
-      (loop :for move :in (legal-moves state)
-            :collect (make-search-path :state (next-state state move)
-                                       :path (cons move path)
-                                       :previous search-path)))))
-
-(defun never (&rest args)
-  (declare (ignore args))
-  nil)
-
-(defun dfs ()
-  (tree-search (list (make-search-path :state (initial-state)))
-               #'buttons-goal-p
-               #'buttons-children
-               #'append))
-
-(defun dfs-exhaust ()
-  (let ((*count* 0))
-    (prog1
-        (tree-search (list (make-search-path :state (initial-state)))
-                     #'never
-                     #'buttons-children
-                     #'append)
-      (format t "Searched ~D nodes.~%" *count*))))
-
-(defun bfs ()
-  (tree-search (list (make-search-path :state (initial-state)))
-               #'buttons-goal-p
-               #'buttons-children
-               (lambda (x y)
-                 (append y x))))
-
-; (sb-sprof:with-profiling
-;     (:report :flat
-;      :sample-interval 0.001
-;      :loop nil)
-;   (dfs-exhaust)
-;   )
diff -r 83f309e6e33a -r a696be29e830 examples/profile.lisp
--- a/examples/profile.lisp	Thu May 19 14:13:37 2016 +0000
+++ b/examples/profile.lisp	Thu Jun 02 10:36:29 2016 +0000
@@ -2,7 +2,7 @@
 
 (require :sb-sprof)
 
-(load "examples/ggp.lisp")
+(load "examples/ggp-wam.lisp")
 
 (in-package :bones)