From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 2 Apr 2016 22:17:12 +0000 (-0700)
Subject: sequences.extras: rename rotate to rotate-headwards and rotate-tailwards. add experim... 
X-Git-Tag: unmaintained~1260
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=b4f979c848a3633b64fe12b0606899749c33241c

sequences.extras: rename rotate to rotate-headwards and rotate-tailwards. add experimental length- word and addo some slice util words.
---

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 838259fe9a..6fc8296884 100644
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -46,10 +46,17 @@ IN: sequences.extras.tests
 { { "hello," " " "world!" " " " " } }
 [ "hello, world!  " [ blank? ] slice-when [ >string ] map ] unit-test
 
-{ "hello" } [ "hello" 0 rotate ] unit-test
-{ "llohe" } [ "hello" 2 rotate ] unit-test
-{ "hello" } [ "hello" dup 0 rotate! ] unit-test
-{ "lohel" } [ "hello" dup 3 rotate! ] unit-test
+{ t }
+[ "abc" sequence>slice slice? ] unit-test
+
+{ "abc" }
+[ "abc" sequence>slice >string ] unit-test
+
+
+{ "hello" } [ "hello" 0 rotate-headwards ] unit-test
+{ "llohe" } [ "hello" 2 rotate-headwards ] unit-test
+{ "hello" } [ "hello" dup 0 rotate-headwards! ] unit-test
+{ "lohel" } [ "hello" dup 3 rotate-headwards! ] unit-test
 
 { { } } [ { } [ ] map-concat ] unit-test
 { V{ 0 0 1 0 1 2 } } [ 4 iota [ iota ] map-concat ] unit-test
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 811ec9bc43..c3e5943c03 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -152,10 +152,21 @@ PRIVATE>
 : cut-slice* ( seq n -- before after )
     [ head-slice* ] [ tail-slice* ] 2bi ;
 
-: rotate ( seq n -- seq' )
+: ?<slice> ( from to/f sequence -- slice )
+    over [ nip [ length ] [ ] bi ] unless <slice> ; inline
+
+: sequence>slice ( sequence -- slice )
+    [ drop 0 ] [ length ] [ ] tri <slice> ; inline
+
+: length- ( n sequence -- m ) length swap - ; inline
+
+: rotate-headwards ( seq n -- seq' )
     cut prepend ;
 
-:: rotate! ( seq n -- )
+: rotate-tailwards ( seq n -- seq' )
+    over length- cut prepend ;
+
+:: rotate-headwards! ( seq n -- )
     n seq bounds-check length :> end
     0 n [ 2dup = ] [
         [ seq exchange-unsafe ] [ [ 1 + ] bi@ ] 2bi
@@ -164,7 +175,7 @@ PRIVATE>
     ] until 3drop ;
 
 : all-rotations ( seq -- seq' )
-    dup length iota [ rotate ] with map ;
+    dup length iota [ rotate-headwards ] with map ;
 
 <PRIVATE