THE CONCATENING
This patch does something I've been dreading since I started: it concatenates
the registers, stack, and heap into one single big-ass array called the store.
This is how the original WAM was laid out (actually the original WAM has
EVERYTHING in one giant block of memory, but let's not get carried away here).
I was hoping I wouldn't have to do this, because the code reads a lot nicer when
these things are separate, but after reading ahead in the book I think I'm
pretty sure it had to be done.
The upside here is that now dereferencing things can be done without caring
where they live -- it's all just pointers into this giant array. For example:
a register could refer to a stack cell, or a heap cell could point at a stack
cell. The downside is that the stack is no longer adjustable (and things are
a bit less safe).
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Sun, 08 May 2016 21:25:08 +0000 |
| parents |
1184d75b21fe |
| children |
e8934091b7bb |
(in-package #:bones-test.wam)
(def-suite :bones.wam)
(in-suite :bones.wam)
;;;; Setup
(defun make-test-database ()
(let ((db (make-database)))
(with-database db
(facts (always))
(facts (drinks tom :anything)
(drinks kim water)
(drinks alice bourbon)
(drinks bob genny-cream)
(drinks candace birch-beer))
(facts (listens alice blues)
(listens alice jazz)
(listens bob blues)
(listens bob rock)
(listens candace blues))
(facts (fuzzy cats))
(facts (cute cats)
(cute snakes))
(rules ((pets alice :what)
(cute :what))
((pets bob :what)
(cute :what)
(fuzzy :what))
((pets candace :bird)
(flies :bird)))
(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)))
(rules ((narcissist :person)
(likes :person :person))))
db))
(defparameter *test-database* (make-test-database))
;;;; Utils
(defun result= (x y)
(set-equal (plist-alist x)
(plist-alist y)
:test #'equal))
(defun results= (r1 r2)
(set-equal r1 r2 :test #'result=))
(defmacro q (&body query)
`(with-database *test-database*
(return-all ,@query)))
(defmacro check (query)
`(with-database *test-database*
(nth-value 1 (return-one ,query))))
;;;; Tests
(test facts-literal
(is (results= '(nil) (q (always))))
(is (results= '(nil) (q (fuzzy cats))))
(is (results= nil (q (fuzzy snakes)))))
(test facts-variables
(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)))))
(test facts-conjunctions
(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 basic-rules
(is (results= '((:what snakes)
(:what cats))
(q (pets alice :what))))
(is (results= '((:what cats))
(q (pets bob :what))))
(is (results= '()
(q (pets candace :what))))
(is (results= '((:who alice))
(q (pets :who snakes))))
(is (results= '((:who tom)
(:who alice)
(:who kim)
(:who cats))
(q (likes kim :who))))
(is (results= '((:who tom))
(q (likes sally :who))))
(is (results= '((:person kim))
(q (narcissist :person)))))