Add precompilation of static queries at compile time
Imagine a function like this:
(defun legal-moves ()
(query (legal ?who ?move)))
The argument to `query` there is constant, so we can compile it into WAM
bytecode once, when the Lisp function around it is compiled. Then running the
query doesn't need to touch the Bones compiler -- it can just load the bytecode
from an array and first up the VM loop.
This saves a lot of time (and consing) compared to compiling the same query over
and over at runtime.
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Sun, 17 Jul 2016 16:49:06 +0000 |
| parents |
5c914fbcb042 |
| children |
f872f5b60d73 |
(in-package #:bones-test.circle)
(defmacro is-circle-contents (circle values)
`(is (equal ,values
(circle-to-list ,circle))))
(test empty-circles
(is (circle-empty-p (make-empty-circle)))
(is (circle-empty-p (make-circle-with nil)))
(is (not (circle-empty-p (make-circle-with (list 1))))))
(test making-circle-with
(is-circle-contents
(make-circle-with (list))
nil)
(is-circle-contents
(make-circle-with (list 1 2 3))
(list 1 2 3))
(is-circle-contents
(make-circle-with '(foo))
(list 'foo))
(is-circle-contents
(make-circle-with '((foo)))
(list (list 'foo))))
(test prepending
(let ((c (make-empty-circle)))
(is-circle-contents c nil)
(circle-prepend c (list 1))
(is-circle-contents c '(1))
(circle-prepend c (list 2 3))
(is-circle-contents c '(2 3 1))
(circle-prepend c nil)
(is-circle-contents c '(2 3 1))))
(test appending
(let ((c (make-empty-circle)))
(is-circle-contents c nil)
(circle-append c (list 1))
(is-circle-contents c '(1))
(circle-append c (list 2 3))
(is-circle-contents c '(1 2 3))
(circle-append c nil)
(is-circle-contents c '(1 2 3))))
(test appending-and-prepending
(let ((c (make-empty-circle)))
(is-circle-contents c nil)
(circle-append c (list 1))
(is-circle-contents c '(1))
(circle-prepend c (list 'a 'b))
(is-circle-contents c '(a b 1))
(circle-append c (list 'p 'q))
(is-circle-contents c '(a b 1 p q))))
(test moving-forward
(let ((c (make-circle-with (list 1 2 3 4))))
(is (equal
'(1 2 3 4)
(loop :for node = (circle-forward c) :then (circle-forward node)
:while node
:collect (circle-value node))))))
(test moving-backward
(let ((c (make-circle-with (list 1 2 3 4))))
(is (equal
'(4 3 2 1)
(loop :for node = (circle-backward c) :then (circle-backward node)
:while node
:collect (circle-value node))))))
(test rotating
(let ((c (make-circle-with (list 1 2 3 4))))
(is-circle-contents (circle-rotate c 0)
'(1 2 3 4))
(is-circle-contents (circle-rotate c 1)
'(1 2 3 4))
(is-circle-contents (circle-rotate c 2)
'(2 3 4 1))
(is-circle-contents (circle-rotate c 3)
'(3 4 1 2))
(is-circle-contents (circle-rotate c 4)
'(4 1 2 3))
(is-circle-contents (circle-rotate c 5)
'(1 2 3 4))
(is-circle-contents (circle-rotate c -1)
'(4 1 2 3))
(is-circle-contents (circle-rotate c -2)
'(3 4 1 2))
(is-circle-contents (circle-rotate c -3)
'(2 3 4 1))
(is-circle-contents (circle-rotate c -4)
'(1 2 3 4))
(is-circle-contents (circle-rotate (circle-rotate c 2) 0)
'(2 3 4 1))
(is-circle-contents (circle-rotate (circle-rotate c 2) 1)
'(3 4 1 2))
(is-circle-contents (circle-rotate (circle-rotate c 2) 2)
'(4 1 2 3))
(is-circle-contents (circle-rotate (circle-rotate c 2) -2)
'(1 2 3 4))
(is-circle-contents (circle-rotate (circle-rotate c 3) -1)
'(2 3 4 1))))
(test retrieving-nth
(let* ((data (list 'a 'b 'c 'd))
(c (make-circle-with data)))
(loop :for i :from 0 :below 4
:for v :in data
:do (is (eql v (circle-value (circle-nth c i)))))))
(test inserting-before
(let ((c (make-circle-with (list 1 2 3))))
(circle-insert-before c 'a)
(is-circle-contents c '(1 2 3 a))
(circle-insert-before (circle-nth c 0) 'b)
(is-circle-contents c '(b 1 2 3 a))
(circle-insert-before (circle-nth c 1) 'c)
(is-circle-contents c '(b c 1 2 3 a))
(circle-insert-before (circle-nth c 2) 'd)
(is-circle-contents c '(b c d 1 2 3 a))
(circle-insert-before (circle-nth c -1) 'e)
(is-circle-contents c '(b c d 1 2 3 e a))))
(test inserting-after
(let ((c (make-circle-with (list 1 2 3))))
(circle-insert-after c 'a)
(is-circle-contents c '(a 1 2 3))
(circle-insert-after (circle-nth c 0) 'b)
(is-circle-contents c '(a b 1 2 3))
(circle-insert-after (circle-nth c 1) 'c)
(is-circle-contents c '(a b c 1 2 3))
(circle-insert-after (circle-nth c 2) 'd)
(is-circle-contents c '(a b c d 1 2 3))
(circle-insert-after (circle-nth c -1) 'x)
(is-circle-contents c '(a b c d 1 2 3 x))))
(test checking-sentinel
(let ((c (make-circle-with (list 1 2 3))))
(is (circle-sentinel-p c))
(is (not (circle-sentinel-p (circle-nth c 0))))
(is (not (circle-sentinel-p (circle-nth c 1))))
(is (not (circle-sentinel-p (circle-nth c 2))))
(is (circle-sentinel-p (circle-nth c 3))))
(is (circle-sentinel-p (make-empty-circle)))
(is (circle-sentinel-p (circle-nth (make-empty-circle) 0)))
(is (circle-sentinel-p (circle-nth (make-empty-circle) -1))))
(test removing
(let ((c (make-circle-with (list 1 2 3))))
(signals simple-error (circle-remove c))
(is-circle-contents c '(1 2 3))
(circle-remove (circle-nth c 0))
(is-circle-contents c '(2 3))
(circle-remove (circle-nth c 1))
(is-circle-contents c '(2))
(circle-remove (circle-nth c 0))
(is-circle-contents c '())))
(test removing-backward
(let ((c (make-circle-with (list 1 2 3 4 5 6))))
(is-circle-contents c '(1 2 3 4 5 6))
(is-circle-contents (circle-backward-remove (circle-nth c 1))
'(1 3 4 5 6))
(is (not (circle-backward-remove (circle-nth c 0))))
(is-circle-contents c '(3 4 5 6))
(is-circle-contents (circle-backward-remove (circle-nth c -1))
'(5 3 4))
(is-circle-contents c '(3 4 5))))
(test removing-forward
(let ((c (make-circle-with (list 1 2 3 4 5 6))))
(is-circle-contents c '(1 2 3 4 5 6))
(is-circle-contents (circle-forward-remove (circle-nth c 1))
'(3 4 5 6 1))
(is (not (circle-forward-remove (circle-nth c -1))))
(is-circle-contents c '(1 3 4 5))))
(test replacing
(let ((c (make-circle-with (list 1 2 3 4 5 6))))
(is-circle-contents c '(1 2 3 4 5 6))
(circle-replace (circle-nth c 0) 'foo)
(is-circle-contents c '(foo 2 3 4 5 6))
(circle-replace (circle-nth c 0) 'bar)
(is-circle-contents c '(bar 2 3 4 5 6))
(circle-replace (circle-nth c 1) 'a)
(is-circle-contents c '(bar a 3 4 5 6))
(circle-replace (circle-nth c 2) 'b)
(is-circle-contents c '(bar a b 4 5 6))
(circle-replace (circle-nth c -1) 'c)
(is-circle-contents c '(bar a b 4 5 c))))
(test replacing-backward
(let ((c (make-circle-with (list 1 2 3 4 5 6))))
(is-circle-contents c '(1 2 3 4 5 6))
(is-circle-contents (circle-backward-replace (circle-nth c 1) 'foo)
'(1 foo 3 4 5 6))
(is-circle-contents (circle-backward-replace (circle-nth c 1) 'bar)
'(1 bar 3 4 5 6))
(is-circle-contents (circle-backward-replace (circle-nth c 2) 'a)
'(bar a 4 5 6 1))
(is (not (circle-backward-replace (circle-nth c 0) 'dogs)))
(is-circle-contents c '(dogs bar a 4 5 6))))
(test replacing-forward
(let ((c (make-circle-with (list 1 2 3 4 5 6))))
(is-circle-contents c '(1 2 3 4 5 6))
(is-circle-contents (circle-forward-replace (circle-nth c 1) 'foo)
'(3 4 5 6 1 foo))
(is-circle-contents (circle-forward-replace (circle-nth c 1) 'bar)
'(3 4 5 6 1 bar))
(is (not (circle-forward-replace (circle-nth c -1) 'cats)))
(is-circle-contents c '(1 bar 3 4 5 cats))))
(test splicing
(let ((c (make-circle-with (list 1 2 3 4 5 6))))
(is-circle-contents c '(1 2 3 4 5 6))
(circle-splice (circle-nth c 0) (list 'a 'b))
(is-circle-contents c '(a b 2 3 4 5 6))
(circle-splice (circle-nth c 1) (list 'c))
(is-circle-contents c '(a c 2 3 4 5 6))
(circle-splice (circle-nth c -1) (list 'dogs 'cats))
(is-circle-contents c '(a c 2 3 4 5 dogs cats))
(circle-splice (circle-nth c 3) nil)
(is-circle-contents c '(a c 2 4 5 dogs cats))))
(test splicing-backward
(let ((c (make-circle-with (list 1 2 3 4 5 6))))
(is-circle-contents c '(1 2 3 4 5 6))
(is-circle-contents (circle-backward-splice (circle-nth c 2) '(a b))
'(2 a b 4 5 6 1))
(is-circle-contents (circle-backward-splice (circle-nth c -1) '())
'(5 1 2 a b 4))
(is (not (circle-backward-splice (circle-nth c 0) '(first second))))
(is-circle-contents c '(first second 2 a b 4 5))))
(test splicing-forward
(let ((c (make-circle-with (list 1 2 3 4 5 6))))
(is-circle-contents c '(1 2 3 4 5 6))
(is-circle-contents (circle-forward-splice (circle-nth c 0) '(a b))
'(2 3 4 5 6 a b))
(is-circle-contents (circle-forward-splice (circle-nth c 1) '())
'(2 3 4 5 6 a))
(is (not (circle-forward-splice (circle-nth c -1) '(last))))
(is-circle-contents c '(a 2 3 4 5 last))))