diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index c578e1ce49..dc24722bf2 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -331,4 +331,8 @@ USE: make [ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ] [ { 1 2 } { "a" "b" } cartesian-product ] unit-test +[ { } [ ] [ + ] map-reduce ] must-fail [ 4 ] [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test + +[ { } { } [ + ] [ + ] 2map-reduce ] must-fail +[ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 6895b3a348..a83c7121c7 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -857,11 +857,17 @@ PRIVATE> [ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe = ] all? nip ; inline -: prepare-2map-reduce ( seq1 seq2 map-quot -- initial length seq1 seq2 ) - [ drop min-length dup 1 < [ "Empty sequence" throw ] when 1 - ] - [ drop [ [ 1 + ] 2dip 2nth-unsafe ] 2curry ] +: 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 ; inline + 3tri -rot [ 1 ] 2dip ; inline PRIVATE> @@ -888,12 +894,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 ) - [ [ unclip-slice ] dip [ call ] keep ] dip - compose reduce ; inline + [ [ prepare-map-reduce ] keep ] dip + 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 ) [ [ prepare-2map-reduce ] keep ] dip - compose compose each-integer ; inline + compose compose (each-integer) ; inline [ but-last-slice ] [ last ] bi ; inline