--- a/examples/ggp-wam.lisp Thu Jun 30 17:53:49 2016 +0000
+++ b/examples/ggp-wam.lisp Sun Jul 03 22:50:24 2016 +0000
@@ -3,15 +3,15 @@
(defparameter *d* (make-database))
(with-database *d*
- (rules ((member :thing (list* :thing :rest)))
- ((member :thing (list* :other :rest))
- (member :thing :rest)))
+ (rules ((member ?thing (list* ?thing ?rest)))
+ ((member ?thing (list* ?other ?rest))
+ (member ?thing ?rest)))
- (rule (true :state :thing)
- (member :thing :state))
+ (rule (true ?state ?thing)
+ (member ?thing ?state))
- (rule (does :performed :role :move)
- (member (does :role :move) :performed))
+ (rule (does ?performed ?role ?move)
+ (member (does ?role ?move) ?performed))
(fact (role robot))
@@ -22,112 +22,112 @@
(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)))
+ (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 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 (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 (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 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 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 (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))))
+ ((next ?state ?performed (step ?y))
+ (true ?state (step ?x))
+ (succ ?x ?y))))
(with-database *d*
(facts (succ num1 num2)
@@ -144,29 +144,29 @@
(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))
+ (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)))
+ ((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))
+ (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))
)))
@@ -181,7 +181,7 @@
(defun initial-state ()
(to-prolog-list
(with-database *d*
- (extract :what (return-all (init :what))))))
+ (extract '?what (return-all (init ?what))))))
(defun terminalp (state)
(with-database *d*
@@ -190,29 +190,28 @@
(defun legal-moves (state)
(declare (ignore state))
(with-database *d*
- (return-all (legal :role :move))))
+ (return-all (legal ?role ?move))))
(defun roles ()
(with-database *d*
- (extract :role (return-all (role :role)))))
+ (extract '?role (return-all (role ?role)))))
(defun goal-value (state role)
(with-database *d*
- (getf (perform-return `((goal ,state ,role :goal)) :one) :goal)))
+ (getf (perform-return `((goal ,state ,role ?goal)) :one) '?goal)))
(defun goal-values (state)
(with-database *d*
- (perform-return `((goal ,state :role :goal)) :all)))
+ (perform-return `((goal ,state ?role ?goal)) :all)))
(defun next-state (current-state move)
(let ((does `(list (does
- ,(getf move :role)
- ,(getf move :move)))))
+ ,(getf move '?role)
+ ,(getf move '?move)))))
(with-database *d*
(to-prolog-list
- (extract :what
- (perform-return `((next ,current-state ,does :what)) :all))))))
-
+ (extract '?what
+ (perform-return `((next ,current-state ,does ?what)) :all))))))
(defvar *count* 0)
--- a/src/wam/compiler.lisp Thu Jun 30 17:53:49 2016 +0000
+++ b/src/wam/compiler.lisp Sun Jul 03 22:50:24 2016 +0000
@@ -1,11 +1,13 @@
(in-package #:bones.wam)
(named-readtables:in-readtable :fare-quasiquote)
+
;;;; Utils
(declaim (inline variablep))
(defun* variablep (term)
(:returns boolean)
- (keywordp term))
+ (and (symbolp term)
+ (char= (char (symbol-name term) 0) #\?)))
;;;; Registers
@@ -101,7 +103,7 @@
(defclass variable-node (vanilla-node)
((variable :accessor node-variable
- :type keyword
+ :type symbol
:initarg :variable)))
(defclass argument-variable-node (variable-node)
@@ -244,7 +246,7 @@
(defun parse (term &optional top-level-argument)
(cond
- ((keywordp term)
+ ((variablep term)
(if top-level-argument
(make-argument-variable-node term)
(make-variable-node term)))
--- a/test/wam.lisp Thu Jun 30 17:53:49 2016 +0000
+++ b/test/wam.lisp Sun Jul 03 22:50:24 2016 +0000
@@ -11,7 +11,7 @@
(facts (always))
- (facts (drinks tom :anything)
+ (facts (drinks tom ?anything)
(drinks kim water)
(drinks alice bourbon)
(drinks bob genny-cream)
@@ -28,33 +28,33 @@
(facts (cute cats)
(cute snakes))
- (rules ((pets alice :what)
- (cute :what))
+ (rules ((pets alice ?what)
+ (cute ?what))
- ((pets bob :what)
- (cute :what)
- (fuzzy :what))
+ ((pets bob ?what)
+ (cute ?what)
+ (fuzzy ?what))
- ((pets candace :bird)
- (flies :bird)))
+ ((pets candace ?bird)
+ (flies ?bird)))
- (rules ((likes sally :who)
- (likes :who cats)
- (drinks :who beer))
+ (rules ((likes sally ?who)
+ (likes ?who cats)
+ (drinks ?who beer))
((likes tom cats))
((likes alice cats))
((likes kim cats))
- ((likes kim :who)
- (likes :who cats)))
+ ((likes kim ?who)
+ (likes ?who cats)))
- (rules ((narcissist :person)
- (likes :person :person)))
+ (rules ((narcissist ?person)
+ (likes ?person ?person)))
- (rules ((member :x (list* :x :rest)))
- ((member :x (list* :y :rest))
- (member :x :rest))))
+ (rules ((member ?x (list* ?x ?rest)))
+ ((member ?x (list* ?y ?rest))
+ (member ?x ?rest))))
db))
(defparameter *test-database* (make-test-database))
@@ -100,53 +100,53 @@
(test facts-variables
(with-database *test-database*
- (is (results= '((:what cats))
- (q (fuzzy :what))))
- (is (results= '((:what blues)
- (:what rock))
- (q (listens bob :what))))
- (is (results= '((:who alice)
- (:who bob)
- (:who candace))
- (q (listens :who blues))))
+ (is (results= '((?what cats))
+ (q (fuzzy ?what))))
+ (is (results= '((?what blues)
+ (?what rock))
+ (q (listens bob ?what))))
+ (is (results= '((?who alice)
+ (?who bob)
+ (?who candace))
+ (q (listens ?who blues))))
(is (results= '()
- (q (listens :who metal))))))
+ (q (listens ?who metal))))))
(test facts-conjunctions
(with-database *test-database*
- (is (results= '((:who alice))
- (q (listens :who blues)
- (listens :who jazz))))
- (is (results= '((:who alice))
- (q (listens :who blues)
- (drinks :who bourbon))))
- (is (results= '((:what bourbon :who alice)
- (:what genny-cream :who bob)
- (:what birch-beer :who candace))
- (q (listens :who blues)
- (drinks :who :what))))))
+ (is (results= '((?who alice))
+ (q (listens ?who blues)
+ (listens ?who jazz))))
+ (is (results= '((?who alice))
+ (q (listens ?who blues)
+ (drinks ?who bourbon))))
+ (is (results= '((?what bourbon ?who alice)
+ (?what genny-cream ?who bob)
+ (?what birch-beer ?who candace))
+ (q (listens ?who blues)
+ (drinks ?who ?what))))))
(test simple-unification
(with-fresh-database
- (rule (= :x :x))
+ (rule (= ?x ?x))
(should-return
((= x x) empty)
((= x y) fail)
- ((= :x foo) (:x foo))
- ((= foo :x) (:x foo))
- ((= (f (g foo)) :x) (:x (f (g foo))))
- ((= (f (g foo)) (f :x)) (:x (g foo)))
- ((= (f :x cats) (f dogs :y)) (:x dogs :y cats))
- ((= (f :x :x) (f dogs :y)) (:x dogs :y dogs)))))
+ ((= ?x foo) (?x foo))
+ ((= foo ?x) (?x foo))
+ ((= (f (g foo)) ?x) (?x (f (g foo))))
+ ((= (f (g foo)) (f ?x)) (?x (g foo)))
+ ((= (f ?x cats) (f dogs ?y)) (?x dogs ?y cats))
+ ((= (f ?x ?x) (f dogs ?y)) (?x dogs ?y dogs)))))
(test dynamic-call
(with-fresh-database
(facts (g cats)
(g (f dogs)))
- (rule (normal :x)
- (g :x))
- (rule (dynamic :struct)
- (call :struct))
+ (rule (normal ?x)
+ (g ?x))
+ (rule (dynamic ?struct)
+ (call ?struct))
(should-return
((normal foo) fail)
((normal cats) empty)
@@ -154,21 +154,21 @@
((call (g cats)) empty)
((call (g (f cats))) fail)
((call (nothing)) fail)
- ((call (g :x))
- (:x cats)
- (:x (f dogs)))
+ ((call (g ?x))
+ (?x cats)
+ (?x (f dogs)))
((dynamic (g cats)) empty)
((dynamic (g dogs)) fail)
((dynamic (g (f dogs))) empty)
- ((dynamic (g :x))
- (:x cats)
- (:x (f dogs))))))
+ ((dynamic (g ?x))
+ (?x cats)
+ (?x (f dogs))))))
(test not
(with-fresh-database
- (facts (yes :anything))
- (rules ((not :x) (call :x) ! fail)
- ((not :x)))
+ (facts (yes ?anything))
+ (rules ((not ?x) (call ?x) ! fail)
+ ((not ?x)))
(should-return
((yes x) empty)
((no x) fail)
@@ -181,9 +181,9 @@
(facts (b))
(facts (c))
(facts (d))
- (rules ((f :x) (a))
- ((f :x) (b) (c))
- ((f :x) (d)))
+ (rules ((f ?x) (a))
+ ((f ?x) (b) (c))
+ ((f ?x) (d)))
(should-return
((f foo) empty)))
(with-fresh-database
@@ -191,9 +191,9 @@
(facts (b))
(facts (c))
(facts (d))
- (rules ((f :x) (a))
- ((f :x) (b) (c))
- ((f :x) (d)))
+ (rules ((f ?x) (a))
+ ((f ?x) (b) (c))
+ ((f ?x) (d)))
(should-return
((f foo) empty)))
(with-fresh-database
@@ -201,9 +201,9 @@
(facts (b))
(facts (c))
; (facts (d))
- (rules ((f :x) (a))
- ((f :x) (b) (c))
- ((f :x) (d)))
+ (rules ((f ?x) (a))
+ ((f ?x) (b) (c))
+ ((f ?x) (d)))
(should-return
((f foo) empty)))
(with-fresh-database
@@ -211,9 +211,9 @@
; (facts (b))
(facts (c))
; (facts (d))
- (rules ((f :x) (a))
- ((f :x) (b) (c))
- ((f :x) (d)))
+ (rules ((f ?x) (a))
+ ((f ?x) (b) (c))
+ ((f ?x) (d)))
(should-return
((f foo) fail)))
(with-fresh-database
@@ -221,39 +221,39 @@
(facts (b))
; (facts (c))
; (facts (d))
- (rules ((f :x) (a))
- ((f :x) (b) (c))
- ((f :x) (d)))
+ (rules ((f ?x) (a))
+ ((f ?x) (b) (c))
+ ((f ?x) (d)))
(should-return
((f foo) fail))))
(test basic-rules
(with-database *test-database*
(should-fail
- (pets candace :what))
+ (pets candace ?what))
(should-return
- ((pets alice :what)
- (:what snakes)
- (:what cats))
+ ((pets alice ?what)
+ (?what snakes)
+ (?what cats))
- ((pets bob :what)
- (:what cats))
+ ((pets bob ?what)
+ (?what cats))
- ((pets :who snakes)
- (:who alice))
+ ((pets ?who snakes)
+ (?who alice))
- ((likes kim :who)
- (:who tom)
- (:who alice)
- (:who kim)
- (:who cats))
+ ((likes kim ?who)
+ (?who tom)
+ (?who alice)
+ (?who kim)
+ (?who cats))
- ((likes sally :who)
- (:who tom))
+ ((likes sally ?who)
+ (?who tom))
- ((narcissist :person)
- (:person kim)))))
+ ((narcissist ?person)
+ (?person kim)))))
(test register-allocation
;; test for tricky register allocation bullshit
@@ -262,10 +262,10 @@
(fact (b fact-b fact-b))
(fact (c fact-c fact-c))
- (rule (foo :x)
- (a :a :a)
- (b :b :b)
- (c :c :c))
+ (rule (foo ?x)
+ (a ?a ?a)
+ (b ?b ?b)
+ (c ?c ?c))
(should-return
((foo dogs) empty))))
@@ -273,28 +273,28 @@
(test lists
(with-database *test-database*
(should-fail
- (member :anything nil)
+ (member ?anything nil)
(member a nil)
(member b (list a))
(member (list a) (list a))
(member a (list (list a))))
(should-return
- ((member :m (list a))
- (:m a))
- ((member :m (list a b))
- (:m a)
- (:m b))
- ((member :m (list a b a))
- (:m a)
- (:m b))
+ ((member ?m (list a))
+ (?m a))
+ ((member ?m (list a b))
+ (?m a)
+ (?m b))
+ ((member ?m (list a b a))
+ (?m a)
+ (?m b))
((member a (list a))
empty)
((member (list foo) (list a (list foo) b))
empty))
;; Check that we can unify against unbound vars that turn into lists
(is ((lambda (result)
- (eql (car (getf result :anything)) 'a))
- (return-one (member a :anything))))))
+ (eql (car (getf result '?anything)) 'a))
+ (return-one (member a ?anything))))))
(test cut
(with-fresh-database
@@ -305,15 +305,15 @@
(rules ((f a) (a))
((f bc) (b) ! (c))
((f d) (d)))
- (rules ((g :what) (never))
- ((g :what) (f :what)))
+ (rules ((g ?what) (never))
+ ((g ?what) (f ?what)))
(should-return
- ((f :what)
- (:what a)
- (:what bc))
- ((g :what)
- (:what a)
- (:what bc))))
+ ((f ?what)
+ (?what a)
+ (?what bc))
+ ((g ?what)
+ (?what a)
+ (?what bc))))
(with-fresh-database
; (facts (a))
@@ -323,13 +323,13 @@
(rules ((f a) (a))
((f bc) (b) ! (c))
((f d) (d)))
- (rules ((g :what) (never))
- ((g :what) (f :what)))
+ (rules ((g ?what) (never))
+ ((g ?what) (f ?what)))
(should-return
- ((f :what)
- (:what bc))
- ((g :what)
- (:what bc))))
+ ((f ?what)
+ (?what bc))
+ ((g ?what)
+ (?what bc))))
(with-fresh-database
; (facts (a))
@@ -339,13 +339,13 @@
(rules ((f a) (a))
((f bc) (b) ! (c))
((f d) (d)))
- (rules ((g :what) (never))
- ((g :what) (f :what)))
+ (rules ((g ?what) (never))
+ ((g ?what) (f ?what)))
(should-return
- ((f :what)
- (:what d))
- ((g :what)
- (:what d))))
+ ((f ?what)
+ (?what d))
+ ((g ?what)
+ (?what d))))
(with-fresh-database
; (facts (a))
@@ -355,11 +355,11 @@
(rules ((f a) (a))
((f bc) (b) ! (c))
((f d) (d)))
- (rules ((g :what) (never))
- ((g :what) (f :what)))
+ (rules ((g ?what) (never))
+ ((g ?what) (f ?what)))
(should-fail
- (f :what)
- (g :what)))
+ (f ?what)
+ (g ?what)))
(with-fresh-database
; (facts (a))
@@ -369,8 +369,9 @@
(rules ((f a) (a))
((f bc) (b) ! (c))
((f d) (d)))
- (rules ((g :what) (never))
- ((g :what) (f :what)))
+ (rules ((g ?what) (never))
+ ((g ?what) (f ?what)))
(should-fail
- (f :what)
- (g :what))))
+ (f ?what)
+ (g ?what))))
+