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 3349 - (view) (download)

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

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