From d18a80dedb0c6a8c4db491ee4578301a658874ac Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 28 Jul 2009 11:16:32 -0500
Subject: [PATCH] compiler.cfg.graphviz: add render-dom word

---
 extra/compiler/cfg/graphviz/graphviz.factor | 50 +++++++++++++++------
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/extra/compiler/cfg/graphviz/graphviz.factor b/extra/compiler/cfg/graphviz/graphviz.factor
index d4513c8394..0aade1301f 100644
--- a/extra/compiler/cfg/graphviz/graphviz.factor
+++ b/extra/compiler/cfg/graphviz/graphviz.factor
@@ -1,22 +1,44 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license
-USING: accessors compiler.cfg.rpo images.viewer io
-io.encodings.ascii io.files io.files.unique io.launcher kernel
-math.parser sequences ;
+USING: accessors compiler.cfg.rpo compiler.cfg.dominance
+compiler.cfg.dominance.private compiler.cfg.predecessors images.viewer
+io io.encodings.ascii io.files io.files.unique io.launcher kernel
+math.parser sequences assocs arrays make namespaces ;
 IN: compiler.cfg.graphviz
 
-: cfg>dot ( cfg -- )
-    "digraph CFG {" print
-    [
-        [ number>> ] [ successors>> ] bi [
-            number>> [ number>string ] bi@ " -> " glue write ";" print
-        ] with each
-    ] each-basic-block
-    "}" print ;
-
-: render-cfg ( cfg -- )
+: render-graph ( edges -- )
     "cfg" "dot" make-unique-file
-    [ ascii [ cfg>dot ] with-file-writer ]
+    [
+        ascii [
+            "digraph CFG {" print
+            [ [ number>> number>string ] bi@ " -> " glue write ";" print ] assoc-each
+            "}" print
+        ] with-file-writer
+    ]
     [ { "dot" "-Tpng" "-O" } swap suffix try-process ]
     [ ".png" append { "open" } swap suffix try-process ]
     tri ;
+
+: cfg-edges ( cfg -- edges )
+    [
+        [
+            dup successors>> [
+                2array ,
+            ] with each
+        ] each-basic-block
+    ] { } make ;
+
+: render-cfg ( cfg -- ) cfg-edges render-graph ;
+
+: dom-edges ( cfg -- edges )
+    [
+        compute-predecessors
+        compute-dominance
+        dom-childrens get [
+            [
+                2array ,
+            ] with each
+        ] assoc-each
+    ] { } make ;
+
+: render-dom ( cfg -- ) dom-edges render-graph ;
\ No newline at end of file