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

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-optimizer ( quot -- cfgs )
-    test-cfg [
+    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 -- )
+GENERIC: insn. ( insn -- )
-    tuple>array but-last [ pprint bl ] each nl ;
 
-: mr. ( mrs -- )
+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
+    instructions>> [ insn. ] each ;
-        nl
-    ] each ;
 
-: test-mr. ( quot -- )
+: mrs. ( mrs -- )
-    test-mr mr. ; inline
+    [ 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> ;

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 )
+M: typed-word test-builder
-    "typed-word" word-prop test-mr ; inline
+    "typed-word" word-prop test-builder ;
-: typed-test-mr. ( word -- )
-    "typed-word" word-prop test-mr mr. ; inline
-: typed-optimized. ( word -- )
-    "typed-word" word-prop optimized. ; inline
 
-: typed-disassemble ( word -- )
+: typed-optimized. ( word -- )
-    "typed-word" word-prop disassemble ; inline
+    "typed-word" word-prop optimized. ;
+
+M: typed-word disassemble ( word -- )
+    "typed-word" word-prop disassemble ;

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

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 quotation? ] [ test-optimizer ] }
-        { [ dup word? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
+        { [ dup word? ] [ test-optimizer ] }
         [ ]
     } cond ;