SCM Repository
Annotation of /branches/charisee/src/compiler/tree-il/tree-il-pp.sml
Parent Directory
|
Revision Log
Revision 1923 -
(view)
(download)
Original Path: trunk/src/compiler/tree-il/tree-il-pp.sml
1 : | jhr | 1115 | (* 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 : | val statement : TextIO.outstream * TreeIL.stm -> unit | ||
12 : | |||
13 : | 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 argsToS (lp, args, rp, l) = let | ||
33 : | fun argToS ([], l) = l | ||
34 : | | argToS ([e], l) = toS (e, l) | ||
35 : | | argToS (e::es, l) = toS(e, "," :: argToS(es, l)) | ||
36 : | in | ||
37 : | lp :: argToS(args, rp :: l) | ||
38 : | end | ||
39 : | jhr | 1640 | and toS (IL.E_State x, l) = IL.stateVarToString x :: l |
40 : | | toS (IL.E_Var x, l) = (case (Var.kind x) | ||
41 : | jhr | 1380 | of IL.VK_Global => "::" :: Var.name x :: l |
42 : | | _ => Var.name x :: l | ||
43 : | (* end case *)) | ||
44 : | jhr | 1115 | | toS (IL.E_Lit lit, l) = Literal.toString lit :: l |
45 : | | toS (IL.E_Op(rator, args), l) = Op.toString rator :: argsToS ("(", args, ")", l) | ||
46 : | jhr | 1923 | | toS (IL.E_Apply(f, args), l) = MathFuns.toString f :: argsToS ("(", args, ")", l) |
47 : | jhr | 1115 | | toS (IL.E_Cons(ty, args), l) = |
48 : | "<" :: Ty.toString ty :: ">" :: argsToS ("{", args, "}", l) | ||
49 : | in | ||
50 : | String.concat (toS (e, [])) | ||
51 : | end | ||
52 : | |||
53 : | fun argsToString (prefix, es) = String.concat[ | ||
54 : | prefix, "(", String.concatWith "," (List.map expToString es), ")" | ||
55 : | ] | ||
56 : | |||
57 : | fun ppVarDecl out x = prln (out, [Ty.toString(Var.ty x), " ", Var.name x, ";\n"]) | ||
58 : | |||
59 : | fun ppStrand out (IL.Strand{name, params, state, stateInit, methods}) = let | ||
60 : | val out' = incIndent out | ||
61 : | fun ppParams [] = () | ||
62 : | | ppParams [x] = prl(out, [Ty.toString (Var.ty x), " ", Var.name x]) | ||
63 : | | ppParams (x::r) = ( | ||
64 : | prl(out, [Ty.toString (Var.ty x), " ", Var.name x, ","]); | ||
65 : | ppParams r) | ||
66 : | jhr | 1640 | fun ppSVarDecl (IL.SV{varying, output, name, ty, ...}) = let |
67 : | jhr | 1115 | val v = if varying then "varying " else "" |
68 : | val out = if output then "output " else "" | ||
69 : | in | ||
70 : | jhr | 1640 | prln (out', [v, out, Ty.toString ty, " ", name, ";\n"]) |
71 : | jhr | 1115 | end |
72 : | in | ||
73 : | prln (out, ["strand ", Atom.toString name, " ("]); | ||
74 : | ppParams params; pr(out, ") {\n"); | ||
75 : | List.app ppSVarDecl state; | ||
76 : | prln (out', ["init () "]); ppBlock(out', stateInit); pr (out', "\n"); | ||
77 : | List.app (ppMethod out') methods; | ||
78 : | prln (out, ["}\n"]) | ||
79 : | end | ||
80 : | |||
81 : | and ppMethod out (IL.Method{name, body}) = ( | ||
82 : | jhr | 1640 | prln (out, [StrandUtil.nameToString name, " () "]); |
83 : | jhr | 1115 | ppBlock (out, body); |
84 : | pr (out, "\n")) | ||
85 : | |||
86 : | and ppBlock (out, IL.Block{locals, body}) = let | ||
87 : | val out' = incIndent out | ||
88 : | in | ||
89 : | pr (out, "{\n"); | ||
90 : | List.app (ppVarDecl out') locals; | ||
91 : | List.app (fn stm => ppStm(out', stm)) body; | ||
92 : | indent out; pr (out, "}") | ||
93 : | end | ||
94 : | |||
95 : | and ppStm (out, stm) = (case stm | ||
96 : | of IL.S_Comment text => let | ||
97 : | val out = decIndent out | ||
98 : | in | ||
99 : | List.app (fn s => prln(out, ["// ", s, "\n"])) text | ||
100 : | end | ||
101 : | jhr | 1640 | | IL.S_Assign([], e) => prln(out, [expToString e, ";\n"]) |
102 : | | IL.S_Assign([x], e) => prln(out, [Var.name x, " = ", expToString e, ";\n"]) | ||
103 : | | IL.S_Assign(x::xs, e) => ( | ||
104 : | prln(out, ["(", Var.name x]); | ||
105 : | List.app (fn x => prl(out, [",", Var.name x])) xs; | ||
106 : | prl (out, [") = ", expToString e, ";\n"])) | ||
107 : | jhr | 1115 | | IL.S_IfThen(cond, blk) => ( |
108 : | prln (out, ["if (", expToString cond, ") "]); | ||
109 : | ppBlock (out, blk); | ||
110 : | pr (out, "\n")) | ||
111 : | | IL.S_IfThenElse(cond, blk1, blk2) => ( | ||
112 : | prln (out, ["if (", expToString cond, ") "]); | ||
113 : | ppBlock (out, blk1); | ||
114 : | pr (out, " else "); | ||
115 : | ppBlock (out, blk2); | ||
116 : | pr (out, "\n")) | ||
117 : | (* | ||
118 : | | IL.S_For(x, e1, e2, blk) => ( | ||
119 : | prln (out, [ | ||
120 : | "for (", Ty.toString(Var.ty x), " ", Var.name x, " = ", | ||
121 : | expToString e1, " ..", expToString e2, ") " | ||
122 : | ]); | ||
123 : | ppBlock (out, blk); | ||
124 : | pr (out, "\n")) | ||
125 : | *) | ||
126 : | jhr | 1131 | | IL.S_New(strand, args) => |
127 : | prln (out, [argsToString("new "^Atom.toString strand, args), ";\n"]) | ||
128 : | jhr | 1640 | | IL.S_Save([x], rhs) => |
129 : | prln (out, [IL.stateVarToString x, " = ", expToString rhs, ";\n"]) | ||
130 : | | IL.S_Save(x::xs, e) => ( | ||
131 : | prln(out, ["(", IL.stateVarToString x]); | ||
132 : | List.app (fn x => prl(out, [",", IL.stateVarToString x])) xs; | ||
133 : | prl (out, [") = ", expToString e, ";\n"])) | ||
134 : | jhr | 1115 | | IL.S_LoadImage(x, dim, exp) => |
135 : | prln (out, [ | ||
136 : | Var.name x, " = load<", Int.toString dim, "> (", expToString exp, ");\n" | ||
137 : | ]) | ||
138 : | jhr | 1301 | | IL.S_Input(x, name, desc, NONE) => |
139 : | jhr | 1115 | prln (out, [ |
140 : | Var.name x, " = input<", Ty.toString(Var.ty x), "> (\"", | ||
141 : | jhr | 1301 | String.toString name, "\",\"", String.toString desc, "\");\n" |
142 : | jhr | 1115 | ]) |
143 : | jhr | 1301 | | IL.S_Input(x, name, desc, SOME dflt) => |
144 : | jhr | 1115 | prln (out, [ |
145 : | Var.name x, " = input<", Ty.toString(Var.ty x), "> (\"", | ||
146 : | jhr | 1301 | String.toString name, "\",\"", String.toString desc, "\",", |
147 : | expToString dflt, ");\n" | ||
148 : | jhr | 1115 | ]) |
149 : | | IL.S_Exit es => prln (out, [argsToString("exit", es), ";\n"]) | ||
150 : | (* return functions for methods *) | ||
151 : | jhr | 1640 | | IL.S_Active => prln (out, ["active;\n"]) |
152 : | | IL.S_Stabilize => prln (out, ["stabilize;\n"]) | ||
153 : | jhr | 1115 | | IL.S_Die => prln (out, ["die;\n"]) |
154 : | (* end case *)) | ||
155 : | |||
156 : | fun statement (outS, stm) = ppStm((outS, 0), stm) | ||
157 : | |||
158 : | fun block (outS, blk) = (ppBlock ((outS, 0), blk); pr ((outS, 0), "\n")) | ||
159 : | |||
160 : | jhr | 1151 | fun ppInitially (out, {isArray, iterPrefix, iters, createPrefix, strand, args}) = let |
161 : | fun ppBlock (out, IL.Block{locals, body}, inside) = let | ||
162 : | val out' = incIndent out | ||
163 : | in | ||
164 : | pr (out, "{\n"); | ||
165 : | List.app (ppVarDecl out') locals; | ||
166 : | List.app (fn stm => ppStm(out', stm)) body; | ||
167 : | inside out'; | ||
168 : | indent out; pr (out, "}") | ||
169 : | end | ||
170 : | fun ppCreate out = let | ||
171 : | fun ppNew out = prln(out, [argsToString("new "^Atom.toString strand, args), ";\n"]) | ||
172 : | in | ||
173 : | indent out; ppBlock (out, createPrefix, ppNew); pr(out, "\n") | ||
174 : | end | ||
175 : | fun ppIters out = let | ||
176 : | fun ppIter (out, []) = ppCreate out | ||
177 : | | ppIter (out, (i, lo, hi)::iters) = ( | ||
178 : | prln(out, ["for ", Var.name i, " = ", expToString lo, " .. ", expToString hi, "\n"]); | ||
179 : | ppIter (incIndent out, iters)) | ||
180 : | in | ||
181 : | ppIter (out, iters) | ||
182 : | end | ||
183 : | in | ||
184 : | indent out; pr(out, if isArray then "ARRAY " else "COLLECTION "); | ||
185 : | jhr | 1232 | ppBlock (out, iterPrefix, ppIters); |
186 : | pr (out, "\n") | ||
187 : | jhr | 1151 | end |
188 : | |||
189 : | jhr | 1301 | fun program (outS, IL.Program{props, globals, inputInit, globalInit, strands, initially}) = let |
190 : | jhr | 1115 | val out = (outS, 0) |
191 : | val out' = incIndent out | ||
192 : | in | ||
193 : | jhr | 1131 | pr(out, "//***** PROPERTIES *****\n"); |
194 : | case props | ||
195 : | of [] => prln(out', ["none\n"]) | ||
196 : | jhr | 1640 | | _ => prln(out', [String.concatWith " " (List.map StrandUtil.propToString props), "\n"]) |
197 : | jhr | 1131 | (* end case *); |
198 : | jhr | 1115 | prln(out, ["//***** GLOBALS *****\n"]); |
199 : | List.app (ppVarDecl out') globals; | ||
200 : | jhr | 1301 | prln(out, ["//***** INPUT INIT *****\n"]); |
201 : | indent out'; ppBlock (out', inputInit); pr (out, "\n"); | ||
202 : | jhr | 1115 | prln(out, ["//***** GLOBAL INIT *****\n"]); |
203 : | indent out'; ppBlock (out', globalInit); pr (out, "\n"); | ||
204 : | prln(out, ["//***** STRANDS *****\n"]); | ||
205 : | List.app (ppStrand out) strands; | ||
206 : | jhr | 1151 | prln(out, ["//***** INITIALLY *****\n"]); |
207 : | ppInitially (out', initially) | ||
208 : | jhr | 1115 | end |
209 : | |||
210 : | end |
root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |
Powered by ViewVC 1.0.0 |