Spread now infers with the correct stack effect. Make spread>quot-shallow which trims empty quotations off the head of the spread sequence. Fixes #139.

db4
Doug Coleman 2011-10-01 19:24:14 -07:00
parent 3b72b641e0
commit 38feae0e8f
4 changed files with 11 additions and 4 deletions

View File

@ -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

View File

@ -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 -- )

View File

@ -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

View File

@ -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 ;