1 ! (c)2010 Joe Groff bsd license
2 USING: combinators combinators.short-circuit fry generalizations kernel
3 locals macros math quotations sequences compiler.tree.propagation.transforms ;
4 FROM: sequences.private => (each) (each-index) (2each) nth-unsafe set-nth-unsafe ;
8 : (unrolled-each-integer) ( quot n -- )
9 swap '[ _ call( i -- ) ] each-integer ;
11 << \ (unrolled-each-integer) [
12 iota [ '[ _ swap call( i -- ) ] ] [ ] map-as '[ _ cleave ]
13 ] 1 define-partial-eval >>
15 : (unrolled-collect) ( quot into -- quot' )
16 '[ dup @ swap _ set-nth-unsafe ] ; inline
20 : unrolled-each-integer ( n quot: ( i -- ) -- )
21 swap (unrolled-each-integer) ; inline
23 : unrolled-collect ( n quot: ( n -- value ) into -- )
24 (unrolled-collect) unrolled-each-integer ; inline
26 : unrolled-map-integers ( n quot: ( n -- value ) exemplar -- newseq )
27 [ over ] dip [ [ unrolled-collect ] keep ] new-like ; inline
29 ERROR: unrolled-bounds-error
32 ERROR: unrolled-2bounds-error
33 xseq yseq unroll-length ;
36 : unrolled-bounds-check ( seq len quot -- seq len quot )
37 2over swap length > [ 2over unrolled-bounds-error ] when ; inline
39 :: unrolled-2bounds-check ( xseq yseq len quot -- xseq yseq len quot )
40 { [ len xseq length > ] [ len yseq length > ] } 0||
41 [ xseq yseq len unrolled-2bounds-error ]
42 [ xseq yseq len quot ] if ; inline
44 : (unrolled-each) ( seq len quot -- len quot )
45 swapd '[ _ nth-unsafe @ ] ; inline
47 : (unrolled-each-index) ( seq len quot -- len quot )
48 swapd '[ dup _ nth-unsafe swap @ ] ; inline
50 : (unrolled-2each) ( xseq yseq len quot -- len quot )
51 [ '[ _ ] 2dip ] dip (2each) nip ; inline
53 : unrolled-each-unsafe ( seq len quot: ( x -- ) -- )
54 (unrolled-each) unrolled-each-integer ; inline
56 : unrolled-2each-unsafe ( xseq yseq len quot: ( x y -- ) -- )
57 (unrolled-2each) unrolled-each-integer ; inline
59 : unrolled-each-index-unsafe ( seq len quot: ( x -- ) -- )
60 (unrolled-each-index) unrolled-each-integer ; inline
62 : unrolled-map-as-unsafe ( seq len quot: ( x -- newx ) exemplar -- newseq )
63 [ (unrolled-each) ] dip unrolled-map-integers ; inline
65 : unrolled-2map-as-unsafe ( xseq yseq len quot: ( x y -- newx ) exemplar -- newseq )
66 [ (unrolled-2each) ] dip unrolled-map-integers ; inline
68 : unrolled-map-unsafe ( seq len quot: ( x -- newx ) -- newseq )
69 pick unrolled-map-as-unsafe ; inline
71 : unrolled-2map-unsafe ( xseq yseq len quot: ( x y -- newx ) -- newseq )
72 4 npick unrolled-2map-as-unsafe ; inline
76 : unrolled-each ( seq len quot: ( x -- ) -- )
77 unrolled-bounds-check unrolled-each-unsafe ; inline
79 : unrolled-2each ( xseq yseq len quot: ( x y -- ) -- )
80 unrolled-2bounds-check unrolled-2each-unsafe ; inline
82 : unrolled-each-index ( seq len quot: ( x i -- ) -- )
83 unrolled-bounds-check unrolled-each-index-unsafe ; inline
85 : unrolled-map-as ( seq len quot: ( x -- newx ) exemplar -- newseq )
86 [ unrolled-bounds-check ] dip unrolled-map-as-unsafe ; inline
88 : unrolled-2map-as ( xseq yseq len quot: ( x y -- newx ) exemplar -- newseq )
89 [ unrolled-2bounds-check ] dip unrolled-2map-as-unsafe ; inline
91 : unrolled-map ( seq len quot: ( x -- newx ) -- newseq )
92 pick unrolled-map-as ; inline
94 : unrolled-2map ( xseq yseq len quot: ( x y -- newx ) -- newseq )
95 4 npick unrolled-2map-as ; inline
97 : unrolled-map-index ( seq len quot: ( x i -- newx ) -- newseq )
98 [ dup length iota ] 2dip unrolled-2map ; inline