--- 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))
--- 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))
--- 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*)))
-
--- 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*)))
-
--- 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)
--- 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)))
--- 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)))