From 61209cbd3ef78853d4d557e4af70b87debf9265e Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh.local>
Date: Sun, 25 May 2008 15:19:26 -0500
Subject: [PATCH] Growing circulars

---
 extra/circular/circular-tests.factor | 12 ++++++++++++
 extra/circular/circular.factor       | 21 +++++++++++++++++----
 2 files changed, 29 insertions(+), 4 deletions(-)

diff --git a/extra/circular/circular-tests.factor b/extra/circular/circular-tests.factor
index 9023ab1dba..105e3790aa 100755
--- a/extra/circular/circular-tests.factor
+++ b/extra/circular/circular-tests.factor
@@ -27,3 +27,15 @@ circular strings ;
 ! This no longer fails
 ! [ "test" <circular> 5 swap nth ] must-fail
 ! [ "foo" <circular> CHAR: b 3 rot set-nth ] must-fail
+
+[ { } ] [ 3 <growing-circular> >array ] unit-test
+[ { 1 2 } ] [
+    3 <growing-circular>
+    [ 1 swap push-growing-circular ] keep
+    [ 2 swap push-growing-circular ] keep >array
+] unit-test
+[ { 3 4 5 } ] [
+    3 <growing-circular> dup { 1 2 3 4 5 } [
+        swap push-growing-circular
+    ] with each >array
+] unit-test
diff --git a/extra/circular/circular.factor b/extra/circular/circular.factor
index 77dfb55766..5d2378120f 100755
--- a/extra/circular/circular.factor
+++ b/extra/circular/circular.factor
@@ -19,10 +19,6 @@ M: circular length seq>> length ;
 
 M: circular virtual@ circular-wrap seq>> ;
 
-M: circular nth virtual@ nth ;
-
-M: circular set-nth virtual@ set-nth ;
-
 M: circular virtual-seq seq>> ;
 
 : change-circular-start ( n circular -- )
@@ -36,3 +32,20 @@ M: circular virtual-seq seq>> ;
     0 <string> <circular> ;
 
 INSTANCE: circular virtual-sequence
+
+TUPLE: growing-circular < circular length ;
+
+M: growing-circular length length>> ;
+
+: full? ( circular -- ? )
+    [ length ] [ seq>> length ] bi = ;
+
+: set-peek ( elt seq -- )
+    [ length 1- ] keep set-nth ;
+
+: push-growing-circular ( elt circular -- )
+    dup full? [ push-circular ]
+    [ [ 1+ ] change-length set-peek ] if ;
+
+: <growing-circular> ( capacity -- growing-circular )
+    { } new-sequence 0 0 growing-circular boa ;