diff --git a/core/effects/effects-tests.factor b/core/effects/effects-tests.factor index 06a97ef3bb..8b51b42a1c 100644 --- a/core/effects/effects-tests.factor +++ b/core/effects/effects-tests.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 diff --git a/core/effects/effects.factor b/core/effects/effects.factor index ffdc4ead39..44ddb71c49 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -61,20 +61,23 @@ M: pair effect>string nip effect>string ":" prepend ] if ; -: stack-picture ( seq -- string ) - [ [ effect>string % CHAR: \s , ] each ] "" make ; +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 ; + { + [ in>> clone ] + [ out>> clone ] + [ terminated?>> ] + [ in-var>> ] + [ out-var>> ] + } cleave effect boa ; : stack-height ( word -- n ) stack-effect effect-height ; inline