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/benchmarks/programs/b-hut/dump.sml
ViewVC logotype

Annotation of /sml/trunk/benchmarks/programs/b-hut/dump.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 193 - (view) (download)

1 : monnier 193 (* dump.sml
2 :     *
3 :     * COPYRIGHT (c) 1993, AT&T Bell Laboratories.
4 :     *
5 :     * Code to dump out the tree as a ``dot'' specification.
6 :     *)
7 :    
8 :     functor Dump (V : VECTOR) =
9 :     struct
10 :     structure M = Main(V)
11 :     structure S = M.S
12 :     structure V = M.V
13 :    
14 :     fun dumpTree (fname, root, bodies) = let
15 :     val strm = IO.open_out fname
16 :     fun print (fmt, items) = IO.output (strm, Format.format fmt items)
17 :     fun indent i = Format.LEFT(i+i, Format.STR "")
18 :     fun bodyName b = let
19 :     fun find ([], _) = raise Fail "bodyNd"
20 :     | find (b'::r, i) = if (b = b') then i else find(r, i+1)
21 :     in
22 :     find (bodies, 0)
23 :     end
24 :     fun bodyNd (i, id, b) =
25 :     print ("%s nd%d [label=\"p%d\", shape=circle, height=0.2, width=0.2];\n", [
26 :     indent i, Format.INT id, Format.INT(bodyName b)
27 :     ])
28 :     fun cellNd (i, id) =
29 :     print ("%s nd%d [label=\"\", shape=box, height=0.4, width=0.1];\n", [
30 :     indent i, Format.INT id
31 :     ])
32 :     fun edge (i, fromId, toId) = print ("%s nd%d -> nd%d;\n", [
33 :     indent i, Format.INT fromId, Format.INT toId
34 :     ])
35 :     val levels = Array.array(32, [] : int list)
36 :     fun addNd (lvl, id) =
37 :     Array.update(levels, lvl, id :: Array.sub(levels, lvl))
38 :     fun prLevels () = let
39 :     fun loop i = (case Array.sub(levels, i)
40 :     of [] => ()
41 :     | l => (
42 :     print (" { rank = same;", []);
43 :     app (fn id => print(" nd%d;", [Format.INT id])) l;
44 :     print ("};\n", []);
45 :     loop (i+1))
46 :     (* end case *))
47 :     in
48 :     loop 0
49 :     end
50 :     fun walk (_, _, S.Empty, nextId) = nextId
51 :     | walk (lvl, parentId, S.Node{cell, ...}, nextId) = (
52 :     addNd (lvl, nextId);
53 :     edge (lvl, parentId, nextId);
54 :     case cell
55 :     of (S.BodyCell b) => (bodyNd(lvl+1, nextId, b); nextId+1)
56 :     | (S.Cell a) => (
57 :     cellNd(lvl+1, nextId);
58 :     walkCell(lvl+1, a, nextId))
59 :     (* end case *))
60 :     and walkCell (lvl, a, parentId) = let
61 :     fun lp (i, nextId') = if (i < S.nsub)
62 :     then lp (i+1, walk (lvl, parentId, Array.sub(a, i), nextId'))
63 :     else nextId'
64 :     in
65 :     lp (0, parentId+1)
66 :     end
67 :     in
68 :     print ("digraph tree {\n", []);
69 :     print (" rankdir = LR;\n", []);
70 :     print (" size = \"7.5,10\";\n", []);
71 :     print (" ordering = out;\n", []);
72 :     print (" fontsize = 8\n", []);
73 :     print (" ranksep = 2\n", []);
74 :     case root
75 :     of S.Empty => ()
76 :     | (S.Node{cell=S.BodyCell b, ...}) => (
77 :     addNd (0, 0); bodyNd(0, 0, b); ())
78 :     | (S.Node{cell=S.Cell a, ...}) => (
79 :     addNd (0, 0); walkCell(1, a, 0); ())
80 :     (* end case *);
81 :     prLevels ();
82 :     print ("}\n", []);
83 :     IO.close_out strm
84 :     end
85 :    
86 :     fun dumpTest (fname, n) = let
87 :     val _ = M.srand 123
88 :     val data = M.testdata n
89 :     val S.Space{root, ...} =
90 :     M.L.makeTree (data, V.tabulate (fn _ => ~2.0), 4.0);
91 :     in
92 :     dumpTree (fname, root, data)
93 :     end
94 :    
95 :     end;
96 :    

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