Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/visualization/dot.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/visualization/dot.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 409 (*
2 :     * This communicates with the dot tool
3 :     *
4 :     * -- Allen
5 :     *)
6 :    
7 :     structure Dot : GRAPH_DISPLAY =
8 :     struct
9 :    
10 :     structure L = GraphLayout
11 :     structure G = Graph
12 :    
13 :     fun suffix() = ".dot"
14 : leunga 601 fun program() = "dotty"
15 : monnier 409
16 :     fun visualize out (G.GRAPH G) =
17 :     let val spaces = " ";
18 :     fun int n = out (Int.toString n)
19 :     fun tab t = out(String.substring(spaces,0,t)) handle _ => out spaces
20 :     fun semi() = out ";"
21 :     fun name n = if n < 0 then (out "XX"; int(~n))
22 :     else (out "X"; int n)
23 : leunga 601 fun attribs t a = (out "[ shape=box"; doAttribs t "," a; out "]")
24 : monnier 409
25 :     and doAttrib t comma (L.LABEL "") = false
26 :     | doAttrib t comma (L.LABEL l) = (out comma; tab t; label l; true)
27 :     | doAttrib t comma _ = false
28 :    
29 :     and doAttribs t comma [] = ()
30 :     | doAttribs t comma (l::ls) =
31 :     doAttribs t (if doAttrib t comma l then ",\n" else comma) ls
32 :    
33 :     and label l = (out "label=\""; out(String.toString l); out "\"\n")
34 :    
35 :     fun doNode t (n,a) = (tab t; name n; attribs t a; semi())
36 :    
37 :     fun doEdge t (i,j,a) =
38 :     (tab t; name i; out "-> "; name j; attribs t a; semi())
39 :    
40 : leunga 601 in out("digraph " ^ #name G ^ " {\n");
41 : monnier 409 #forall_nodes G (doNode 2);
42 :     #forall_edges G (doEdge 2);
43 :     out "}\n"
44 :     end
45 :    
46 :     end
47 :    

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