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

Clean up circular

db4
Slava Pestov 2008-04-13 00:52:49 -05:00
parent 8110074bc0
commit 3fc06f02ec
1 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
extra/circular/circular.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2005, 2006 Alex Chapman, Daniel Ehrenberg ! Copyright (C) 2005, 2006 Alex Chapman, Daniel Ehrenberg
! See http;//factorcode.org/license.txt for BSD license ! See http;//factorcode.org/license.txt for BSD license
USING: kernel sequences math sequences.private strings ; USING: kernel sequences math sequences.private strings
accessors ;
IN: circular IN: circular
! a circular sequence wraps another sequence, but begins at an ! a circular sequence wraps another sequence, but begins at an
@ -11,27 +12,27 @@ TUPLE: circular seq start ;
0 circular construct-boa ; 0 circular construct-boa ;
: circular-wrap ( n circular -- n circular ) : circular-wrap ( n circular -- n circular )
[ circular-start + ] keep [ start>> + ] keep
[ circular-seq length rem ] keep ; inline [ seq>> length rem ] keep ; inline
M: circular length circular-seq length ; M: circular length seq>> length ;
M: circular virtual@ circular-wrap circular-seq ; M: circular virtual@ circular-wrap seq>> ;
M: circular nth virtual@ nth ; M: circular nth virtual@ nth ;
M: circular set-nth virtual@ set-nth ; M: circular set-nth virtual@ set-nth ;
M: circular virtual-seq seq>> ;
: change-circular-start ( n circular -- ) : change-circular-start ( n circular -- )
#! change start to (start + n) mod length #! change start to (start + n) mod length
circular-wrap set-circular-start ; circular-wrap (>>start) ;
: push-circular ( elt circular -- ) : push-circular ( elt circular -- )
[ set-first ] keep 1 swap change-circular-start ; [ set-first ] [ 1 swap change-circular-start ] bi ;
: <circular-string> ( n -- circular ) : <circular-string> ( n -- circular )
0 <string> <circular> ; 0 <string> <circular> ;
M: circular virtual-seq circular-seq ;
INSTANCE: circular virtual-sequence INSTANCE: circular virtual-sequence