steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

effects: fix clone of row variadic effects.

clean-linux-x86-64
John Benediktsson 2019-09-12 11:15:58 -07:00
parent d26d36cc86
commit 2657e7507e
2 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/effects/effects-tests.factor
View File

@ -60,3 +60,5 @@ sequences tools.test math ;
{ "( :( :integer -- :integer ) :float -- :bignum )" } { "( :( :integer -- :integer ) :float -- :bignum )" }
[ ( :( :integer -- :integer ) :float -- :bignum ) unparse ] unit-test [ ( :( :integer -- :integer ) :float -- :bignum ) unparse ] unit-test
{ t } [ ( ..a x quot: ( ..a -- ..b ) -- ..b ) dup clone = ] unit-test

29
core/effects/effects.factor
View File

@ -61,20 +61,23 @@ M: pair effect>string
nip effect>string ":" prepend nip effect>string ":" prepend
] if ; ] if ;
: stack-picture ( seq -- string ) <PRIVATE
[ [ effect>string % CHAR: \s , ] each ] "" make ;
: var-picture ( var -- string ) : stack-picture% ( seq -- )
[ ".." " " surround ] [ effect>string % CHAR: \s , ] each ;
[ "" ] if* ;
: var-picture% ( var -- )
[ ".." % % CHAR: \s , ] when* ;
PRIVATE>
M: effect effect>string ( effect -- string ) M: effect effect>string ( effect -- string )
[ [
"( " % "( " %
dup in-var>> var-picture % dup in-var>> var-picture%
dup in>> stack-picture % "-- " % dup in>> stack-picture% "-- " %
dup out-var>> var-picture % dup out-var>> var-picture%
dup out>> stack-picture % dup out>> stack-picture%
dup terminated?>> [ "* " % ] when dup terminated?>> [ "* " % ] when
drop drop
")" % ")" %
@ -102,7 +105,13 @@ M: word stack-effect
M: deferred stack-effect call-next-method ( -- * ) or ; M: deferred stack-effect call-next-method ( -- * ) or ;
M: effect clone M: effect clone
[ in>> clone ] [ out>> clone ] bi <effect> ; {
[ in>> clone ]
[ out>> clone ]
[ terminated?>> ]
[ in-var>> ]
[ out-var>> ]
} cleave effect boa ;
: stack-height ( word -- n ) : stack-height ( word -- n )
stack-effect effect-height ; inline stack-effect effect-height ; inline