]> gitweb.factorcode.org Git - factor.git/commitdiff
effects: short-circuit versions of a few words
authorJohn Benediktsson <mrjbq7@gmail.com>
Tue, 2 Aug 2022 17:27:24 +0000 (10:27 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 2 Aug 2022 17:27:24 +0000 (10:27 -0700)
core/effects/effects.factor

index f14f5cfecb35a8ae4c8705c0aa6521710a2fc53e..8d622bf8cf0ae0bd79d1706e391f1087d4183fc3 100644 (file)
@@ -27,7 +27,7 @@ TUPLE: effect
     [ out>> length ] [ in>> length ] bi - ; inline
 
 : variable-effect? ( effect -- ? )
-    [ in-var>> ] [ out-var>> ] bi or ;
+    dup in-var>> [ drop t ] [ out-var>> ] if ;
 
 : bivariable-effect? ( effect -- ? )
     [ in-var>> ] [ out-var>> ] bi = not ;
@@ -44,10 +44,11 @@ TUPLE: effect
     } cond 2nip ; inline
 
 : effect= ( effect1 effect2 -- ? )
-    [ [ in>> length ] same? ]
-    [ [ out>> length ] same? ]
-    [ [ terminated?>> ] same? ]
-    2tri and and ;
+    2dup [ in>> length ] same? [
+        2dup [ out>> length ] same? [
+            [ terminated?>> ] same?
+        ] [ 2drop f ] if
+    ] [ 2drop f ] if ;
 
 GENERIC: effect>string ( obj -- str )
 M: string effect>string ;
@@ -105,13 +106,7 @@ M: word stack-effect
 M: deferred stack-effect call-next-method ( -- * ) or ;
 
 M: effect clone
-    {
-        [ in>> clone ]
-        [ out>> clone ]
-        [ terminated?>> ]
-        [ in-var>> ]
-        [ out-var>> ]
-    } cleave effect boa ;
+    (clone) [ clone ] change-in [ clone ] change-out ;
 
 : stack-height ( word -- n )
     stack-effect effect-height ; inline