# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1471729214 0
# Node ID 5dce435d830e48320c24ea4d584849ea39ef9a5a
# Parent  8897604cb9dd852293b6484d348e775f9c417b7e
Remove examples directory

I've got Hype for benchmarking now.

diff -r 8897604cb9dd -r 5dce435d830e examples/bench.lisp
--- a/examples/bench.lisp	Sat Aug 20 21:38:54 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,41 +0,0 @@
-(ql:quickload 'bones)
-(ql:quickload 'paiprolog)
-
-(load "examples/ggp-paip-compiled.lisp")
-(load "examples/ggp-paip-interpreted.lisp")
-(load "examples/ggp-wam.lisp")
-
-(in-package :bones)
-
-(defun reload ()
-  (let ((*standard-output* (make-broadcast-stream))
-        (*debug-io* (make-broadcast-stream))
-        (*terminal-io* (make-broadcast-stream))
-        (*error-output* (make-broadcast-stream)))
-    (asdf:load-system 'bones :force t)
-    (asdf:load-system 'paiprolog :force t)
-    (load "examples/ggp-paip-compiled.lisp")
-    (load "examples/ggp-paip-interpreted.lisp")
-    (load "examples/ggp-wam.lisp")))
-
-(defun run-test% ()
-  (format t "PAIP (Compiled) --------------------~%")
-  (time (paiprolog-test::dfs-exhaust))
-
-  (format t "PAIP (Interpreted) -----------------~%")
-  (time (bones.paip::depth-first-search :exhaust t))
-
-  (format t "WAM --------------------------------~%")
-  (time (bones.wam::depth-first-search :exhaust t)))
-
-(defmacro run-test (&rest settings)
-  `(progn
-    (declaim (optimize ,@settings))
-    (format t "~%~%========================================================~%")
-    (format t "~S~%" ',settings)
-    (format t "--------------------------------------------------------~%")
-    (reload)
-    (run-test%)))
-
-; (run-test (speed 3) (safety 1) (debug 1))
-(run-test (speed 3) (safety 0) (debug 0))
diff -r 8897604cb9dd -r 5dce435d830e examples/ggp-paip-compiled.lisp
--- a/examples/ggp-paip-compiled.lisp	Sat Aug 20 21:38:54 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 8897604cb9dd -r 5dce435d830e examples/ggp-paip-interpreted.lisp
--- a/examples/ggp-paip-interpreted.lisp	Sat Aug 20 21:38:54 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,279 +0,0 @@
-(in-package #:bones.paip)
-
-;;;; Queues
-(deftype queue () '(cons list list))
-(declaim (inline queue-contents make-queue
-                 enqueue dequeue
-                 queue-empty-p queue-append))
-
-
-(defun queue-contents (q)
-  (cdr q))
-
-(defun make-queue ()
-  (let ((q (cons nil nil)))
-    (setf (car q) q)))
-
-(defun enqueue (item q)
-  (setf (car q)
-        (setf (rest (car q))
-              (cons item nil)))
-  q)
-
-(defun dequeue (q)
-  (prog1
-      (pop (cdr q))
-    (if (null (cdr q))
-      (setf (car q) q))))
-
-(defun queue-empty-p (q)
-  (null (queue-contents q)))
-
-(defun queue-append (q l)
-  (when l
-    (setf (car q)
-          (last (setf (rest (car q))
-                      l))))
-  q)
-
-
-;;;; Rules
-(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 equiv-roles (move1 move2)
-  (eq (car move1) (car move2)))
-
-(defun legal-moves (state)
-  (declare (ignore state))
-  (let* ((individual-moves
-           (loop :for move :in (return-all (legal ?role ?action))
-                 :collect (cons (cdr (assoc '?role move))
-                                (cdr (assoc '?action move)))))
-         (joint-moves
-           (apply #'map-product #'list
-                  (equivalence-classes #'equiv-roles individual-moves))))
-    joint-moves))
-
-
-(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 joint-move)
-  (let ((does (to-fake-list
-                (loop :for (role . action) :in joint-move
-                      :collect `(does ,role ,action)))))
-    (to-fake-list
-      (extract
-        '?what
-        (raw-return-all `(next ,current-state ,does ?what))))))
-
-
-(defun depth-first-search (&key exhaust)
-  (let ((*count* 0)
-        (nodes (make-queue)))
-    (enqueue (cons (initial-state) nil) nodes)
-    (pprint
-      (while (not (queue-empty-p nodes))
-        (incf *count*)
-        (destructuring-bind (state . path)
-            (dequeue nodes)
-          ; (format t "Searching: ~S (~D remaining)~%" state (length remaining))
-          (if (and (not exhaust)
-                   (eql 'num100 (goal-value state 'robot)))
-            (return (list state (reverse path)))
-            (let ((children
-                    (when (not (terminalp state))
-                      (loop :for joint-move :in (legal-moves state)
-                            :collect (cons (next-state state joint-move)
-                                           (cons joint-move path))))))
-              (queue-append nodes children))))))
-    (format t "~%Searched ~D nodes.~%" *count*)))
-
diff -r 8897604cb9dd -r 5dce435d830e examples/ggp-wam.lisp
--- a/examples/ggp-wam.lisp	Sat Aug 20 21:38:54 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,261 +0,0 @@
-(in-package #:bones.wam)
-
-;;;; Rules
-(setf *database* (make-database))
-
-(push-logic-frame)
-
-(fact (role robot))
-
-(facts (init (off p))
-       (init (off q))
-       (init (off r))
-       (init (off s))
-       (init (step 1)))
-
-
-(rule (next (on p))
-  (does robot a)
-  (true (off p)))
-(rule (next (on q))
-  (does robot a)
-  (true (on q)))
-(rule (next (on r))
-  (does robot a)
-  (true (on r)))
-(rule (next (off p))
-  (does robot a)
-  (true (on p)))
-(rule (next (off q))
-  (does robot a)
-  (true (off q)))
-(rule (next (off r))
-  (does robot a)
-  (true (off r)))
-
-(rule (next (on p))
-  (does robot b)
-  (true (on q)))
-(rule (next (on q))
-  (does robot b)
-  (true (on p)))
-(rule (next (on r))
-  (does robot b)
-  (true (on r)))
-(rule (next (off p))
-  (does robot b)
-  (true (off q)))
-(rule (next (off q))
-  (does robot b)
-  (true (off p)))
-(rule (next (off r))
-  (does robot b)
-  (true (off r)))
-
-(rule (next (on p))
-  (does robot c)
-  (true (on p)))
-(rule (next (on q))
-  (does robot c)
-  (true (on r)))
-(rule (next (on r))
-  (does robot c)
-  (true (on q)))
-(rule (next (off p))
-  (does robot c)
-  (true (off p)))
-(rule (next (off q))
-  (does robot c)
-  (true (off r)))
-(rule (next (off r))
-  (does robot c)
-  (true (off q)))
-
-(rule (next (off s))
-  (does robot a)
-  (true (off s)))
-(rule (next (off s))
-  (does robot b)
-  (true (off s)))
-(rule (next (off s))
-  (does robot c)
-  (true (off s)))
-(rule (next (on s))
-  (does robot a)
-  (true (on s)))
-(rule (next (on s))
-  (does robot b)
-  (true (on s)))
-(rule (next (on s))
-  (does robot c)
-  (true (on s)))
-(rule (next (off s))
-  (does robot d)
-  (true (on s)))
-(rule (next (on s))
-  (does robot d)
-  (true (off s)))
-
-(rule (next (on p))
-  (does robot d)
-  (true (on p)))
-(rule (next (off p))
-  (does robot d)
-  (true (off p)))
-
-(rule (next (on q))
-  (does robot d)
-  (true (on q)))
-(rule (next (off q))
-  (does robot d)
-  (true (off q)))
-
-(rule (next (on r))
-  (does robot d)
-  (true (on r)))
-(rule (next (off r))
-  (does robot d)
-  (true (off r)))
-
-(rule (next (step ?y))
-  (true (step ?x))
-  (succ ?x ?y))
-
-
-(facts (succ 1 2)
-       (succ 2 3)
-       (succ 3 4)
-       (succ 4 5)
-       (succ 5 6)
-       (succ 6 7)
-       (succ 7 8))
-
-(facts (legal robot a)
-       (legal robot b)
-       (legal robot c)
-       (legal robot d))
-
-
-(rule (goal robot 100)
-  (true (on p))
-  (true (on q))
-  (true (on r))
-  (true (on s)))
-(rule (goal robot 0)
-  (true (off p)))
-(rule (goal robot 0)
-  (true (off q)))
-(rule (goal robot 0)
-  (true (off r)))
-(rule (goal robot 0)
-  (true (off s)))
-
-
-(rule (terminal)
-  (true (step 8)))
-(rule (terminal)
-  (true (on p))
-  (true (on q))
-  (true (on r))
-  (true (on s)))
-
-(finalize-logic-frame)
-
-
-(defun extract (key results)
-  (mapcar (lambda (result) (getf result key)) results))
-
-
-(defun initial-state ()
-  (extract '?what (query-all (init ?what))))
-
-(defun terminalp ()
-  (prove (terminal)))
-
-
-(defun equiv-roles (move1 move2)
-  (eq (car move1) (car move2)))
-
-(defun legal-moves ()
-  (let* ((individual-moves
-           (query-map (lambda (move)
-                        (cons (getf move '?role)
-                              (getf move '?action)))
-                      (legal ?role ?action)))
-         (joint-moves
-           (apply #'map-product #'list
-                  (equivalence-classes #'equiv-roles individual-moves))))
-    joint-moves))
-
-(defun roles ()
-  (extract '?role (query-all (role ?role))))
-
-(defun goal-value (role)
-  (getf (invoke-query `(goal ,role ?goal))
-        '?goal))
-
-(defun goal-values ()
-  (invoke-query-all `(goal ?role ?goal)))
-
-(defun next-state ()
-  (extract '?what (query-all (next ?what))))
-
-
-(defun apply-state (state)
-  (push-logic-frame)
-  (loop :for fact :in state
-        :do (invoke-fact `(true ,fact)))
-  (finalize-logic-frame))
-
-(defun apply-moves (moves)
-  (push-logic-frame)
-  (loop :for (role . action) :in moves
-        :do (invoke-fact `(does ,role ,action)))
-  (finalize-logic-frame))
-
-
-(defun clear-state ()
-  (pop-logic-frame))
-
-(defun clear-moves ()
-  (pop-logic-frame))
-
-
-(defun perform-move (joint-move)
-  (prog2
-    (apply-moves joint-move)
-    (next-state)
-    (clear-moves)))
-
-
-(defvar *count* 0)
-(defvar *role* nil)
-
-
-;; nodes: (state . path)
-(defun depth-first-search (&key exhaust)
-  (let ((*count* 0)
-        (*role* (first (roles)))
-        (nodes (make-queue)))
-    (enqueue (cons (initial-state) nil) nodes)
-    (pprint
-      (while (not (queue-empty-p nodes))
-        (incf *count*)
-        (destructuring-bind (state . path)
-            (dequeue nodes)
-          (apply-state state)
-          ; (format t "Searching: ~S (~D remaining)~%" state (length remaining))
-          (if (terminalp)
-            (prog1
-                (if (and (not exhaust) (= 100 (goal-value *role*)))
-                  (list state (reverse path))
-                  nil)
-              (clear-state))
-            (let ((children
-                    (loop :for joint-move :in (legal-moves)
-                          :collect (cons (perform-move joint-move)
-                                         (cons joint-move path)))))
-              (clear-state)
-              (queue-append nodes children))))))
-    (format t "~%Searched ~D nodes.~%" *count*)))
-
diff -r 8897604cb9dd -r 5dce435d830e examples/profile.lisp
--- a/examples/profile.lisp	Sat Aug 20 21:38:54 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,48 +0,0 @@
-(ql:quickload 'bones)
-(load "examples/ggp-wam.lisp")
-
-(require :sb-sprof)
-
-(in-package :bones.wam)
-
-(defun reload ()
-  (let ((*standard-output* (make-broadcast-stream))
-        (*debug-io* (make-broadcast-stream))
-        (*terminal-io* (make-broadcast-stream))
-        (*error-output* (make-broadcast-stream)))
-    (asdf:load-system 'bones :force t)
-    (load "examples/ggp-wam.lisp")))
-
-
-(defun run-profile ()
-  (reload)
-
-  (format t "PROFILING -------------------------------~%")
-
-  ; (sb-sprof:profile-call-counts "COMMON-LISP")
-  (sb-sprof:profile-call-counts "BONES.WAM")
-  (sb-sprof:profile-call-counts "BONES.QUICKUTILS")
-
-  (sb-sprof:with-profiling (:max-samples 5000
-                            :mode :alloc
-                            :sample-interval 0.0005
-                            :loop nil)
-    (bones.wam::depth-first-search :exhaust t))
-
-  (sb-sprof:report :type :flat)
-  )
-
-; (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 3) (debug 3)))
-; (run-profile)
-
-; (format t "~%~%====================================~%")
-; (format t "(speed 3) (safety 0) (debug 0)~%")
-(declaim (optimize (speed 3) (safety 0) (debug 0)))
-(run-profile)
diff -r 8897604cb9dd -r 5dce435d830e examples/zebra-wam.lisp
--- a/examples/zebra-wam.lisp	Sat Aug 20 21:38:54 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,57 +0,0 @@
-(in-package #:bones.wam)
-
-(reset-database)
-(push-logic-frame)
-
-(fact (member ?item (list* ?item ?)))
-(rule (member ?item (list* ? ?rest))
-  (member ?item ?rest))
-
-(rule (next-to ?x ?y ?list)
-  (in-order ?x ?y ?list))
-
-(rule (next-to ?x ?y ?list)
-  (in-order ?y ?x ?list))
-
-(fact (in-order ?x ?y (list* ?x ?y ?)))
-(rule (in-order ?x ?y (list* ? ?rest))
-  (in-order ?x ?y ?rest))
-
-(rule (= ?x ?x))
-
-(rule
-    (zebra ?houses ?water-drinker ?zebra-owner)
-  ;; Houses are of the form:
-  ;; (HOUSE ?country ?pet ?cigarette ?drink ?color)
-
-  (= ?houses
-     (list (house norway ? ? ? ?)
-           ?
-           (house ? ? ? milk ?)
-           ?
-           ?))
-
-  (member   (house england ?      ?            ?            red   ) ?houses)
-  (member   (house spain   dog    ?            ?            ?     ) ?houses)
-  (member   (house ?       ?      ?            coffee       green ) ?houses)
-  (member   (house ukraine ?      ?            tea          ?     ) ?houses)
-  (member   (house ?       snails winston      ?            ?     ) ?houses)
-  (member   (house ?       ?      kools        ?            yellow) ?houses)
-  (member   (house ?       ?      lucky-strike orange-juice ?     ) ?houses)
-  (member   (house japan   ?      parliaments  ?            ?     ) ?houses)
-  (in-order (house ?       ?      ?            ?            ivory )
-            (house ?       ?      ?            ?            green ) ?houses)
-  (next-to  (house ?       ?      chesterfield ?            ?     )
-            (house ?       fox    ?            ?            ?     ) ?houses)
-  (next-to  (house ?       ?      kools        ?            ?     )
-            (house ?       horse  ?            ?            ?     ) ?houses)
-  (next-to  (house norway  ?      ?            ?            ?     )
-            (house ?       ?      ?            ?            blue  ) ?houses)
-
-  (member (house ?water-drinker ?     ? water ?) ?houses)
-  (member (house ?zebra-owner   zebra ? ?     ?) ?houses))
-
-(finalize-logic-frame)
-
-(time (query-all (zebra ?houses ?water ?zebra)))
-; (declaim (optimize (speed 3) (safety 0)))
diff -r 8897604cb9dd -r 5dce435d830e examples/zebra.lisp
--- a/examples/zebra.lisp	Sat Aug 20 21:38:54 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,54 +0,0 @@
-(in-package #:bones.paip)
-
-(clear-db)
-
-(rule (member ?item (?item . ?)))
-(rule (member ?item (? . ?rest))
-      (member ?item ?rest))
-
-(rule (next-to ?x ?y ?list)
-      (in-order ?x ?y ?list))
-
-(rule (next-to ?x ?y ?list)
-      (in-order ?y ?x ?list))
-
-(rule (in-order ?x ?y (?x ?y . ?)))
-(rule (in-order ?x ?y (? . ?rest))
-      (in-order ?x ?y ?rest))
-
-(rule (= ?x ?x))
-
-(rule
- (zebra ?houses ?water-drinker ?zebra-owner)
- ;; Houses are of the form:
- ;; (HOUSE ?country ?pet ?cigarette ?drink ?color)
-
- (= ?houses
-    ((house norway ? ? ? ?)
-     ?
-     (house ? ? ? milk ?)
-     ?
-     ?))
-
- (member   (house england ?      ?            ?            red   ) ?houses)
- (member   (house spain   dog    ?            ?            ?     ) ?houses)
- (member   (house ?       ?      ?            coffee       green ) ?houses)
- (member   (house ukraine ?      ?            tea          ?     ) ?houses)
- (member   (house ?       snails winston      ?            ?     ) ?houses)
- (member   (house ?       ?      kools        ?            yellow) ?houses)
- (member   (house ?       ?      lucky-strike orange-juice ?     ) ?houses)
- (member   (house japan   ?      parliaments  ?            ?     ) ?houses)
- (in-order (house ?       ?      ?            ?            ivory )
-           (house ?       ?      ?            ?            green ) ?houses)
- (next-to  (house ?       ?      chesterfield ?            ?     )
-           (house ?       fox    ?            ?            ?     ) ?houses)
- (next-to  (house ?       ?      kools        ?            ?     )
-           (house ?       horse  ?            ?            ?     ) ?houses)
- (next-to  (house norway  ?      ?            ?            ?     )
-           (house ?       ?      ?            ?            blue  ) ?houses)
-
- (member (house ?water-drinker ? ? water ?) ?houses)
- (member (house ?zebra-owner zebra ? ? ?) ?houses))
-
-(time (query-all (zebra ?houses ?water ?zebra)))
-; (declaim (optimize (speed 3) (safety 0)))