steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

sequences.unrolled: tweak helper words so that call( -- ) guards inline in more cases (w/ help from Slava)

db4
Joe Groff 2010-05-24 16:50:46 -07:00
parent 0993e6883d
commit 9391f10164
2 changed files with 27 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/sequences/unrolled/unrolled-tests.factor
View File

@ -1,5 +1,5 @@
! (c)2010 Joe Groff bsd license
USING: compiler.test make math.parser sequences
USING: compiler.test compiler.tree.debugger kernel make math.parser sequences
sequences.unrolled tools.test ;
IN: sequences.unrolled.tests
@ -32,3 +32,21 @@ IN: sequences.unrolled.tests
[ { 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
[ t ]
[ [ 3 [ number>string ] unrolled-map ] { call } inlined? ] unit-test
[ t ]
[ [ 3 [ number>string , ] unrolled-each ] { call } inlined? ] unit-test
[ t ]
[ [ 3 [ number>string append , ] unrolled-each-index ] { call } inlined? ] unit-test
[ t ]
[ [ 3 [ append , ] unrolled-2each ] { call } inlined? ] unit-test
[ t ]
[ [ 3 [ append ] unrolled-2map ] { call } inlined? ] unit-test
[ t ]
[ [ 3 [ number>string append ] unrolled-map-index ] { call } inlined? ] unit-test

12
basis/sequences/unrolled/unrolled.factor
View File

@ -1,7 +1,7 @@
! (c)2010 Joe Groff bsd license
USING: combinators combinators.short-circuit fry generalizations kernel
locals macros math quotations sequences compiler.tree.propagation.transforms ;
FROM: sequences.private => (each) (each-index) (collect) (2each) ;
FROM: sequences.private => (each) (each-index) (2each) nth-unsafe set-nth-unsafe ;
IN: sequences.unrolled
<PRIVATE
@ -11,13 +11,17 @@ IN: sequences.unrolled
<< \ (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 -- ) -- )
swap (unrolled-each-integer) ; inline
: unrolled-collect ( n quot: ( n -- value ) into -- )
(collect) unrolled-each-integer ; inline
(unrolled-collect) unrolled-each-integer ; inline
: unrolled-map-integers ( n quot: ( n -- value ) exemplar -- newseq )
[ over ] dip [ [ unrolled-collect ] keep ] new-like ; inline
@ -38,10 +42,10 @@ 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