effects: fix clone of row variadic effects.

factor · Sep 15, 2019 · 2657e75 · 2657e75
1 parent d26d36c
commit 2657e75
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 10 deletions.
diff --git 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
@@ -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