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

circular: Fix rotate-circular

Slava Pestov 2009-06-09 18:28:53 -05:00
parent e4bce2615f
commit 2fa3b8c57a
2 changed files with 3 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/circular/circular-tests.factor
View File

@ -13,6 +13,7 @@ circular strings ;
[ [ 1 2 3 ] ] [ { 1 2 3 } <circular> [ ] like ] unit-test [ [ 1 2 3 ] ] [ { 1 2 3 } <circular> [ ] like ] unit-test
[ [ 2 3 1 ] ] [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test [ [ 2 3 1 ] ] [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test
[ [ 3 1 2 ] ] [ { 1 2 3 } <circular> [ rotate-circular ] keep [ rotate-circular ] keep [ ] like ] unit-test
[ [ 2 3 1 ] ] [ { 1 2 3 } <circular> 1 over change-circular-start [ ] like ] unit-test [ [ 2 3 1 ] ] [ { 1 2 3 } <circular> 1 over change-circular-start [ ] like ] unit-test
[ [ 3 1 2 ] ] [ { 1 2 3 } <circular> 1 over change-circular-start 1 over change-circular-start [ ] like ] unit-test [ [ 3 1 2 ] ] [ { 1 2 3 } <circular> 1 over change-circular-start 1 over change-circular-start [ ] like ] unit-test
[ [ 3 1 2 ] ] [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test [ [ 3 1 2 ] ] [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test

4
basis/circular/circular.factor
View File

@ -28,10 +28,10 @@ M: circular virtual-seq seq>> ;
circular-wrap (>>start) ; circular-wrap (>>start) ;
: rotate-circular ( circular -- ) : rotate-circular ( circular -- )
[ start>> 1 + ] keep circular-wrap (>>start) ; [ 1 ] dip change-circular-start ;
: push-circular ( elt circular -- ) : push-circular ( elt circular -- )
[ set-first ] [ 1 swap change-circular-start ] bi ; [ set-first ] [ rotate-circular ] bi ;
: <circular-string> ( n -- circular ) : <circular-string> ( n -- circular )
0 <string> <circular> ; 0 <string> <circular> ;