# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1463169652 0
# Node ID 14de0f74d3e2cddfdc41a57febb78dc88b019c3b
# Parent  c77968cd3c5197be44c5a43b483f54fdb979d13f
Add a circle data structure

We'll use it for the instruction list soon

diff -r c77968cd3c51 -r 14de0f74d3e2 bones-test.asd
--- a/bones-test.asd	Thu May 12 18:52:30 2016 +0000
+++ b/bones-test.asd	Fri May 13 20:00:52 2016 +0000
@@ -9,6 +9,7 @@
                (:module "test"
                 :serial t
                 :components ((:file "bones")
+                             (:file "circle")
                              (:file "paip")
                              (:file "wam")))))
 
diff -r c77968cd3c51 -r 14de0f74d3e2 bones.asd
--- a/bones.asd	Thu May 12 18:52:30 2016 +0000
+++ b/bones.asd	Fri May 13 20:00:52 2016 +0000
@@ -22,6 +22,7 @@
                 :serial t
                 :components ((:file "paip")
                              (:file "utils")
+                             (:file "circle")
                              (:module "wam"
                               :serial t
                               :components ((:file "constants")
diff -r c77968cd3c51 -r 14de0f74d3e2 package-test.lisp
--- a/package-test.lisp	Thu May 12 18:52:30 2016 +0000
+++ b/package-test.lisp	Fri May 13 20:00:52 2016 +0000
@@ -27,3 +27,6 @@
     #:facts
     #:return-one
     #:return-all))
+
+(defpackage #:bones-test.circle
+  (:use :cl :5am :bones.circle))
diff -r c77968cd3c51 -r 14de0f74d3e2 package.lisp
--- a/package.lisp	Thu May 12 18:52:30 2016 +0000
+++ b/package.lisp	Fri May 13 20:00:52 2016 +0000
@@ -13,12 +13,44 @@
     #:topological-sort
     #:push-if-new))
 
+(defpackage #:bones.circle
+  (:use #:cl #:defstar)
+  (:export
+    #:make-circle-with
+    #:make-empty-circle
+    #:circle-to-list
+    #:circle-prepend
+    #:circle-append
+    #:circle-forward
+    #:circle-backward
+    #:circle-value
+    #:circle-rotate
+    #:circle-nth
+    #:circle-insert-before
+    #:circle-insert-after
+    #:circle-sentinel-p
+    #:circle-empty-p
+    #:circle-remove
+    #:circle-backward-remove
+    #:circle-forward-remove
+    #:circle-replace
+    #:circle-backward-replace
+    #:circle-forward-replace
+    #:circle-splice
+    #:circle-backward-splice
+    #:circle-forward-splice
+    #:circle-insert-beginning
+    #:circle-insert-end
+    )
+  )
+
 (defpackage #:bones.wam
   (:use
     #:cl
     #:defstar
     #:optima
     #:cl-arrows
+    #:bones.circle
     #:bones.quickutils
     #:bones.utils)
   (:import-from #:optima
diff -r c77968cd3c51 -r 14de0f74d3e2 src/circle.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/circle.lisp	Fri May 13 20:00:52 2016 +0000
@@ -0,0 +1,285 @@
+(in-package #:bones.circle)
+
+;;;; Circular, Doubly-Linked Lists
+;;; If you found this through a Google search or a link or something, turn back
+;;; now.  You probably don't want this.
+;;;
+;;; When we're creating and optimizing the WAM instructions (before rendering
+;;; into bytecode) it would be really nice to have a data structure that
+;;; supports a few things:
+;;;
+;;; * O(1) appending (when building the initial list of instructions)
+;;; * O(n) forward traversal (when rendering and optimizing for `set_constant`)
+;;; * O(n) backward traversal (when optimizing for `unify_constant`)
+;;; * In-place removal/replacement, with the ability to choose "which side we
+;;;   move to" after.
+;;;
+;;; That last one is tricky.  We want to be able to remove/replace/splice
+;;; elements during a single traversal.  For example, we want to perform the
+;;; following optimization for constants (taken from the WAM book erratum):
+;;;
+;;;     unify_variable Xi     -> unify_constant c
+;;;     ...
+;;;     get_structure c/0, Xi
+;;;
+;;; The nicest way to do this would be something like:
+;;;
+;;; 1. Iterate backward from end to start.
+;;; 2. When we see a `:get-structure-* CONSTANT LOCALREG` instruction:
+;;;   A. Remove it in-place, so the next node will be processed on the next
+;;;      iteration (remember, we're iterating backwards).
+;;;   B. Search forward for the corresponding `:unify-variable` instruction and
+;;;      replace it in-place with the `:unify-constant` instruction.
+;;;
+;;; Of course you could do all this with immutable data structures, but it'll be
+;;; pretty slow.  And since one of the primary goals of this project is to be
+;;; fast, we don't want to do slow things.
+;;;
+;;; So instead we make our own data structure for the list of WAM instructions.
+;;; A "circle" is a circular, doubly-linked list, with a sentinel node to denote
+;;; the start/end of the list.
+;;;
+;;; TODO: explain further
+;;; TODO: docstrings below
+
+(defparameter *circle-sentinel* 'circle-sentinel)
+
+
+(declaim (inline circle-prev circle-value circle-next))
+
+(defstruct circle prev value next)
+
+
+(declaim (inline circle-tie))
+(defun* circle-tie ((c1 circle) (c2 circle))
+  (:returns :void)
+  (setf (circle-next c1) c2
+        (circle-prev c2) c1)
+  (values))
+
+
+(defun* make-empty-circle ()
+  (:returns circle)
+  "Create an empty circle.
+
+  It will still contain a sentinel.
+
+  "
+  (let ((circle (make-circle :value *circle-sentinel*)))
+    (setf (slot-value circle 'prev) circle
+          (slot-value circle 'next) circle)
+    circle))
+
+(defun* make-circle-with ((list list))
+  "Create a circle whose nodes contain the values in `list`."
+  (:returns circle)
+  (let ((sentinel (make-empty-circle)))
+    (loop :with prev = sentinel
+          :for value :in list
+          :for current = (make-circle :prev prev
+                                      :value value)
+          :do (setf (circle-next prev) current
+                    prev current)
+          :finally (unless (null list)
+                     (circle-tie current sentinel)))
+    sentinel))
+
+
+(defun* circle-sentinel-p ((circle circle))
+  (:returns boolean)
+  "Return whether this circle node is the sentinel."
+  (eql (circle-value circle) *circle-sentinel*))
+
+(defun* circle-empty-p ((circle circle))
+  (:returns boolean)
+  "Return whether this circle is empty."
+  (and (circle-sentinel-p circle)
+       (eql circle (circle-next circle))))
+
+
+(defun* circle-rotate ((circle circle) (n integer))
+  (:returns circle)
+  (cond
+    ((zerop n) circle)
+    ((> n 0) (circle-rotate (circle-next circle) (1- n)))
+    ((< n 0) (circle-rotate (circle-prev circle) (1+ n)))))
+
+(defun* circle-nth ((circle circle) (n integer))
+  (:returns circle)
+  (assert (circle-sentinel-p circle) ()
+    "Can only call circle-nth on the sentinel.")
+  (circle-rotate circle
+                 (if (< n 0)
+                   n
+                   (1+ n))))
+
+
+(defun* circle-insert-before ((circle circle) value)
+  (:returns :void)
+  ;; L new old R
+  (let ((old circle)
+        (l (circle-prev circle))
+        ; (r (circle-next circle))
+        (new (make-circle :value value)))
+    (circle-tie l new)
+    (circle-tie new old))
+  (values))
+
+(defun* circle-insert-after ((circle circle) value)
+  (:returns :void)
+  ;; L old new R
+  (let ((old circle)
+        ; (l (circle-prev circle))
+        (r (circle-next circle))
+        (new (make-circle :value value)))
+    (circle-tie old new)
+    (circle-tie new r))
+  (values)
+  )
+
+
+(defun* circle-insert-beginning ((circle circle) value)
+  (:returns :void)
+  (assert (circle-sentinel-p circle) ()
+    "Can only insert-beginning at the sentinel.")
+  (circle-insert-after circle value))
+
+(defun* circle-insert-end ((circle circle) value)
+  (:returns :void)
+  (assert (circle-sentinel-p circle) ()
+    "Can only insert-end at the sentinel.")
+  (circle-insert-before circle value))
+
+
+(defun* circle-prepend ((circle circle) values)
+  (:returns :void)
+  (assert (circle-sentinel-p circle) ()
+    "Can only prepend to the sentinel.")
+  ;; S new-first ... new-last R
+  (if (null values)
+    circle
+    (let ((s circle)
+          (r (circle-next circle))
+          (new (make-circle-with values)))
+      (circle-tie s (circle-next new))
+      (circle-tie (circle-prev new) r)))
+  (values))
+
+(defun* circle-append ((circle circle) values)
+  (:returns :void)
+  (assert (circle-sentinel-p circle) ()
+    "Can only prepend to the sentinel.")
+  ;; L new-first ... new-last S
+  (if (null values)
+    circle
+    (let ((s circle)
+          (l (circle-prev circle))
+          (new (make-circle-with values)))
+      (circle-tie l (circle-next new))
+      (circle-tie (circle-prev new) s)))
+  (values))
+
+
+(defun* circle-forward ((circle circle))
+  (:returns (or circle null))
+  (let ((next (circle-next circle)))
+    (when (not (circle-sentinel-p next))
+      next)))
+
+(defun* circle-backward ((circle circle))
+  (:returns (or circle null))
+  (let ((prev (circle-prev circle)))
+    (when (not (circle-sentinel-p prev))
+      prev)))
+
+
+(defun* circle-remove ((circle circle))
+  (:returns :void)
+  ;; L rem R
+  (assert (not (circle-sentinel-p circle)) () "Cannot remove sentinel.")
+  (let ((l (circle-prev circle))
+        (r (circle-next circle)))
+    (circle-tie l r))
+  (values))
+
+(defun* circle-backward-remove ((circle circle))
+  (:returns (or circle null))
+  (prog1
+      (circle-backward circle)
+    (circle-remove circle)))
+
+(defun* circle-forward-remove ((circle circle))
+  (:returns (or circle null))
+  (prog1
+      (circle-forward circle)
+    (circle-remove circle)))
+
+
+(defun* circle-replace ((circle circle) value)
+  (:returns :void)
+  (assert (not (circle-sentinel-p circle)) ()
+    "Cannot replace sentinel.")
+  ;; L new R
+  (let ((l (circle-prev circle))
+        (r (circle-next circle))
+        (new (make-circle :value value)))
+    (circle-tie l new)
+    (circle-tie new r))
+  (values))
+
+(defun* circle-backward-replace ((circle circle) value)
+  (:returns (or circle null))
+  (prog1
+      (circle-backward circle)
+    (circle-replace circle value)))
+
+(defun* circle-forward-replace ((circle circle) value)
+  (:returns (or circle null))
+  (prog1
+      (circle-forward circle)
+    (circle-replace circle value)))
+
+
+(defun* circle-splice ((circle circle) values)
+  (:returns :void)
+  (if (null values)
+    (circle-remove circle)
+    (progn
+      (assert (not (circle-sentinel-p circle)) ()
+        "Cannot splice sentinel.")
+      ;; L new-first ... new-last R
+      (let ((l (circle-prev circle))
+            (r (circle-next circle))
+            (new (make-circle-with values)))
+        (circle-tie l (circle-next new))
+        (circle-tie (circle-prev new) r))))
+  (values))
+
+(defun* circle-backward-splice ((circle circle) values)
+  (:returns (or circle null))
+  (prog1
+      (circle-backward circle)
+    (circle-splice circle values)))
+
+(defun* circle-forward-splice ((circle circle) values)
+  (:returns (or circle null))
+  (prog1
+      (circle-forward circle)
+    (circle-splice circle values)))
+
+
+(defun* circle-to-list ((circle circle) &optional include-sentinel-p)
+  (:returns list)
+  (loop
+    :with node = circle
+    :when (or include-sentinel-p
+              (not (circle-sentinel-p node)))
+    :collect (circle-value node) :into results
+    :do (setf node (circle-next node))
+    :when (eql node circle) :do (return results)))
+
+
+(defmethod print-object ((object circle) stream)
+  (print-unreadable-object (object stream :type t :identity nil)
+    (format stream "~S" (subst '%%% *circle-sentinel* (circle-to-list object t)))))
+
diff -r c77968cd3c51 -r 14de0f74d3e2 src/utils.lisp
--- a/src/utils.lisp	Thu May 12 18:52:30 2016 +0000
+++ b/src/utils.lisp	Fri May 13 20:00:52 2016 +0000
@@ -83,3 +83,5 @@
                     (remove minimal-element remaining-elements :test test)
                     (cons minimal-element result))))))
     (reverse (recur constraints elements (list)))))
+
+
diff -r c77968cd3c51 -r 14de0f74d3e2 test/circle.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/circle.lisp	Fri May 13 20:00:52 2016 +0000
@@ -0,0 +1,305 @@
+(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))))
diff -r c77968cd3c51 -r 14de0f74d3e2 test/run.lisp
--- a/test/run.lisp	Thu May 12 18:52:30 2016 +0000
+++ b/test/run.lisp	Fri May 13 20:00:52 2016 +0000
@@ -10,8 +10,9 @@
     (when (not (5am:results-status result))
       (setf *passed* nil))))
 
-(test :bones)
-(test :bones.paip)
-(test :bones.wam)
+; (test :bones)
+; (test :bones.paip)
+; (test :bones.wam)
+(test :bones.circle)
 
 (sb-ext:exit :code (if *passed* 0 1))