sequences: fix row variadic stack effect of map-reduce/2map-reduce.

diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 722e61545c6104f6152272d53406b0e0a79c12df..61ca2d6e802a3ede954663fe1c968315c2290c67 100644 (file)
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -369,10 +369,12 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ;
 [ { } [ string>digits sum ] [ + ] map-reduce ] must-infer
 [ { } [ ] [ + ] map-reduce ] must-fail
 { 4 } [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
+{ 2 18 } [ 2 { 3 3 3 } [ dupd * ] [ + ] 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
+{ 2 96 } [ 2 { 3 3 3 3 } { 4 4 4 4 } [ [ dup ] 2dip * * ] [ + ] 2map-reduce ] unit-test
 
 { 4 } [ 5 <iota> [ ] supremum-by ] unit-test
 { 0 } [ 5 <iota> [ ] infimum-by ] unit-test

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 9d5df6a51ca366f502e43e0bc5ac4972db8cc899..50a3a38091f87b02a10f8b494ab8e23f80a5e4e1 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -1030,11 +1030,13 @@ PRIVATE>
 : unclip-slice ( seq -- rest-slice first )
     [ rest-slice ] [ first-unsafe ] bi ; inline
 
-: map-reduce ( ..a seq map-quot: ( ..a elt -- ..b intermediate ) reduce-quot: ( ..b prev intermediate -- ..a next ) -- ..a result )
-    [ [ [ first ] keep ] dip [ dip ] keep ] dip compose 1 each-from ; inline
+: map-reduce ( ..a seq map-quot: ( ..a elt -- ..a intermediate ) reduce-quot: ( ..a prev intermediate -- ..a next ) -- ..a result )
+    [ [ [ first ] keep ] dip [ dip ] keep ] dip
+    '[ swap _ dip swap @ ] 1 each-from ; inline
 
-: 2map-reduce ( ..a seq1 seq2 map-quot: ( ..a elt1 elt2 -- ..b intermediate ) reduce-quot: ( ..b prev intermediate -- ..a next ) -- ..a result )
-    [ [ [ [ first ] bi@ ] 2keep ] dip [ 2dip ] keep ] dip compose 1 2each-from ; inline
+: 2map-reduce ( ..a seq1 seq2 map-quot: ( ..a elt1 elt2 -- ..a intermediate ) reduce-quot: ( ..a prev intermediate -- ..a next ) -- ..a result )
+    [ [ [ [ first ] bi@ ] 2keep ] dip [ 2dip ] keep ] dip
+    '[ rot _ dip swap @ ] 1 2each-from ; inline
 
 <PRIVATE