factor: trim using lists

[factor.git] / basis / sequences / unrolled / unrolled.factor

diff --git a/basis/sequences/unrolled/unrolled.factor b/basis/sequences/unrolled/unrolled.factor
index dd94bfa9418f072bd5ce2663b1a22f65593f6925..a6a408f7145a1f037cdd1bc5cb8e642ab57eba74 100644 (file)
--- a/basis/sequences/unrolled/unrolled.factor
+++ b/basis/sequences/unrolled/unrolled.factor
@@ -1,22 +1,31 @@
-! (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) ;
+! Copyright (C) 2010 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators combinators.short-circuit
+compiler.tree.propagation.transforms kernel math
+sequences sequences.private ;
 IN: sequences.unrolled
 
 <PRIVATE
-MACRO: (unrolled-each-integer) ( n -- )
-    [ iota >quotation ] keep '[ _ dip _ napply ] ;
+: (unrolled-each-integer) ( quot n -- )
+    swap '[ _ call( i -- ) ] each-integer ;
+
+<< \ (unrolled-each-integer) [
+    <iota> [ '[ _ swap call( i -- ) ] ] [ ] map-as '[ _ cleave ]
+] 1 define-partial-eval >>
+
+: (unrolled-collect) ( quot into -- quot' )
+    '[ dup @ swap _ set-nth-unsafe ] ; inline
+
 PRIVATE>
 
-: unrolled-each-integer ( ... n quot: ( ... i -- ... ) -- ... )
+: unrolled-each-integer ( n quot: ( i -- ) -- )
     swap (unrolled-each-integer) ; inline
 
-: unrolled-collect ( ... n quot: ( ... n -- ... value ) into -- ... )
-    (collect) unrolled-each-integer ; inline
+: unrolled-collect ( n quot: ( n -- value ) into -- )
+    (unrolled-collect) unrolled-each-integer ; inline
 
-: unrolled-map-integers ( ... n quot: ( ... n -- ... value ) exemplar -- ... newseq )
-    [ over ] dip [ [ unrolled-collect ] keep ] new-like ; inline
+: unrolled-map-integers ( n quot: ( n -- value ) exemplar -- newseq )
+    overd [ [ unrolled-collect ] keep ] new-like ; inline
 
 ERROR: unrolled-bounds-error
     seq unroll-length ;
@@ -34,52 +43,57 @@ ERROR: unrolled-2bounds-error
     [ xseq yseq len quot ] if ; inline
 
 : (unrolled-each) ( seq len quot -- len quot )
-    swapd (each) nip ; inline
+    swapd '[ _ nth-unsafe @ ] ; inline
 
 : (unrolled-each-index) ( seq len quot -- len quot )
-    swapd (each-index) nip ; inline
+    swapd '[ dup _ nth-unsafe swap @ ] ; inline
 
 : (unrolled-2each) ( xseq yseq len quot -- len quot )
     [ '[ _ ] 2dip ] dip (2each) nip ; inline
 
-: unrolled-each-unsafe ( ... seq len quot: ( ... x -- ... ) -- ... )
+: unrolled-each-unsafe ( seq len quot: ( x -- ) -- )
     (unrolled-each) unrolled-each-integer ; inline
 
-: unrolled-2each-unsafe ( ... xseq yseq len quot: ( ... x y -- ... ) -- ... )
+: 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-unsafe ( seq len quot: ( x -- ) -- )
     (unrolled-each-index) unrolled-each-integer ; inline
 
-: unrolled-map-as-unsafe ( ... seq len quot: ( ... x -- ... newx ) exemplar -- ... newseq )
+: 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-2map-as-unsafe ( xseq yseq len quot: ( x y -- newx ) exemplar -- newseq )
     [ (unrolled-2each) ] dip unrolled-map-integers ; inline
 
+: unrolled-map-unsafe ( seq len quot: ( x -- newx ) -- newseq )
+    pick unrolled-map-as-unsafe ; inline
+
+: unrolled-2map-unsafe ( xseq yseq len quot: ( x y -- newx ) -- newseq )
+    reach unrolled-2map-as-unsafe ; inline
+
 PRIVATE>
 
-: unrolled-each ( ... seq len quot: ( ... x -- ... ) -- ... )
+: unrolled-each ( seq len quot: ( x -- ) -- )
     unrolled-bounds-check unrolled-each-unsafe ; inline
 
-: unrolled-2each ( ... xseq yseq len quot: ( ... x y -- ... ) -- ... )
+: unrolled-2each ( xseq yseq len quot: ( x y -- ) -- )
     unrolled-2bounds-check unrolled-2each-unsafe ; inline
 
-: unrolled-each-index ( ... seq len quot: ( ... x i -- ... ) -- ... )
+: 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-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-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 )
+: 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
+: unrolled-2map ( xseq yseq len quot: ( x y -- newx ) -- newseq )
+    reach unrolled-2map-as ; inline
 
+: unrolled-map-index ( seq len quot: ( x i -- newx ) -- newseq )
+    [ dup length <iota> ] 2dip unrolled-2map ; inline