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

diff --git a/extra/sequences/extras/extras-docs.factor b/extra/sequences/extras/extras-docs.factor
index 6e75c0307bea1b64879213f0c87de13fce35437e..1e9a63042196f3943f56223fc517a7abde290fd1 100644 (file)
--- a/extra/sequences/extras/extras-docs.factor
+++ b/extra/sequences/extras/extras-docs.factor
@@ -1,4 +1,5 @@
-USING: help.markup help.syntax kernel math sequences ;
+USING: arrays help.markup help.syntax kernel math multiline
+quotations sequences ;
 IN: sequences.extras
 
 HELP: ?supremum
@@ -260,3 +261,156 @@ HELP: count-subseq*
     } } ;
 
 { start-all start-all* count-subseq count-subseq* } related-words
+
+HELP: loop>array
+{ $values
+    { "quot" quotation }
+    { "array" array }
+}
+{ $description "Call the " { $snippet "quot" } ", which should output an object or " { $snippet "f" } ", and collect the objects in " { $snippet "array" } " until " { $snippet "quot" } " outputs " { $snippet "f" } "." }
+{ $examples
+    "Example:"
+    { $example "USING: sequences.extras prettyprint io.encodings.binary"
+    "io.streams.byte-array io ;"
+        "B{ 10 20 30 } binary ["
+        "   [ read1 ] loop>array"
+        "] with-byte-reader ."
+        "{ 10 20 30 }"
+    }
+} ;
+
+HELP: loop>array*
+{ $values
+    { "quot" quotation }
+    { "array" array }
+}
+{ $description "Call the " { $snippet "quot" } ", which should output an object and a " { $snippet "bool" } ", and collect the objects in " { $snippet "array" } " until " { $snippet "quot" } " outputs " { $snippet "f" } ". Do collect the last object." }
+{ $examples
+    "Example:"
+    { $example "USING: sequences.extras prettyprint io.encodings.binary"
+               "random random.mersenne-twister kernel math ;"
+    "123 <mersenne-twister> ["
+    "   ["
+    "      10 random dup 5 >"
+    "   ] loop>array* ."
+    "] with-random"
+    "{ 6 7 2 }"
+    }
+} ;
+
+HELP: loop>array**
+{ $values
+    { "quot" quotation }
+    { "array" array }
+}
+{ $description "Call the " { $snippet "quot" } ", which should output an object and a " { $snippet "bool" } ", and collect the objects in " { $snippet "array" } " until " { $snippet "quot" } " outputs " { $snippet "f" } ". Do not collect the last object." }
+{ $examples
+    "Example:"
+    { $example "USING: sequences.extras prettyprint io.encodings.binary"
+               "random random.mersenne-twister kernel math ;"
+    "123 <mersenne-twister> ["
+    "   ["
+    "      10 random dup 5 >"
+    "   ] loop>array** ."
+    "] with-random"
+    "{ 6 7 }"
+    }
+} ;
+
+
+HELP: loop>sequence
+{ $values
+    { "quot" quotation } { "exemplar" object }
+    { "seq" sequence }
+}
+{ $description "Call " { $snippet "quot" } ", which should output an object or " { $snippet "f" } ", and collect the objects in " { $snippet "seq" } " of type " { $snippet "exemplar" } " until " { $snippet "quot" } " outputs " { $snippet "f" } "." }
+{ $examples
+    "Example:"
+    { $example "USING: sequences.extras prettyprint io.encodings.binary"
+               "random random.mersenne-twister kernel math ;"
+    "! Get random numbers until one of them is greater than 5"
+    "! but also output the last number"
+    "123 <mersenne-twister> ["
+    "   ["
+    "      10 random dup 5 >"
+    "   ] loop>array*"
+    "] with-random ."
+    "{ 6 7 2 }"
+    }
+} ;
+
+HELP: loop>sequence*
+{ $values
+    { "quot" quotation } { "exemplar" object }
+    { "seq" sequence }
+}
+{ $description "Call " { $snippet "quot" } ", which should output an object and a " { $snippet "bool" } ", and collect the objects in " { $snippet "seq" } " of type " { $snippet "exemplar" } " until " { $snippet "quot" } " outputs " { $snippet "f" } ". Do collect the last object." }
+{ $examples
+    "Example:"
+    { $example "USING: sequences.extras prettyprint io.encodings.binary"
+               "random random.mersenne-twister kernel math ;"
+    "! Get random numbers until one of them is greater than 5"
+    "! but also output the last number"
+    "123 <mersenne-twister> ["
+    "   ["
+    "      10 random dup 5 >"
+    "   ] V{ } loop>sequence*"
+    "] with-random ."
+    "V{ 6 7 2 }"
+    }
+} ;
+
+HELP: loop>sequence**
+{ $values
+    { "quot" quotation } { "exemplar" object }
+    { "seq" sequence }
+}
+{ $description "Call " { $snippet "quot" } ", which should output an object and a " { $snippet "bool" } ", and collect the objects in " { $snippet "seq" } " of type " { $snippet "exemplar" } " until " { $snippet "quot" } " outputs " { $snippet "f" } ". Do not collect the last object." }
+{ $examples
+    "Example:"
+    { $example "USING: sequences.extras prettyprint io.encodings.binary"
+               "random random.mersenne-twister kernel math ;"
+    "! Get random numbers until one of them is greater than 5"
+    "! but also output the last number"
+    "123 <mersenne-twister> ["
+    "   ["
+    "      10 random dup 5 >"
+    "   ] V{ } loop>sequence**"
+    "] with-random ."
+    "V{ 6 7 }"
+    }
+} ;
+
+{
+    loop>array loop>array* loop>array**
+    loop>sequence loop>sequence* loop>sequence**
+    zero-loop>array zero-loop>sequence
+} related-words
+
+HELP: zero-loop>array
+{ $values
+    { "quot" quotation }
+    { "seq" sequence }
+}
+{ $description "Call " { $snippet "quot" } ", which takes an integer starting from zero and incrementing on every loop, and should output an object, and collect the objects in " { $snippet "array" } " until " { $snippet "quot" } " outputs " { $snippet "f" } "." }
+{ $examples
+    "Example:"
+    { $example "USING: sequences.extras prettyprint math.text.english math kernel ;"
+        "[ dup 5 < [ number>text ] [ drop f ] if ] zero-loop>array ."
+        [[ { "zero" "one" "two" "three" "four" }]]
+    }
+} ;
+
+HELP: zero-loop>sequence
+{ $values
+    { "quot" quotation } { "exemplar" object }
+    { "seq" sequence }
+}
+{ $description "Call the " { $snippet "quot" } ", which takes an integer starting from zero and incrementing on every loop, and should output an object or " { $snippet "f" } ", and collect the objects in " { $snippet "array" } " until " { $snippet "quot" } " outputs " { $snippet "f" } "." }
+{ $examples
+    "Example:"
+    { $example "USING: sequences.extras prettyprint math.text.english math kernel ;"
+        "[ dup 5 < [ number>text ] [ drop f ] if ] V{ } zero-loop>sequence ."
+        [[ V{ "zero" "one" "two" "three" "four" }]]
+    }
+} ;
\ No newline at end of file

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