compiler.cfg.debugger: clean up and make it more flexible

diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 9aa81a1b0dcbf09a8d8a6f5fc824f2326d674fea..8cbd23db020684d2f92a00f92fe9db4282b0cbdf 100644 (file)
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -10,21 +10,45 @@ compiler.cfg.stack-frame compiler.cfg.linear-scan
 compiler.cfg.optimizer compiler.cfg.finalization
 compiler.cfg.instructions compiler.cfg.utilities
 compiler.cfg.def-use compiler.cfg.rpo compiler.cfg.mr
-compiler.cfg.representations.preferred compiler.cfg ;
+compiler.cfg.representations
+compiler.cfg.representations.preferred
+compiler.cfg.gc-checks compiler.cfg.save-contexts compiler.cfg ;
 IN: compiler.cfg.debugger
 
-GENERIC: test-cfg ( quot -- cfgs )
+GENERIC: test-builder ( quot -- cfgs )
 
-M: callable test-cfg
+M: callable test-builder
     0 vreg-counter set-global
     build-tree optimize-tree gensym build-cfg ;
 
-M: word test-cfg
+M: word test-builder
     0 vreg-counter set-global
     [ build-tree optimize-tree ] keep build-cfg ;
 
-: test-mr ( quot -- mrs )
-    test-cfg [
+: test-optimizer ( quot -- cfgs )
+    test-builder [ [ optimize-cfg ] with-cfg ] map ;
+
+: test-ssa ( quot -- mrs )
+    test-builder [
+        [
+            optimize-cfg
+            flatten-cfg
+        ] with-cfg
+    ] map ;
+
+: test-flat ( quot -- mrs )
+    test-builder [
+        [
+            optimize-cfg
+            select-representations
+            insert-gc-checks
+            insert-save-contexts
+            flatten-cfg
+        ] with-cfg
+    ] map ;
+
+: test-regs ( quot -- mrs )
+    test-builder [
         [
             optimize-cfg
             finalize-cfg
@@ -32,21 +56,26 @@ M: word test-cfg
         ] with-cfg
     ] map ;
 
-: insn. ( insn -- )
-    tuple>array but-last [ pprint bl ] each nl ;
+GENERIC: insn. ( insn -- )
 
-: mr. ( mrs -- )
-    [
-        "=== word: " write
-        dup word>> pprint
-        ", label: " write
-        dup label>> pprint nl nl
-        instructions>> [ insn. ] each
-        nl
-    ] each ;
-
-: test-mr. ( quot -- )
-    test-mr mr. ; inline
+M: ##phi insn.
+    clone [ [ [ number>> ] dip ] assoc-map ] change-inputs
+    call-next-method ;
+
+M: insn insn. tuple>array but-last [ bl ] [ pprint ] interleave nl ;
+
+: mr. ( mr -- )
+    "=== word: " write
+    dup word>> pprint
+    ", label: " write
+    dup label>> pprint nl nl
+    instructions>> [ insn. ] each ;
+
+: mrs. ( mrs -- )
+    [ nl ] [ mr. ] interleave ;
+
+: flat. ( quot -- ) test-flat mrs. ; inline
+: regs. ( quot -- ) test-regs mrs. ; inline
 
 ! Prettyprinting
 : pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;

diff --git a/basis/typed/debugger/debugger.factor b/basis/typed/debugger/debugger.factor
index dae30fa9d80d7cafec5e0d89e4e7fd0e83ff452e..98a083a2babb32d878583b304676638859ec2fdd 100644 (file)
--- a/basis/typed/debugger/debugger.factor
+++ b/basis/typed/debugger/debugger.factor
@@ -3,12 +3,11 @@ USING: typed compiler.cfg.debugger compiler.tree.debugger
 tools.disassembler words ;
 IN: typed.debugger
 
-: typed-test-mr ( word -- mrs )
-    "typed-word" word-prop test-mr ; inline
-: typed-test-mr. ( word -- )
-    "typed-word" word-prop test-mr mr. ; inline
+M: typed-word test-builder
+    "typed-word" word-prop test-builder ;
+
 : typed-optimized. ( word -- )
-    "typed-word" word-prop optimized. ; inline
+    "typed-word" word-prop optimized. ;
 
-: typed-disassemble ( word -- )
-    "typed-word" word-prop disassemble ; inline
+M: typed-word disassemble ( word -- )
+    "typed-word" word-prop disassemble ;

diff --git a/basis/typed/typed.factor b/basis/typed/typed.factor
index 65b21fcc38236e7b32a6acfc2450a48c97b31a7f..50da7b1bad5e1386c45c563058ad97cb44837662 100644 (file)
--- a/basis/typed/typed.factor
+++ b/basis/typed/typed.factor
@@ -167,3 +167,4 @@ SYNTAX: TYPED::
 USE: vocabs.loader
 
 { "typed" "prettyprint" } "typed.prettyprint" require-when
+{ "typed" "compiler.cfg.debugger" } "typed.debugger" require-when

diff --git a/extra/compiler/graphviz/graphviz.factor b/extra/compiler/graphviz/graphviz.factor
index 7378d3284c36eb0a7243ec2965ed5d1a38a681fe..79a72b33eabbd8a357c4288f92f30f693c04f0bb 100644 (file)
--- a/extra/compiler/graphviz/graphviz.factor
+++ b/extra/compiler/graphviz/graphviz.factor
@@ -78,8 +78,8 @@ IN: compiler.graphviz
 : optimized-cfg ( quot -- cfgs )
     {
         { [ dup cfg? ] [ 1array ] }
-        { [ dup quotation? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
-        { [ dup word? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
+        { [ dup quotation? ] [ test-optimizer ] }
+        { [ dup word? ] [ test-optimizer ] }
         [ ]
     } cond ;