sequences: fixing "Cannot apply 'call' to a run-time computed value" error in map-reduce and 2map-reduce.
parent
2407ee0234
commit
c7b6003233
|
@ -1,6 +1,6 @@
|
|||
USING: arrays kernel math math.order namespaces sequences kernel.private
|
||||
sequences.private strings sbufs tools.test vectors assocs
|
||||
generic vocabs.loader ;
|
||||
USING: arrays kernel math math.order math.parser namespaces
|
||||
sequences kernel.private sequences.private strings sbufs
|
||||
tools.test vectors assocs generic vocabs.loader ;
|
||||
IN: sequences.tests
|
||||
|
||||
[ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
|
||||
|
@ -331,8 +331,10 @@ USE: make
|
|||
[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
|
||||
[ { 1 2 } { "a" "b" } cartesian-product ] unit-test
|
||||
|
||||
[ { } [ string>digits sum ] [ + ] map-reduce ] must-infer
|
||||
[ { } [ ] [ + ] map-reduce ] must-fail
|
||||
[ 4 ] [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
|
||||
|
||||
[ { } { } [ [ string>digits product ] bi@ + ] [ + ] 2map-reduce ] must-infer
|
||||
[ { } { } [ + ] [ + ] 2map-reduce ] must-fail
|
||||
[ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test
|
||||
|
|
|
@ -857,18 +857,6 @@ PRIVATE>
|
|||
[ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe =
|
||||
] 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>
|
||||
|
||||
: start* ( subseq seq n -- i )
|
||||
|
@ -894,12 +882,12 @@ PRIVATE>
|
|||
[ 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 )
|
||||
[ [ prepare-map-reduce ] keep ] dip
|
||||
compose compose (each-integer) ; inline
|
||||
[ [ dup first ] dip [ call ] keep ] dip compose
|
||||
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 )
|
||||
[ [ prepare-2map-reduce ] keep ] dip
|
||||
compose compose (each-integer) ; inline
|
||||
[ [ 2dup [ first ] bi@ ] dip [ call ] keep ] dip compose
|
||||
[ -rot ] dip [ 1 ] 3dip (2each) (each-integer) ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
Loading…
Reference in New Issue