]> gitweb.factorcode.org Git - factor.git/commitdiff
sequences.unrolled: tweak helper words so that call( -- ) guards inline in more cases...
authorJoe Groff <arcata@gmail.com>
Mon, 24 May 2010 23:50:46 +0000 (16:50 -0700)
committerJoe Groff <arcata@gmail.com>
Mon, 24 May 2010 23:50:46 +0000 (16:50 -0700)
basis/sequences/unrolled/unrolled-tests.factor
basis/sequences/unrolled/unrolled.factor

index b9b82e2fea1eeeafac4172d56e273b4204a8cf88..e0d70b4fa7dbc1c39b68ed3966bb3653d7164708 100644 (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
index 23ba40202c767a1fc15c535e6508384d77dc3a89..1a30e49d5b9d452a57e68643bac99fbbab5d350d 100644 (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