Allow circular clumps with a length smaller than the clump

Conflicts:
	basis/grouping/grouping-tests.factor

diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor
index 83f9173f1fc128e25badf40c4fcc97374389629f..64f277ee940d30d8db08af30ce494e5b7c94a6ed 100644 (file)
--- a/basis/grouping/grouping-docs.factor
+++ b/basis/grouping/grouping-docs.factor
@@ -125,7 +125,7 @@ HELP: clump
 HELP: circular-clump
 { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
 { $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements, wrapping around the end of the sequence, and collects the clumps into a new array." }
-{ $errors "Throws an error if " { $snippet "n" } " is larger than the length of the sequence." }
+{ $notes "For an empty sequence, the result is an empty sequence." }
 { $examples
     { $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 circular-clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } { 7 3 } }" }
 } ;

diff --git a/basis/grouping/grouping-tests.factor b/basis/grouping/grouping-tests.factor
index 50d72bae2673c7f3f60b6afc79bb3675890825e8..605b2b76ce12482fec5032de52fd0020fb95037d 100644 (file)
--- a/basis/grouping/grouping-tests.factor
+++ b/basis/grouping/grouping-tests.factor
@@ -21,12 +21,13 @@ IN: grouping.tests
 { { { 1 2 } } } [ { 1 2 } 2 clump ] unit-test
 { { { 1 2 } { 2 3 } } } [ { 1 2 3 } 2 clump ] unit-test
 
-[ { } 2 <circular-clumps> length ] must-fail
-[ { 1 } 2 <circular-clumps> length ] must-fail
+{ 0 } [ { } 2 <circular-clumps> length ] unit-test
+{ 1 } [ { 1 } 2 <circular-clumps> length ] unit-test
 
 [ 2 ] [ { 1 2 } 2 <circular-clumps> length ] unit-test
 [ 3 ] [ { 1 2 3 } 2 <circular-clumps> length ] unit-test
 
+[ { { 1 1 }                 } ] [ { 1     } 2 circular-clump ] unit-test
 [ { { 1 2 } { 2 1 }         } ] [ { 1 2   } 2 circular-clump ] unit-test
 [ { { 1 2 } { 2 3 } { 3 1 } } ] [ { 1 2 3 } 2 circular-clump ] unit-test
 

diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor
index b2f850cf4992e5eed292c777b542933665cac9a2..c7733b871d4fc171d0bce7fbe92c7a713c1d8b6b 100644 (file)
--- a/basis/grouping/grouping.factor
+++ b/basis/grouping/grouping.factor
@@ -62,12 +62,6 @@ TUPLE: chunking-seq { seq read-only } { n read-only } ;
 : new-groups ( seq n class -- groups )
     [ check-groups ] dip boa ; inline
 
-: slice-mod ( n length -- n' )
-    2dup >= [ - ] [ drop ] if ; inline
-
-: check-circular-clumps ( seq n -- seq n )
-    2dup 1 - swap bounds-check 2drop ; inline
-
 PRIVATE>
 
 TUPLE: groups < chunking-seq ;
@@ -129,7 +123,7 @@ M: circular-slice length [ to>> ] [ from>> ] bi - ; inline
 M: circular-slice virtual-exemplar seq>> ; inline
 
 M: circular-slice virtual@
-    [ from>> + ] [ seq>> ] bi [ length slice-mod ] keep ; inline
+    [ from>> + ] [ seq>> ] bi [ length rem ] keep ; inline
 
 C: <circular-slice> circular-slice
 
@@ -143,7 +137,7 @@ M: sliced-circular-clumps nth
     [ n>> over + ] [ seq>> ] bi <circular-slice> ; inline
 
 : <sliced-circular-clumps> ( seq n -- clumps )
-    check-circular-clumps sliced-circular-clumps boa ; inline
+    sliced-circular-clumps new-groups ; inline
 
 TUPLE: circular-clumps < chunking-seq ;
 INSTANCE: circular-clumps sequence
@@ -155,7 +149,7 @@ M: circular-clumps nth
     [ n>> over + ] [ seq>> ] bi [ <circular-slice> ] [ like ] bi ; inline
 
 : <circular-clumps> ( seq n -- clumps )
-    check-circular-clumps circular-clumps boa ; inline
+    circular-clumps new-groups ; inline
 
 : circular-clump ( seq n -- array )
     <circular-clumps> { } like ; inline