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

sequences: fixing "Cannot apply 'call' to a run-time computed value" error in map-reduce and 2map-reduce.

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

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

@ -1,6 +1,6 @@
USING: arrays kernel math math.order namespaces sequences kernel.private USING: arrays kernel math math.order math.parser namespaces
sequences.private strings sbufs tools.test vectors assocs sequences kernel.private sequences.private strings sbufs
generic vocabs.loader ; tools.test vectors assocs generic vocabs.loader ;
IN: sequences.tests IN: sequences.tests
[ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test [ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
@ -331,8 +331,10 @@ 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
[ { } [ string>digits sum ] [ + ] map-reduce ] must-infer
[ { } [ ] [ + ] map-reduce ] must-fail [ { } [ ] [ + ] map-reduce ] must-fail
[ 4 ] [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test [ 4 ] [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
[ { } { } [ [ string>digits product ] bi@ + ] [ + ] 2map-reduce ] must-infer
[ { } { } [ + ] [ + ] 2map-reduce ] must-fail [ { } { } [ + ] [ + ] 2map-reduce ] must-fail
[ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test [ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test

20
core/sequences/sequences.factor
View File

@ -857,18 +857,6 @@ 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-map-reduce ( seq map-quot -- initial i n quot )
[ drop length dup 1 < [ "Empty sequence" throw ] when ]
[ 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 ]
3tri -rot [ 1 ] 2dip ; inline
PRIVATE> PRIVATE>
: start* ( subseq seq n -- i ) : start* ( subseq seq n -- i )
@ -894,12 +882,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 )
[ [ prepare-map-reduce ] keep ] dip [ [ dup first ] dip [ call ] keep ] dip compose
compose compose (each-integer) ; inline swapd [ 1 ] 2dip (each) (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 [ [ 2dup [ first ] bi@ ] dip [ call ] keep ] dip compose
compose compose (each-integer) ; inline [ -rot ] dip [ 1 ] 3dip (2each) (each-integer) ; inline
<PRIVATE <PRIVATE