1 ! Copyright (C) 2005, 2006 Alex Chapman, Daniel Ehrenberg
2 ! See http;//factorcode.org/license.txt for BSD license
3 USING: kernel sequences math sequences.private strings
7 ! a circular sequence wraps another sequence, but begins at an
8 ! arbitrary element in the underlying sequence.
9 TUPLE: circular seq start ;
11 : <circular> ( seq -- circular )
15 : circular-wrap ( n circular -- n circular )
17 [ seq>> length rem ] keep ; inline
20 M: circular length seq>> length ;
22 M: circular virtual@ circular-wrap seq>> ;
24 M: circular virtual-seq seq>> ;
26 : change-circular-start ( n circular -- )
27 #! change start to (start + n) mod length
28 circular-wrap (>>start) ;
30 : rotate-circular ( circular -- )
31 [ start>> 1 + ] keep circular-wrap (>>start) ;
33 : push-circular ( elt circular -- )
34 [ set-first ] [ 1 swap change-circular-start ] bi ;
36 : <circular-string> ( n -- circular )
37 0 <string> <circular> ;
39 INSTANCE: circular virtual-sequence
41 TUPLE: growing-circular < circular length ;
43 M: growing-circular length length>> ;
46 : full? ( circular -- ? )
47 [ length ] [ seq>> length ] bi = ;
49 : set-peek ( elt seq -- )
50 [ length 1- ] keep set-nth ;
53 : push-growing-circular ( elt circular -- )
54 dup full? [ push-circular ]
55 [ [ 1+ ] change-length set-peek ] if ;
57 : <growing-circular> ( capacity -- growing-circular )
58 { } new-sequence 0 0 growing-circular boa ;