Spread now infers with the correct stack effect. Make spread>quot-shallow which trims...

diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor
index bf69f440bdf6bf4ec73738f2961688346d50e069..a262548214ceb8b55aebf1a3ea086f9f997b6bdd 100644 (file)
--- a/basis/fry/fry.factor
+++ b/basis/fry/fry.factor
@@ -95,7 +95,7 @@ INSTANCE: fried-callable fried
     check-fry mark-composes
     { _ } split convert-curries
     [ [ [ ] ] [ [ ] (make-curry) but-last ] if-zero ]
-    [ spread>quot swap [ [ ] (make-curry) compose ] unless-zero ] if-empty ;
+    [ spread>quot-shallow swap [ [ ] (make-curry) compose ] unless-zero ] if-empty ;
 
 DEFER: dredge-fry
 

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 3c40efc2d35d7f63cf3b6199160d07e440b7b3c8..51faf3a550c8821a69eb21b1564fc86d189e08fc 100644 (file)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -134,7 +134,7 @@ M: class final-class? drop t ;
     superclasses [ "slots" word-prop length ] map-sum ;
 
 : boa-check-quot ( class -- quot )
-    all-slots [ class>> instance-check-quot ] map spread>quot
+    all-slots [ class>> instance-check-quot ] map spread>quot-shallow
     f like ;
 
 : define-boa-check ( class -- )

diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor
index 97de07d54668a51e8631c0a8f5c233ef1b3fe791..1f524520b890fb1bcc856e48dbb02a1fe24160b5 100644 (file)
--- a/core/combinators/combinators-tests.factor
+++ b/core/combinators/combinators-tests.factor
@@ -1,6 +1,6 @@
 USING: alien strings kernel math tools.test io prettyprint
 namespaces combinators words classes sequences accessors
-math.functions arrays combinators.private ;
+math.functions arrays combinators.private stack-checker ;
 IN: combinators.tests
 
 [ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test
@@ -320,3 +320,7 @@ DEFER: corner-case-1
 
 [ "nachos" ] [ 33 test-case-12 ] unit-test
 [ "nachos" ] [ 33 \ test-case-12 def>> call ] unit-test
+
+[ (( x x -- x x )) ] [
+    [ { [ ] [ ] } spread ] infer
+] unit-test

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index fc259afbaf57ffd0ac5d53bb17f62317096da5ec..0453b257661aa6981f01bfc0c2805a8b2bc66515 100644 (file)
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -65,9 +65,12 @@ SLOT: terminated?
     [ [ 3keep ] curry ] map concat [ 3drop ] append [ ] like ;
 
 ! spread
-: spread>quot ( seq -- quot )
+: spread>quot-shallow ( seq -- quot )
     [ ] [ [ dup empty? [ [ dip ] curry ] unless ] dip append ] reduce ;
 
+: spread>quot ( seq -- quot )
+    [ ] [ [ [ dip ] curry ] dip append ] reduce ;
+
 : spread ( objs... seq -- )
     spread>quot call ;