temporary fix for core/effects

diff --git a/core/effects/effects.factor b/core/effects/effects.factor
index cab1e531b796200781c3757fa57cc9fafacdadf2..5cbb0fe36e3c61e895e43132f32d0524e74a25cb 100644 (file)
--- a/core/effects/effects.factor
+++ b/core/effects/effects.factor
@@ -6,25 +6,29 @@ IN: effects
 
 TUPLE: effect { in read-only } { out read-only } { terminated? read-only } ;
 
+GENERIC: effect-length ( obj -- n )
+M: sequence effect-length length ;
+M: integer effect-length ;
+
 : <effect> ( in out -- effect )
     dup { "*" } sequence= [ drop { } t ] [ f ] if
     effect boa ;
 
 : effect-height ( effect -- n )
-    [ out>> length ] [ in>> length ] bi - ; inline
+    [ out>> effect-length ] [ in>> effect-length ] bi - ; inline
 
 : effect<= ( effect1 effect2 -- ? )
     {
         { [ over terminated?>> ] [ t ] }
         { [ dup terminated?>> ] [ f ] }
-        { [ 2dup [ in>> length ] bi@ > ] [ f ] }
+        { [ 2dup [ in>> effect-length ] bi@ > ] [ f ] }
         { [ 2dup [ effect-height ] bi@ = not ] [ f ] }
         [ t ]
     } cond 2nip ; inline
 
 : effect= ( effect1 effect2 -- ? )
-    [ [ in>> length ] bi@ = ]
-    [ [ out>> length ] bi@ = ]
+    [ [ in>> effect-length ] bi@ = ]
+    [ [ out>> effect-length ] bi@ = ]
     [ [ terminated?>> ] bi@ = ]
     2tri and and ;
 
@@ -62,7 +66,7 @@ M: effect clone
     stack-effect effect-height ;
 
 : split-shuffle ( stack shuffle -- stack1 stack2 )
-    in>> length cut* ;
+    in>> effect-length cut* ;
 
 : shuffle-mapping ( effect -- mapping )
     [ out>> ] [ in>> ] bi [ index ] curry map ;
@@ -77,8 +81,9 @@ M: effect clone
     over terminated?>> [
         drop
     ] [
-        [ [ [ in>> length ] [ out>> length ] bi ] [ in>> length ] bi* swap [-] + ]
-        [ [ out>> length ] [ [ in>> length ] [ out>> length ] bi ] bi* [ [-] ] dip + ]
+        [ [ [ in>> effect-length ] [ out>> effect-length ] bi ] [ in>> effect-length ] bi* swap [-] + ]
+        [ [ out>> effect-length ] [ [ in>> effect-length ] [ out>> effect-length ] bi ] bi* [ [-] ] dip + ]
         [ nip terminated?>> ] 2tri
+        [ [ [ "obj" ] replicate ] bi@ ] dip
         effect boa
     ] if ; inline