Name the subterm-handling instructions something not completely stupid
The `unify-*` instructions in the original WAM are used both in both program
mode and query mode. In program mode, they are used to unify subterms of
arguments with things. In query mode, they are used to write the subterms of
the arguments into the head.
You may have noticed the common word in both of these descriptions is "subterm"
and not "unify". Let's use that word to name the instructions so it's less
confusing.
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Sun, 10 Jul 2016 14:28:48 +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))))