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

SCM Repository

[diderot] Annotation of /branches/pure-cfg/src/compiler/codegen/tree-il-pp.sml
ViewVC logotype

Annotation of /branches/pure-cfg/src/compiler/codegen/tree-il-pp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 603 - (view) (download)

1 : jhr 535 (* tree-il-pp.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Printing for the TreeIL
7 :     *)
8 :    
9 :     structure TreeILPP : sig
10 :    
11 : jhr 603 val statement : TextIO.outstream * TreeIL.stm -> unit
12 :    
13 : jhr 535 val block : TextIO.outstream * TreeIL.block -> unit
14 :    
15 :     val program : TextIO.outstream * TreeIL.program -> unit
16 :    
17 :     end = struct
18 :    
19 :     structure IL = TreeIL
20 :     structure Op = IL.Op
21 :     structure Var = IL.Var
22 :     structure Ty = IL.Ty
23 :    
24 :     fun indent (outS, i) = TextIO.output(outS, StringCvt.padLeft #" " i "")
25 :     fun incIndent (outS, i) = (outS, i+2)
26 :     fun decIndent (outS, i) = (outS, Int.max(0, i-2))
27 :     fun pr ((outS, _), s) = TextIO.output(outS, s)
28 :     fun prl (out, l) = pr(out, concat l)
29 :     fun prln (out, l) = (indent out; prl(out, l))
30 :    
31 :     fun expToString e = let
32 :     fun toS (IL.E_Var x, l) = Var.name x :: l
33 :     | toS (IL.E_Lit lit, l) = Literal.toString lit :: l
34 :     | toS (IL.E_Op(rator, args), l) = let
35 :     fun argToS ([], l) = l
36 :     | argToS ([e], l) = toS (e, l)
37 :     | argToS (e::es, l) = toS(e, "," :: argToS(es, l))
38 :     in
39 :     Op.toString rator :: "(" :: argToS(args, ")" :: l)
40 :     end
41 :     in
42 :     String.concat (toS (e, []))
43 :     end
44 :    
45 : jhr 563 fun argsToString (prefix, es) = String.concat[
46 :     prefix, "(", String.concatWith "," (List.map expToString es), ")"
47 :     ]
48 :    
49 : jhr 535 fun ppVarDecl out x = prln (out, [Ty.toString(Var.ty x), " ", Var.name x, ";\n"])
50 :    
51 :     fun ppStrand out (IL.Strand{name, params, state, stateInit, methods}) = let
52 :     val out' = incIndent out
53 :     fun ppParams [] = ()
54 :     | ppParams [x] = prl(out, [Ty.toString (Var.ty x), " ", Var.name x])
55 :     | ppParams (x::r) = (
56 :     prl(out, [Ty.toString (Var.ty x), " ", Var.name x, ","]);
57 : jhr 539 ppParams r)
58 : jhr 535 in
59 : jhr 541 prln (out, ["strand ", Atom.toString name, " ("]);
60 : jhr 535 ppParams params; pr(out, ") {\n");
61 :     List.app (ppVarDecl out') state;
62 : jhr 539 prln (out', ["init () "]); ppBlock(out', stateInit); pr (out', "\n");
63 : jhr 535 List.app (ppMethod out') methods;
64 :     prln (out, ["}\n"])
65 :     end
66 :    
67 :     and ppMethod out (IL.Method{name, body}) = (
68 : jhr 539 prln (out, [Atom.toString name, " () "]);
69 : jhr 535 ppBlock (out, body);
70 :     pr (out, "\n"))
71 :    
72 :     and ppBlock (out, IL.Block{locals, body}) = let
73 :     val out' = incIndent out
74 :     in
75 :     pr (out, "{\n");
76 :     List.app (ppVarDecl out') locals;
77 :     List.app (fn stm => ppStm(out', stm)) body;
78 :     indent out; pr (out, "}")
79 :     end
80 :    
81 :     and ppStm (out, stm) = (case stm
82 :     of IL.S_Comment text => let
83 :     val out = decIndent out
84 :     in
85 :     List.app (fn s => prln(out, ["// ", s, "\n"])) text
86 :     end
87 :     | IL.S_Assign(x, e) => prln(out, [Var.name x, " = ", expToString e, ";\n"])
88 : jhr 543 | IL.S_Cons(x, args) => let
89 :     fun mkStrings [] = []
90 :     | mkStrings [e] = [expToString e]
91 :     | mkStrings (e::es) = (expToString e ^ ",") :: mkStrings es
92 :     val args = mkStrings args
93 :     in
94 :     if (List.foldl (fn (s, n) => n+size s) 0 args > 60)
95 :     then let
96 :     val out' = incIndent out
97 :     val out'' = incIndent out'
98 :     fun prArgs (_, []) = (
99 :     pr (out', "\n");
100 :     prln (out', ["};\n"]))
101 :     | prArgs (n, arg::args) =
102 :     if (n = 0)
103 :     then (
104 :     prln (out'', [arg]);
105 :     prArgs (n + size arg, args))
106 :     else if (n + size arg > 60)
107 :     then (
108 :     pr(out'', "\n");
109 :     prArgs (0, arg::args))
110 :     else (
111 :     pr(out'', " ");
112 :     pr(out'', arg);
113 :     prArgs (n + size arg + 1, args))
114 :     in
115 :     prln (out, [Var.name x, " = {\n"]);
116 :     prArgs (0, args)
117 :     end
118 :     else (
119 :     prln (out, Var.name x :: " = {" :: args);
120 :     pr (out, "};\n"))
121 : jhr 548 end
122 :     | IL.S_LoadVoxels(x, dim, exp) =>
123 :     prln (out, [
124 :     Var.name x, " = loadVoxels<",
125 :     Int.toString dim, "> (", expToString exp, ");\n"
126 :     ])
127 : jhr 535 | IL.S_LoadImage(x, dim, exp) =>
128 :     prln (out, [
129 :     Var.name x, " = load<", Int.toString dim, "> (", expToString exp, ");\n"
130 :     ])
131 :     | IL.S_Input(x, name, NONE) =>
132 :     prln (out, [
133 :     Var.name x, " = input<", Ty.toString(Var.ty x), "> (\"",
134 :     String.toString name, "\");\n"
135 :     ])
136 :     | IL.S_Input(x, name, SOME dflt) =>
137 :     prln (out, [
138 :     Var.name x, " = input<", Ty.toString(Var.ty x), "> (\"",
139 :     String.toString name, "\",", expToString dflt, ");\n"
140 :     ])
141 :     | IL.S_IfThen(cond, blk) => (
142 :     prln (out, ["if (", expToString cond, ") "]);
143 :     ppBlock (out, blk);
144 :     pr (out, "\n"))
145 :     | IL.S_IfThenElse(cond, blk1, blk2) => (
146 :     prln (out, ["if (", expToString cond, ") "]);
147 :     ppBlock (out, blk1);
148 :     pr (out, " else ");
149 :     ppBlock (out, blk2);
150 :     pr (out, "\n"))
151 : jhr 603 | IL.S_Exit es => prln (out, [argsToString("exit", es), ";\n"])
152 : jhr 563 (* return functions for methods *)
153 : jhr 603 | IL.S_Active es => prln (out, [argsToString("active", es), ";\n"])
154 :     | IL.S_Stabilize es => prln (out, [argsToString("stabilize", es), ";\n"])
155 : jhr 535 | IL.S_Die => prln (out, ["die;\n"])
156 :     (* end case *))
157 :    
158 : jhr 603 fun statement (outS, stm) = ppStm((outS, 0), stm)
159 :    
160 : jhr 535 fun block (outS, blk) = (ppBlock ((outS, 0), blk); pr ((outS, 0), "\n"))
161 :    
162 :     fun program (outS, IL.Program{globals, globalInit, strands}) = let
163 :     val out = (outS, 0)
164 :     val out' = incIndent out
165 :     in
166 :     prln(out, ["//***** GLOBALS *****\n"]);
167 :     List.app (ppVarDecl out') globals;
168 :     prln(out, ["//***** GLOBAL INIT *****\n"]);
169 :     indent out'; ppBlock (out', globalInit); pr (out, "\n");
170 :     prln(out, ["//***** STRANDS *****\n"]);
171 :     List.app (ppStrand out) strands
172 :     end
173 :    
174 :     end

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