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

SCM Repository

[diderot] View of /trunk/src/compiler/IL/dump-dot-fn.sml
ViewVC logotype

View of /trunk/src/compiler/IL/dump-dot-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1232 - (download) (annotate)
Mon May 16 23:37:52 2011 UTC (8 years, 4 months ago) by jhr
File size: 2877 byte(s)
  Porting many changes from the pure-cfg branch, including value numbering
  and support for parallel execution on SMP systems.
(* dump-dot-fn.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * A debugging aid that dumps an IL control-flow graph as a dot file.
 *)

functor DumpDotFn (IL : SSA) : sig

    structure IL : SSA

    val dump : string * IL.cfg -> unit

  end = struct

    structure IL = IL

    fun indent (outS, i) = TextIO.output(outS, StringCvt.padLeft #" " i "")
    fun incIndent (outS, i) = (outS, i+2)
    fun pr ((outS, _), s) = TextIO.output(outS, s)
    fun prl (out, l) = pr(out, concat l)
    fun prln (out, l) = (indent out; prl(out, l))

    val n2s = IL.Node.toString

    val {getFn, setFn} = IL.Node.newFlag ()

  (* assuming that the current node is a simple node, do we need a new dot node for its
   * successor?
   *)
    fun needNewDotNode nd = (case IL.Node.kind nd
	   of IL.COM _ => false
	    | IL.ASSIGN _ => false
	    | IL.NEW _ => false
	    | _ => true
	  (* end case *))

    fun dumpCFG (out, IL.CFG{entry, ...}) = let
	  val out' = incIndent out
	  val out'' = incIndent out'
	  fun prNode (name, shape) = prln (out', [name, " [shape = ", shape, "];\n"]);
	  fun prEdges (src, []) = ()
	    | prEdges (src, dsts) = prln (out'', [String.concatWith " -> " dsts, ";\n"])
	  fun dfs (label, edge, nd, l) =
		if getFn nd
		  then l
		  else let
		    val l = nd::l
		    fun doEdge (dstNd, l) = let
			  val dstLabel = n2s dstNd
			  in
			    prln(out'', [label, " -> ", dstLabel, ";\n"]);
			    dfs (dstLabel, true, dstNd, l)
			  end
		    fun condEdge (dstNd, l) = if needNewDotNode dstNd
			  then doEdge (dstNd, l)
			  else dfs (label, false, dstNd, l)
		    in
		      setFn (nd, true);
		      case IL.Node.kind nd
		       of IL.NULL => (prNode (n2s nd, "plaintext"); l)
			| IL.ENTRY{succ, ...} => (
			    prNode (label, "house");
			    doEdge (!succ, l))
			| IL.JOIN{succ, ...} => (
			    prNode (label, "ellipse");
			    doEdge (!succ, l))
			| IL.COND{trueBranch, falseBranch, ...} => (
			    prNode (label, "diamond");
			    doEdge (!trueBranch, doEdge (!falseBranch, l)))
			| IL.COM{succ, ...} => (
			    if edge then prNode(label, "box") else ();
			    condEdge (!succ, l))
			| IL.ASSIGN{succ, ...} =>(
			    if edge then prNode(label, "box") else ();
			    condEdge (!succ, l))
			| IL.NEW{succ, ...} =>(
			    if edge then prNode(label, "box") else ();
			    condEdge (!succ, l))
			| IL.EXIT _ => (prNode (label, "hexagon"); l)
		      (* end case *)
		    end
	  in
	    pr (out, "digraph CFG {\n");
	    prln (out', ["size = \"7.5,10\";\n"]);
	    prln (out', ["node [fontsize = 14];\n"]);
	    List.app (fn nd => setFn(nd, false))
	      (dfs (n2s entry, true, entry, []));
	    pr (out, "}\n")
	  end

    fun dump (fileName, cfg) = let
	  val outS = TextIO.openOut fileName
	  in
	    dumpCFG ((outS, 0), cfg);
	    TextIO.closeOut outS
	  end

  end

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