compiler.cfg.liveness: refactoring so that words that doesn't modify

the live-set doesnt return it

e.g it's clearer when the effect is ( live-set insn -- ) than ( live-set insn -- live-set ) that the live-set is modified in place

diff --git a/basis/compiler/cfg/liveness/liveness-tests.factor b/basis/compiler/cfg/liveness/liveness-tests.factor
index efcb9251b34c8a5249b9e0161e19e62579b797a9..48c74bad04a924cb42f375441940361dd9448097 100644 (file)
--- a/basis/compiler/cfg/liveness/liveness-tests.factor
+++ b/basis/compiler/cfg/liveness/liveness-tests.factor
@@ -54,13 +54,12 @@ IN: compiler.cfg.liveness.tests
 ] unit-test
 
 ! fill-gc-map
-{ H{ } } [
+{ } [
     f representations set
     H{ } clone T{ gc-map } fill-gc-map
 ] unit-test
 
 {
-    H{ { 48 48 } }
     T{ gc-map { gc-roots { 48 } } { derived-roots V{ } } }
 } [
     H{ { 48 tagged-rep } } representations set
@@ -70,16 +69,12 @@ IN: compiler.cfg.liveness.tests
 
 ! kill-defs
 { H{ } } [
-    H{ } T{ ##peek f 37 D 0 0 } kill-defs
+    H{ } dup T{ ##peek f 37 D 0 0 } kill-defs
 ] unit-test
 
 { H{ { 3 3 } } } [
     H{ { 37 99 } { 99 99 } { 2 99 } } leader-map set
-    H{ { 37 37 } { 3 3 } } T{ ##peek f 2 D 0 0 } kill-defs
-] unit-test
-
-{ t } [
-    H{ { 123 123 } } clone T{ ##peek f 7 D 0 } dupd kill-defs eq?
+    H{ { 37 37 } { 3 3 } } dup T{ ##peek f 2 D 0 0 } kill-defs
 ] unit-test
 
 ! lookup-base-pointer
@@ -97,6 +92,14 @@ IN: compiler.cfg.liveness.tests
     456 T{ ##peek f 123 D 0 } lookup-base-pointer*
 ] unit-test
 
+! transfer-liveness
+{
+    H{ { 37 37 } }
+} [
+    H{ } clone dup { T{ ##replace f 37 D 1 6 } T{ ##peek f 37 D 0 0 } }
+    transfer-liveness
+] unit-test
+
 ! visit-gc-root
 { V{ } HS{ 48 } } [
     H{ { 48 tagged-rep } } representations set
@@ -112,12 +115,24 @@ IN: compiler.cfg.liveness.tests
 
 ! visit-insn
 { H{ } } [
-    H{ } clone T{ ##peek f 0 D 0 } visit-insn
+    H{ } clone [ T{ ##peek f 0 D 0 } visit-insn ] keep
 ] unit-test
 
 { H{ { 48 48 } { 37 37 } } } [
     H{ { 48 tagged-rep } } representations set
-    H{ { 48 48  } } clone T{ ##replace f 37 D 1 6 } visit-insn
+    H{ { 48 48  } } clone [ T{ ##replace f 37 D 1 6 } visit-insn ] keep
+] unit-test
+
+{
+    T{ ##call-gc
+       { gc-map
+         T{ gc-map { gc-roots { 93 } } { derived-roots V{ } } }
+       }
+    }
+} [
+    H{ { 93 tagged-rep } } representations set
+    H{ { 93 93  } } clone T{ ##call-gc f T{ gc-map } }
+    [ visit-insn ] keep
 ] unit-test
 
 : test-liveness ( -- )

diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor
index ecb9c0816497b5bf44a2dd5440d145f6f245d1a8..16e22ecaff7ead58a0d6b9b30c62ab2f9660c0e9 100644 (file)
--- a/basis/compiler/cfg/liveness/liveness.factor
+++ b/basis/compiler/cfg/liveness/liveness.factor
@@ -26,17 +26,18 @@ SYMBOL: edge-live-ins
 
 SYMBOL: base-pointers
 
-GENERIC: visit-insn ( live-set insn -- live-set )
+GENERIC: visit-insn ( live-set insn -- )
 
-: kill-defs ( live-set insn -- live-set )
+! This would be much better if live-set was a real set
+: kill-defs ( live-set insn -- )
     defs-vregs [ ?leader ] map
-    '[ drop ?leader _ in? not ] assoc-filter! ; inline
+    '[ drop ?leader _ in? not ] assoc-filter! drop ; inline
 
-: gen-uses ( live-set insn -- live-set )
-    uses-vregs [ over conjoin ] each ; inline
+: gen-uses ( live-set insn -- )
+    uses-vregs [ swap conjoin ] with each ; inline
 
-M: vreg-insn visit-insn ( live-set insn -- live-set )
-    [ kill-defs ] [ gen-uses ] bi ;
+M: vreg-insn visit-insn ( live-set insn -- )
+    [ kill-defs ] [ gen-uses ] 2bi ;
 
 DEFER: lookup-base-pointer
 
@@ -96,19 +97,19 @@ M: vreg-insn lookup-base-pointer* 2drop f ;
     [ '[ drop _ _ visit-gc-root ] assoc-each ] 2keep
     members ;
 
-: fill-gc-map ( live-set gc-map -- live-set )
-    [ representations get [ dup gc-roots ] [ f f ] if ] dip
+: fill-gc-map ( live-set gc-map -- )
+    [ representations get [ gc-roots ] [ drop f f ] if ] dip
     [ gc-roots<< ] [ derived-roots<< ] bi ;
 
-M: gc-map-insn visit-insn ( live-set insn -- live-set )
-    [ kill-defs ] [ gc-map>> fill-gc-map ] [ gen-uses ] tri ;
+M: gc-map-insn visit-insn ( live-set insn -- )
+    [ kill-defs ] [ gc-map>> fill-gc-map ] [ gen-uses ] 2tri ;
 
 M: ##phi visit-insn kill-defs ;
 
-M: insn visit-insn drop ;
+M: insn visit-insn 2drop ;
 
-: transfer-liveness ( live-set instructions -- live-set' )
-    [ clone ] [ <reversed> ] bi* [ visit-insn ] each ;
+: transfer-liveness ( live-set insns -- )
+    <reversed> [ visit-insn ] with each ;
 
 SYMBOL: work-list
 
@@ -116,7 +117,7 @@ SYMBOL: work-list
     work-list get push-all-front ;
 
 : compute-live-in ( basic-block -- live-in )
-    [ live-out ] keep instructions>> transfer-liveness ;
+    [ live-out clone dup ] keep instructions>> transfer-liveness ;
 
 : compute-edge-live-in ( basic-block -- edge-live-in )
     H{ } clone [