Use a queues instead of lists for the logic frame pending predicates
I wonder if this is ACTUALLY faster, since often there will probably only be
a couple of entries in a particular predicate's list? But then again there are
some HUGE predicates (e.g. successor relations), so it'll benefit us there.
Either way, conceptually the thing should be FIFO, so as long as using queues
doesn't COST us performance I'm happy.
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Tue, 05 Jul 2016 23:37:14 +0000 |
| parents |
14de0f74d3e2 |
| children |
5c914fbcb042 |
(in-package #:bones-test.circle)
(def-suite :bones.circle)
(in-suite :bones.circle)
(defmacro is-circle-contents (circle values)
`(is (equal ,values
(circle-to-list ,circle))))
(test empty-circles
(is-true (circle-empty-p (make-empty-circle)))
(is-true (circle-empty-p (make-circle-with nil)))
(is-false (circle-empty-p (make-circle-with (list 1)))))
(test make-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 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 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 rotate
(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 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 insert-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 insert-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 sentinel-p
(let ((c (make-circle-with (list 1 2 3))))
(is-true (circle-sentinel-p c))
(is-false (circle-sentinel-p (circle-nth c 0)))
(is-false (circle-sentinel-p (circle-nth c 1)))
(is-false (circle-sentinel-p (circle-nth c 2)))
(is-true (circle-sentinel-p (circle-nth c 3))))
(is-true (circle-sentinel-p (make-empty-circle)))
(is-true (circle-sentinel-p (circle-nth (make-empty-circle) 0)))
(is-true (circle-sentinel-p (circle-nth (make-empty-circle) -1))))
(test remove
(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 backward-remove
(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-false (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 forward-remove
(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-false (circle-forward-remove (circle-nth c -1)))
(is-circle-contents c '(1 3 4 5))))
(test replace
(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 backward-replace
(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-false (circle-backward-replace (circle-nth c 0) 'dogs))
(is-circle-contents c '(dogs bar a 4 5 6))))
(test forward-replace
(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-false (circle-forward-replace (circle-nth c -1) 'cats))
(is-circle-contents c '(1 bar 3 4 5 cats))))
(test splice
(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 backward-splice
(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-false (circle-backward-splice (circle-nth c 0) '(first second)))
(is-circle-contents c '(first second 2 a b 4 5))))
(test forward-splice
(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-false (circle-forward-splice (circle-nth c -1) '(last)))
(is-circle-contents c '(a 2 3 4 5 last))))