steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Growing circulars

db4
Daniel Ehrenberg 2008-05-25 15:19:26 -05:00
parent 8ac9d9d9b2
commit 61209cbd3e
2 changed files with 29 additions and 4 deletions

12
extra/circular/circular-tests.factor
View File

@ -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

21
extra/circular/circular.factor
View File

@ -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 ;