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

sequences.extras: make rotate wrap.

locals-and-roots
John Benediktsson 2016-04-04 11:17:24 -07:00
parent 4c6511a058
commit 1aa8a432c7
2 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/sequences/extras/extras-tests.factor
View File

@ -75,11 +75,15 @@ IN: sequences.extras.tests
{ "hello" "hello" } [ "hello" dup 0 rotate ] unit-test { "hello" "hello" } [ "hello" dup 0 rotate ] unit-test
{ "hello" "llohe" } [ "hello" dup 2 rotate ] unit-test { "hello" "llohe" } [ "hello" dup 2 rotate ] unit-test
{ "hello" "lohel" } [ "hello" dup 13 rotate ] unit-test
{ "hello" "ohell" } [ "hello" dup -1 rotate ] unit-test { "hello" "ohell" } [ "hello" dup -1 rotate ] unit-test
{ "hello" "lohel" } [ "hello" dup -12 rotate ] unit-test
{ "hello" } [ "hello" dup 0 rotate! ] unit-test { "hello" } [ "hello" dup 0 rotate! ] unit-test
{ "lohel" } [ "hello" dup 3 rotate! ] unit-test { "llohe" } [ "hello" dup 2 rotate! ] unit-test
{ "lohel" } [ "hello" dup 13 rotate! ] unit-test
{ "ohell" } [ "hello" dup -1 rotate! ] unit-test { "ohell" } [ "hello" dup -1 rotate! ] unit-test
{ "lohel" } [ "hello" dup -12 rotate! ] unit-test
{ { } } [ { } [ ] map-concat ] unit-test { { } } [ { } [ ] map-concat ] unit-test
{ V{ 0 0 1 0 1 2 } } [ 4 iota [ iota ] map-concat ] unit-test { V{ 0 0 1 0 1 2 } } [ 4 iota [ iota ] map-concat ] unit-test

4
extra/sequences/extras/extras.factor
View File

@ -196,11 +196,11 @@ ERROR: slices-don't-touch slice1 slice2 ;
] if ; ] if ;
: rotate ( seq n -- seq' ) : rotate ( seq n -- seq' )
dup 0 >= [ cut ] [ abs cut* ] if prepend ; over length mod dup 0 >= [ cut ] [ abs cut* ] if prepend ;
:: rotate! ( seq n -- ) :: rotate! ( seq n -- )
seq length :> len seq length :> len
n dup 0 < [ len + ] when seq bounds-check drop 0 over n len mod dup 0 < [ len + ] when seq bounds-check drop 0 over
[ 2dup = ] [ [ 2dup = ] [
[ seq exchange-unsafe ] [ [ 1 + ] bi@ ] 2bi [ seq exchange-unsafe ] [ [ 1 + ] bi@ ] 2bi
dup len = [ drop over ] when dup len = [ drop over ] when