]> gitweb.factorcode.org Git - factor.git/commitdiff
effects: fix clone of row variadic effects.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 12 Sep 2019 18:15:58 +0000 (11:15 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 15 Sep 2019 15:35:08 +0000 (08:35 -0700)
core/effects/effects-tests.factor
core/effects/effects.factor

index 06a97ef3bb50c3c0c34f56ee1acfcb5e4c89c6f1..8b51b42a1cdc2d99240b1e632de5f27e83d61052 100644 (file)
@@ -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
index ffdc4ead3976f70d8b155a00226218f433937770..44ddb71c49b0b0047d1b913323050a5e64c249cc 100644 (file)
@@ -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