Implement anonymous variables and the `*_void` opcodes
That was more difficult than I expected. The shitty part was that we have to
thread the anonymous variables way the hell down into the register allocation
phase. I took the opportunity to refactor a bit so further things like this
shouldn't be quite so bad.
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Mon, 04 Jul 2016 23:35:08 +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))))