sequences.unrolled vocab with fixed-length unrolling versions of some each and map...

diff --git a/basis/sequences/unrolled/authors.txt b/basis/sequences/unrolled/authors.txt
new file mode 100644 (file)
index 0000000..f13c9c1
--- /dev/null
+++ b/basis/sequences/unrolled/authors.txt
@@ -0,0 +1 @@
+Joe Groff

diff --git a/basis/sequences/unrolled/summary.txt b/basis/sequences/unrolled/summary.txt
new file mode 100644 (file)
index 0000000..1c9ba01
--- /dev/null
+++ b/basis/sequences/unrolled/summary.txt
@@ -0,0 +1 @@
+Unrolled fixed-length sequence iteration

diff --git a/basis/sequences/unrolled/unrolled-docs.factor b/basis/sequences/unrolled/unrolled-docs.factor
new file mode 100644 (file)
index 0000000..14533d3
--- /dev/null
+++ b/basis/sequences/unrolled/unrolled-docs.factor
@@ -0,0 +1,96 @@
+! (c)2010 Joe Groff bsd license
+USING: help.markup help.syntax kernel math quotations sequences
+sequences.private ;
+IN: sequences.unrolled
+
+HELP: unrolled-collect
+{ $values
+    { "n" integer } { "quot" { $quotation "( ... n -- ... value )" } } { "into" sequence }
+}
+{ $description "Unrolled version of " { $link collect } ". " { $snippet "n" } " must be a compile-time constant." } ;
+
+HELP: unrolled-each
+{ $values
+    { "seq" sequence } { "len" integer } { "quot" { $quotation "( ... x -- ... )" } }
+}
+{ $description "Unrolled version of " { $link each } " that iterates over the first " { $snippet "len" } " elements of " { $snippet "seq" } ". " { $snippet "len" } " must be a compile-time constant. If " { $snippet "seq" } " has fewer than " { $snippet "len" } " elements, raises an " { $link unrolled-bounds-error } "." } ;
+
+HELP: unrolled-2each
+{ $values
+    { "xseq" sequence } { "yseq" sequence } { "len" integer } { "quot" { $quotation "( ... x y -- ... )" } }
+}
+{ $description "Unrolled version of " { $link 2each } " that iterates over the first " { $snippet "len" } " elements of " { $snippet "xseq" } " and " { $snippet "yseq" } ". " { $snippet "len" } " must be a compile-time constant. If " { $snippet "seq" } " has fewer than " { $snippet "len" } " elements, raises an " { $link unrolled-bounds-error } "." } ;
+
+HELP: unrolled-each-index
+{ $values
+    { "seq" sequence } { "len" integer } { "quot" { $quotation "( ... x i -- ... )" } }
+}
+{ $description "Unrolled version of " { $link each-index } " that iterates over the first " { $snippet "len" } " elements of " { $snippet "seq" } ". " { $snippet "len" } " must be a compile-time constant. If " { $snippet "seq" } " has fewer than " { $snippet "len" } " elements, raises an " { $link unrolled-bounds-error } "." } ;
+
+HELP: unrolled-each-integer
+{ $values
+    { "n" integer } { "quot" { $quotation "( ... i -- ... )" } }
+}
+{ $description "Unrolled version of " { $link each-integer } ". " { $snippet "n" } " must be a compile-time constant." } ;
+
+HELP: unrolled-map
+{ $values
+    { "seq" sequence } { "len" integer } { "quot" { $quotation "( ... x -- ... newx )" } }
+    { "newseq" sequence }
+}
+{ $description "Unrolled version of " { $link map } " that maps over the first " { $snippet "len" } " elements of " { $snippet "seq" } ". " { $snippet "len" } " must be a compile-time constant. If " { $snippet "seq" } " has fewer than " { $snippet "len" } " elements, raises an " { $link unrolled-bounds-error } "." } ;
+
+HELP: unrolled-map-as
+{ $values
+    { "seq" sequence } { "len" integer } { "quot" { $quotation "( ... x -- ... newx )" } } { "exemplar" sequence }
+    { "newseq" sequence }
+}
+{ $description "Unrolled version of " { $link map-as } " that maps over the first " { $snippet "len" } " elements of " { $snippet "seq" } ". " { $snippet "len" } " must be a compile-time constant. If " { $snippet "seq" } " has fewer than " { $snippet "len" } " elements, raises an " { $link unrolled-bounds-error } "." } ;
+
+HELP: unrolled-2map
+{ $values
+    { "xseq" sequence } { "yseq" sequence } { "len" integer } { "quot" { $quotation "( ... x y -- ... newx )" } } { "newseq" sequence }
+}
+{ $description "Unrolled version of " { $link 2map } " that iterates over the first " { $snippet "len" } " elements of " { $snippet "xseq" } " and " { $snippet "yseq" } ". " { $snippet "len" } " must be a compile-time constant. If " { $snippet "seq" } " has fewer than " { $snippet "len" } " elements, raises an " { $link unrolled-bounds-error } "." } ;
+
+HELP: unrolled-2map-as
+{ $values
+    { "xseq" sequence } { "yseq" sequence } { "len" integer } { "quot" { $quotation "( ... x y -- ... newx )" } } { "exemplar" sequence } { "newseq" sequence }
+}
+{ $description "Unrolled version of " { $link 2map-as } " that iterates over the first " { $snippet "len" } " elements of " { $snippet "xseq" } " and " { $snippet "yseq" } ". " { $snippet "len" } " must be a compile-time constant. If " { $snippet "seq" } " has fewer than " { $snippet "len" } " elements, raises an " { $link unrolled-bounds-error } "." } ;
+
+HELP: unrolled-map-index
+{ $values
+    { "seq" sequence } { "len" integer } { "quot" { $quotation "( ... x i -- ... newx )" } }
+    { "newseq" sequence }
+}
+{ $description "Unrolled version of " { $link map-index } " that maps over the first " { $snippet "len" } " elements of " { $snippet "seq" } ". " { $snippet "len" } " must be a compile-time constant. If " { $snippet "seq" } " has fewer than " { $snippet "len" } " elements, raises an " { $link unrolled-bounds-error } "." } ;
+
+HELP: unrolled-map-integers
+{ $values
+    { "n" integer } { "quot" { $quotation "( ... n -- ... value )" } } { "exemplar" sequence } { "newseq" sequence }
+}
+{ $description "Unrolled version of " { $link map-integers } ". " { $snippet "n" } " must be a compile-time constant." } ;
+
+ARTICLE: "sequences.unrolled" "Unrolled sequence iteration combinators"
+"The " { $vocab-link "sequences.unrolled" } " vocabulary provides versions of some of the " { $link "sequences-combinators" } " that unroll their loops, that is, expand to a constant number of repetitions of a quotation rather than an explicit loop. These unrolled combinators all require a constant integer value to indicate the number of unrolled iterations to perform."
+$nl
+"Unrolled versions of high-level iteration combinators:"
+{ $subsections
+    unrolled-each
+    unrolled-each-index
+    unrolled-2each
+    unrolled-map
+    unrolled-map-index
+    unrolled-map-as
+    unrolled-2map
+    unrolled-2map-as
+}
+"Unrolled versions of low-level iteration combinators:"
+{ $subsections
+    unrolled-each-integer
+    unrolled-map-integers
+    unrolled-collect
+} ;
+
+ABOUT: "sequences.unrolled"

diff --git a/basis/sequences/unrolled/unrolled-tests.factor b/basis/sequences/unrolled/unrolled-tests.factor
new file mode 100644 (file)
index 0000000..47fdd4f
--- /dev/null
+++ b/basis/sequences/unrolled/unrolled-tests.factor
@@ -0,0 +1,23 @@
+! (c)2010 Joe Groff bsd license
+USING: compiler.test math.parser sequences.unrolled tools.test ;
+IN: sequences.unrolled.tests
+
+[ { "0" "1" "2" } ] [ { 0 1 2 } 3 [ number>string ] unrolled-map ] unit-test
+[ { "0" "1" "2" } ] [ { 0 1 2 } [ 3 [ number>string ] unrolled-map ] compile-call ] unit-test
+
+[ { "0" "1" "2" } ] [ [ { 0 1 2 } 3 [ number>string , ] unrolled-each ] { } make ] unit-test
+
+[ { "a0" "b1" "c2" } ]
+[ [ { "a" "b" "c" } 3 [ number>string append , ] unrolled-each-index ] { } make ] unit-test
+
+[ { "aI" "bII" "cIII" } ]
+[ [ { "a" "b" "c" } { "I" "II" "III" } 3 [ append , ] unrolled-2each ] { } make ] unit-test
+
+[ { "aI" "bII" "cIII" } ]
+[ { "a" "b" "c" } { "I" "II" "III" } 3 [ append ] unrolled-2map ] unit-test
+
+[ { "a0" "b1" "c2" } ]
+[ { "a" "b" "c" } 3 [ number>string append ] unrolled-map-index ] unit-test
+
+[ { 0 1 2 } 4 [ number>string ] unrolled-map ] [ unrolled-bounds-error? ] must-fail-with
+[ { 0 1 2 3 } { 0 1 2 } 4 [ number>string append ] unrolled-2map ] [ unrolled-2bounds-error? ] must-fail-with

diff --git a/basis/sequences/unrolled/unrolled.factor b/basis/sequences/unrolled/unrolled.factor
new file mode 100644 (file)
index 0000000..dd94bfa
--- /dev/null
+++ b/basis/sequences/unrolled/unrolled.factor
@@ -0,0 +1,85 @@
+! (c)2010 Joe Groff bsd license
+USING: combinators.short-circuit fry generalizations kernel
+locals macros math quotations sequences ;
+FROM: sequences.private => (each) (each-index) (collect) (2each) ;
+IN: sequences.unrolled
+
+<PRIVATE
+MACRO: (unrolled-each-integer) ( n -- )
+    [ iota >quotation ] keep '[ _ dip _ napply ] ;
+PRIVATE>
+
+: unrolled-each-integer ( ... n quot: ( ... i -- ... ) -- ... )
+    swap (unrolled-each-integer) ; inline
+
+: unrolled-collect ( ... n quot: ( ... n -- ... value ) into -- ... )
+    (collect) unrolled-each-integer ; inline
+
+: unrolled-map-integers ( ... n quot: ( ... n -- ... value ) exemplar -- ... newseq )
+    [ over ] dip [ [ unrolled-collect ] keep ] new-like ; inline
+
+ERROR: unrolled-bounds-error
+    seq unroll-length ;
+
+ERROR: unrolled-2bounds-error
+    xseq yseq unroll-length ;
+
+<PRIVATE
+: unrolled-bounds-check ( seq len quot -- seq len quot )
+    2over swap length > [ 2over unrolled-bounds-error ] when ; inline
+
+:: unrolled-2bounds-check ( xseq yseq len quot -- xseq yseq len quot )
+    { [ len xseq length > ] [ len yseq length > ] } 0||
+    [ xseq yseq len unrolled-2bounds-error ]
+    [ xseq yseq len quot ] if ; inline
+
+: (unrolled-each) ( seq len quot -- len quot )
+    swapd (each) nip ; inline
+
+: (unrolled-each-index) ( seq len quot -- len quot )
+    swapd (each-index) nip ; inline
+
+: (unrolled-2each) ( xseq yseq len quot -- len quot )
+    [ '[ _ ] 2dip ] dip (2each) nip ; inline
+
+: unrolled-each-unsafe ( ... seq len quot: ( ... x -- ... ) -- ... )
+    (unrolled-each) unrolled-each-integer ; inline
+
+: unrolled-2each-unsafe ( ... xseq yseq len quot: ( ... x y -- ... ) -- ... )
+    (unrolled-2each) unrolled-each-integer ; inline
+
+: unrolled-each-index-unsafe ( ... seq len quot: ( ... x -- ... ) -- ... )
+    (unrolled-each-index) unrolled-each-integer ; inline
+
+: unrolled-map-as-unsafe ( ... seq len quot: ( ... x -- ... newx ) exemplar -- ... newseq )
+    [ (unrolled-each) ] dip unrolled-map-integers ; inline
+
+: unrolled-2map-as-unsafe ( ... xseq yseq len quot: ( ... x y -- ... newx ) exemplar -- ... newseq )
+    [ (unrolled-2each) ] dip unrolled-map-integers ; inline
+
+PRIVATE>
+
+: unrolled-each ( ... seq len quot: ( ... x -- ... ) -- ... )
+    unrolled-bounds-check unrolled-each-unsafe ; inline
+
+: unrolled-2each ( ... xseq yseq len quot: ( ... x y -- ... ) -- ... )
+    unrolled-2bounds-check unrolled-2each-unsafe ; inline
+
+: unrolled-each-index ( ... seq len quot: ( ... x i -- ... ) -- ... )
+    unrolled-bounds-check unrolled-each-index-unsafe ; inline
+
+: unrolled-map-as ( ... seq len quot: ( ... x -- ... newx ) exemplar -- ... newseq )
+    [ unrolled-bounds-check ] dip unrolled-map-as-unsafe ; inline
+
+: unrolled-2map-as ( ... xseq yseq len quot: ( ... x y -- ... newx ) exemplar -- ... newseq )
+    [ unrolled-2bounds-check ] dip unrolled-2map-as-unsafe ; inline
+
+: unrolled-map ( ... seq len quot: ( ... x -- ... newx ) -- ... newseq )
+    pick unrolled-map-as ; inline
+
+: unrolled-2map ( ... xseq yseq len quot: ( ... x y -- ... newx ) -- ... newseq )
+    4 npick unrolled-2map-as ; inline
+
+: unrolled-map-index ( ... seq len quot: ( ... x i -- ... newx ) -- ... newseq )
+    [ dup length iota ] 2dip unrolled-2map ; inline
+