]> gitweb.factorcode.org Git - factor.git/commitdiff
compiler.cfg.graphviz: add render-dom word
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 28 Jul 2009 16:16:32 +0000 (11:16 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 28 Jul 2009 16:16:32 +0000 (11:16 -0500)
extra/compiler/cfg/graphviz/graphviz.factor

index d4513c839400a7578934c389047ace26d1b5b2b1..0aade1301f18b23414b46e30cd93d022ce65e92e 100644 (file)
@@ -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