From 33eb15bf44a06c4f00b31d2b43ce8269c6de87bc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 30 Apr 2010 05:33:17 -0400
Subject: [PATCH] compiler.cfg.debugger: clean up and make it more flexible

---
 basis/compiler/cfg/debugger/debugger.factor | 67 +++++++++++++++------
 basis/typed/debugger/debugger.factor        | 15 +++--
 basis/typed/typed.factor                    |  1 +
 extra/compiler/graphviz/graphviz.factor     |  4 +-
 4 files changed, 58 insertions(+), 29 deletions(-)

diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 9aa81a1b0d..8cbd23db02 100644
--- 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 ;
+M: ##phi insn.
+    clone [ [ [ number>> ] dip ] assoc-map ] change-inputs
+    call-next-method ;
 
-: test-mr. ( quot -- )
-    test-mr mr. ; inline
+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 dae30fa9d8..98a083a2ba 100644
--- 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
-: typed-optimized. ( word -- )
-    "typed-word" word-prop optimized. ; inline
+M: typed-word test-builder
+    "typed-word" word-prop test-builder ;
 
-: typed-disassemble ( word -- )
-    "typed-word" word-prop disassemble ; inline
+: typed-optimized. ( word -- )
+    "typed-word" word-prop optimized. ;
+
+M: typed-word disassemble ( word -- )
+    "typed-word" word-prop disassemble ;
diff --git a/basis/typed/typed.factor b/basis/typed/typed.factor
index 65b21fcc38..50da7b1bad 100644
--- 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 7378d3284c..79a72b33ea 100644
--- 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 ;