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

sequences: make map-reduce 5-20% faster, and 2map-reduce 3-5% faster.

db4
John Benediktsson 2012-04-17 17:58:19 -07:00
parent db60f6e8c9
commit 2407ee0234
2 changed files with 18 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
core/sequences/sequences-tests.factor
View File

@ -331,4 +331,8 @@ USE: make
[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ] [ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
[ { 1 2 } { "a" "b" } cartesian-product ] unit-test [ { 1 2 } { "a" "b" } cartesian-product ] unit-test
[ { } [ ] [ + ] map-reduce ] must-fail
[ 4 ] [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test [ 4 ] [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
[ { } { } [ + ] [ + ] 2map-reduce ] must-fail
[ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test

22
core/sequences/sequences.factor
View File

@ -857,11 +857,17 @@ PRIVATE>
[ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe = [ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe =
] all? nip ; inline ] all? nip ; inline
: prepare-2map-reduce ( seq1 seq2 map-quot -- initial length seq1 seq2 ) : prepare-map-reduce ( seq map-quot -- initial i n quot )
[ drop min-length dup 1 < [ "Empty sequence" throw ] when 1 - ] [ drop length dup 1 < [ "Empty sequence" throw ] when ]
[ drop [ [ 1 + ] 2dip 2nth-unsafe ] 2curry ] [ drop [ nth-unsafe ] curry ]
[ [ first-unsafe ] dip call ]
2tri -rot [ 1 ] 2dip ; inline
: prepare-2map-reduce ( seq1 seq2 map-quot -- initial i n quot )
[ drop min-length dup 1 < [ "Empty sequence" throw ] when ]
[ drop [ 2nth-unsafe ] 2curry ]
[ [ [ first-unsafe ] bi@ ] dip call ] [ [ [ first-unsafe ] bi@ ] dip call ]
3tri -rot ; inline 3tri -rot [ 1 ] 2dip ; inline
PRIVATE> PRIVATE>
@ -888,12 +894,12 @@ PRIVATE>
[ rest-slice ] [ first-unsafe ] bi ; inline [ rest-slice ] [ first-unsafe ] bi ; inline
: map-reduce ( ..a seq map-quot: ( ..a x -- ..b elt ) reduce-quot: ( ..b prev elt -- ..a next ) -- ..a result ) : map-reduce ( ..a seq map-quot: ( ..a x -- ..b elt ) reduce-quot: ( ..b prev elt -- ..a next ) -- ..a result )
[ [ unclip-slice ] dip [ call ] keep ] dip [ [ prepare-map-reduce ] keep ] dip
compose reduce ; inline compose compose (each-integer) ; inline
: 2map-reduce ( ..a seq1 seq2 map-quot: ( ..a elt1 elt2 -- ..b intermediate ) reduce-quot: ( ..b prev intermediate -- ..a next ) -- ..a result ) : 2map-reduce ( ..a seq1 seq2 map-quot: ( ..a elt1 elt2 -- ..b intermediate ) reduce-quot: ( ..b prev intermediate -- ..a next ) -- ..a result )
[ [ prepare-2map-reduce ] keep ] dip [ [ prepare-2map-reduce ] keep ] dip
compose compose each-integer ; inline compose compose (each-integer) ; inline
<PRIVATE <PRIVATE
@ -913,7 +919,7 @@ PRIVATE>
[ but-last-slice ] [ last ] bi ; inline [ but-last-slice ] [ last ] bi ; inline
<PRIVATE <PRIVATE
: (trim-head) ( seq quot -- seq n ) : (trim-head) ( seq quot -- seq n )
over [ [ not ] compose find drop ] dip over [ [ not ] compose find drop ] dip
[ length or ] keep swap ; inline [ length or ] keep swap ; inline