Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/pure-cfg/src/compiler/IL/dump-dot-fn.sml
ViewVC logotype

Annotation of /branches/pure-cfg/src/compiler/IL/dump-dot-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1157 - (view) (download)

1 : jhr 1157 (* dump-dot-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * A debugging aid that dumps an IL control-flow graph as a dot file.
7 :     *)
8 :    
9 :     functor DumpDotFn (IL : SSA) : sig
10 :    
11 :     structure IL : SSA
12 :    
13 :     val dump : string * IL.cfg -> unit
14 :    
15 :     end = struct
16 :    
17 :     structure IL = IL
18 :    
19 :     fun indent (outS, i) = TextIO.output(outS, StringCvt.padLeft #" " i "")
20 :     fun incIndent (outS, i) = (outS, i+2)
21 :     fun pr ((outS, _), s) = TextIO.output(outS, s)
22 :     fun prl (out, l) = pr(out, concat l)
23 :     fun prln (out, l) = (indent out; prl(out, l))
24 :    
25 :     val n2s = IL.Node.toString
26 :    
27 :     val {getFn, setFn} = IL.Node.newFlag ()
28 :    
29 :     (* assuming that the current node is a simple node, do we need a new dot node for its
30 :     * successor?
31 :     *)
32 :     fun needNewDotNode nd = (case IL.Node.kind nd
33 :     of IL.COM _ => false
34 :     | IL.ASSIGN _ => false
35 :     | IL.NEW _ => false
36 :     | _ => true
37 :     (* end case *))
38 :    
39 :     fun dumpCFG (out, IL.CFG{entry, ...}) = let
40 :     val out' = incIndent out
41 :     val out'' = incIndent out'
42 :     fun prNode (name, shape) = prln (out', [name, " [shape = ", shape, "];\n"]);
43 :     fun prEdges (src, []) = ()
44 :     | prEdges (src, dsts) = prln (out'', [String.concatWith " -> " dsts, ";\n"])
45 :     fun dfs (label, edge, nd, l) =
46 :     if getFn nd
47 :     then l
48 :     else let
49 :     val l = nd::l
50 :     fun doEdge (dstNd, l) = let
51 :     val dstLabel = n2s dstNd
52 :     in
53 :     prln(out'', [label, " -> ", dstLabel, ";\n"]);
54 :     dfs (dstLabel, true, dstNd, l)
55 :     end
56 :     fun condEdge (dstNd, l) = if needNewDotNode dstNd
57 :     then doEdge (dstNd, l)
58 :     else dfs (label, false, dstNd, l)
59 :     in
60 :     setFn (nd, true);
61 :     case IL.Node.kind nd
62 :     of IL.NULL => (prNode (n2s nd, "plaintext"); l)
63 :     | IL.ENTRY{succ, ...} => (
64 :     prNode (label, "house");
65 :     doEdge (!succ, l))
66 :     | IL.JOIN{succ, ...} => (
67 :     prNode (label, "ellipse");
68 :     doEdge (!succ, l))
69 :     | IL.COND{trueBranch, falseBranch, ...} => (
70 :     prNode (label, "diamond");
71 :     doEdge (!trueBranch, doEdge (!falseBranch, l)))
72 :     | IL.COM{succ, ...} => (
73 :     if edge then prNode(label, "box") else ();
74 :     condEdge (!succ, l))
75 :     | IL.ASSIGN{succ, ...} =>(
76 :     if edge then prNode(label, "box") else ();
77 :     condEdge (!succ, l))
78 :     | IL.NEW{succ, ...} =>(
79 :     if edge then prNode(label, "box") else ();
80 :     condEdge (!succ, l))
81 :     | IL.EXIT _ => (prNode (label, "hexagon"); l)
82 :     (* end case *)
83 :     end
84 :     in
85 :     pr (out, "digraph CFG {\n");
86 :     prln (out', ["size = \"7.5,10\";\n"]);
87 :     prln (out', ["node [fontsize = 14];\n"]);
88 :     List.app (fn nd => setFn(nd, false))
89 :     (dfs (n2s entry, true, entry, []));
90 :     pr (out, "}\n")
91 :     end
92 :    
93 :     fun dump (fileName, cfg) = let
94 :     val outS = TextIO.openOut fileName
95 :     in
96 :     dumpCFG ((outS, 0), cfg);
97 :     TextIO.closeOut outS
98 :     end
99 :    
100 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0