Skip to content
Permalink
Browse files

effects: fix clone of row variadic effects.

  • Loading branch information...
mrjbq7 committed Sep 12, 2019
1 parent d26d36c commit 2657e7507e37d706b4e265cb577c4d3f2395ba55
Showing with 21 additions and 10 deletions.
  1. +2 −0 core/effects/effects-tests.factor
  2. +19 −10 core/effects/effects.factor
@@ -60,3 +60,5 @@ sequences tools.test math ;

{ "( :( :integer -- :integer ) :float -- :bignum )" }
[ ( :( :integer -- :integer ) :float -- :bignum ) unparse ] unit-test

{ t } [ ( ..a x quot: ( ..a -- ..b ) -- ..b ) dup clone = ] unit-test
@@ -61,20 +61,23 @@ M: pair effect>string
nip effect>string ":" prepend
] if ;

: stack-picture ( seq -- string )
[ [ effect>string % CHAR: \s , ] each ] "" make ;
<PRIVATE

: var-picture ( var -- string )
[ ".." " " surround ]
[ "" ] if* ;
: stack-picture% ( seq -- )
[ effect>string % CHAR: \s , ] each ;

: var-picture% ( var -- )
[ ".." % % CHAR: \s , ] when* ;

PRIVATE>

M: effect effect>string ( effect -- string )
[
"( " %
dup in-var>> var-picture %
dup in>> stack-picture % "-- " %
dup out-var>> var-picture %
dup out>> stack-picture %
dup in-var>> var-picture%
dup in>> stack-picture% "-- " %
dup out-var>> var-picture%
dup out>> stack-picture%
dup terminated?>> [ "* " % ] when
drop
")" %
@@ -102,7 +105,13 @@ M: word stack-effect
M: deferred stack-effect call-next-method ( -- * ) or ;

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-effect effect-height ; inline

0 comments on commit 2657e75

Please sign in to comment.
You can’t perform that action at this time.