sequences.extras: Add loop>array** and document all related words.

[factor.git] / extra / sequences / extras / extras.factor

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index bbbb9d71f6f160210d345cb487e618a53e2d72e1..5fa817f77bd9942eeb556645775b348883363fad 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -447,15 +447,29 @@ PRIVATE>
 : loop>sequence ( quot: ( ..a -- ..a obj/f ) exemplar -- seq )
    [ '[ [ @ [ [ , ] when* ] keep ] loop ] ] dip make ; inline
 
-: loop>array ( quot: ( ..a -- ..a obj/f ) -- seq )
+: loop>array ( quot: ( ..a -- ..a obj/f ) -- array )
    { } loop>sequence ; inline
 
 : loop>sequence* ( quot: ( ..a -- ..a obj ? ) exemplar -- seq )
     [ '[ [ @ [ [ , ] when* ] [ ] bi* ] loop ] ] dip make ; inline
 
-: loop>array* ( quot: ( ..a -- ..a obj ? ) -- seq )
+: loop>array* ( quot: ( ..a -- ..a obj ? ) -- array )
    { } loop>sequence* ; inline
 
+: loop>sequence** ( quot: ( ..a -- ..a obj ? ) exemplar -- seq )
+    [
+        '[
+            [
+                @
+                [ [ , ] [ drop ] if ]
+                [ nip ] 2bi
+            ] loop
+        ]
+    ] dip make ; inline
+
+: loop>array** ( quot: ( ..a -- ..a obj ? ) -- array )
+   { } loop>sequence** ; inline
+
 : with-pre-incrementer ( quot: ( ..a n -- ..a obj/f ) seq -- quot: ( ..a n -- ..a obj/f ) )
     [ -1 ] 2dip
     [ [ 1 + dup ] prepose ] dip