From 9391f101647ef9b7f8fab9df56128b6cc69a78ac Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 24 May 2010 16:50:46 -0700 Subject: [PATCH] sequences.unrolled: tweak helper words so that call( -- ) guards inline in more cases (w/ help from Slava) --- .../sequences/unrolled/unrolled-tests.factor | 20 ++++++++++++++++++- basis/sequences/unrolled/unrolled.factor | 12 +++++++---- 2 files changed, 27 insertions(+), 5 deletions(-) diff --git a/basis/sequences/unrolled/unrolled-tests.factor b/basis/sequences/unrolled/unrolled-tests.factor index b9b82e2fea..e0d70b4fa7 100644 --- a/basis/sequences/unrolled/unrolled-tests.factor +++ b/basis/sequences/unrolled/unrolled-tests.factor @@ -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 diff --git a/basis/sequences/unrolled/unrolled.factor b/basis/sequences/unrolled/unrolled.factor index 23ba40202c..1a30e49d5b 100644 --- a/basis/sequences/unrolled/unrolled.factor +++ b/basis/sequences/unrolled/unrolled.factor @@ -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 > + +: (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