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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/ast/ast-pp.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/ast/ast-pp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3464 - (view) (download)

1 : jhr 3384 (* ast-pp.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 :     * Pretty printing for the AST representation.
9 :     *)
10 :    
11 :     structure ASTPP : sig
12 :    
13 : jhr 3437 val output : TextIO.outstream * string * AST.program -> unit
14 : jhr 3384
15 :     end = struct
16 :    
17 :     structure PP = TextIOPP
18 :     structure TU = TypeUtil
19 :    
20 :     val indent = PP.Abs 2
21 :    
22 :     fun ppList ppFn (left, sep, right) (ppStrm, list) = let
23 :     fun sp () = PP.space ppStrm 1
24 :     val string = PP.string ppStrm
25 :     fun pp [] = string right
26 :     | pp [x] = (ppFn(ppStrm, x); string right)
27 :     | pp (x::xs) = (ppFn(ppStrm, x); string sep; sp(); pp xs)
28 :     in
29 :     string left; pp list
30 :     end
31 :    
32 :     (* print type arguments; we use "#" to denote differentiation arguments, "$" to denote
33 :     * shape arguments, and "%" to denote dimension arguments.
34 :     *)
35 :     fun ppTyArgs (ppStrm, mvs) = let
36 :     val string = PP.string ppStrm
37 :     fun ppTyArg (_, mv) = (case mv
38 :     of Types.TYPE tv => string(TU.toString(TU.resolve tv))
39 :     | Types.DIFF dv => string("#"^TU.diffToString(TU.resolveDiff dv))
40 :     | Types.SHAPE sv => string("$"^TU.shapeToString(TU.resolveShape sv))
41 :     | Types.DIM dv => string("%"^TU.dimToString(TU.resolveDim dv))
42 :     (* end case *))
43 :     in
44 :     ppList ppTyArg ("<", ";", ">") (ppStrm, mvs)
45 :     end
46 :    
47 :     fun ppExp (ppStrm, e) = let
48 :     fun sp () = PP.space ppStrm 1
49 :     val string = PP.string ppStrm
50 :     fun var x = string(Var.nameOf x)
51 :     fun ppIndex (ppStrm, NONE) = PP.string ppStrm ":"
52 :     | ppIndex (ppStrm, SOME e) = ppExp (ppStrm, e)
53 :     fun pp e = (case e
54 : jhr 3407 of AST.E_Var(x, _) => var x
55 : jhr 3384 | AST.E_Lit lit => string (Literal.toString lit)
56 : jhr 3407 | AST.E_Select(e, (field, _)) => (pp e; string "."; var field)
57 :     | AST.E_Prim(f, [], args, _) => (var f; sp(); ppArgs (ppStrm, args))
58 :     | AST.E_Prim(f, mvs, args, _) => (
59 : jhr 3384 var f; ppTyArgs (ppStrm, mvs); sp(); ppArgs (ppStrm, args))
60 : jhr 3407 | AST.E_Apply((f, _), args, _) => (var f; sp(); ppArgs (ppStrm, args))
61 : jhr 3413 | AST.E_Comprehension(e, iter, _) => (
62 : jhr 3384 string "{";
63 :     pp e; sp(); string "|"; sp();
64 : jhr 3413 ppIter (ppStrm, iter);
65 : jhr 3384 string "}")
66 : jhr 3464 | AST.E_ParallelMap(e, x, xs, _)=> (
67 :     string "{|";
68 :     pp e; sp(); string "|"; sp();
69 :     PP.openHBox ppStrm;
70 :     string(TU.toString(#2(Var.typeOf x))); sp(); var x;
71 :     sp(); string "in"; sp(); var xs;
72 :     PP.closeBox ppStrm;
73 :     string "|}")
74 : jhr 3406 | AST.E_Tensor(es, _) => (
75 : jhr 3384 ppList ppExp ("[", ",", "]") (ppStrm, es))
76 :     | AST.E_Seq(es, _) => (
77 :     ppList ppExp ("{", ",", "}") (ppStrm, es))
78 :     | AST.E_Slice(e, indices, _) => (
79 :     pp e;
80 :     ppList ppIndex ("[", ",", "]") (ppStrm, indices))
81 :     | AST.E_Cond(e1, e2, e3, _) => (
82 :     pp e2; sp(); string "if"; sp(); pp e1; sp(); string "else"; sp(); pp e3)
83 :     | AST.E_LoadNrrd(mvs, name, ty) => (
84 :     case TU.pruneHead ty
85 : jhr 3398 of Types.T_Sequence _ => string "loadSeq"
86 : jhr 3384 | Types.T_Image _ => string "loadImage"
87 :     | _ => raise Fail "impossible"
88 :     (* end case *);
89 :     ppTyArgs (ppStrm, mvs); sp();
90 :     string(concat["(\"", name, "\")"]))
91 :     | AST.E_Coerce{dstTy, e, ...} => (
92 :     PP.openHBox ppStrm;
93 :     string "("; string(TU.toString dstTy); string ")";
94 :     PP.closeBox ppStrm;
95 :     case e
96 :     of AST.E_Var _ => pp e
97 :     | AST.E_Lit _ => pp e
98 : jhr 3406 | AST.E_Tensor _ => pp e
99 : jhr 3384 | AST.E_Seq _ => pp e
100 :     | _ => (string "("; pp e; string ")")
101 :     (* end case *))
102 :     (* end case *))
103 :     in
104 :     pp e
105 :     end
106 :    
107 :     and ppArgs (ppStrm, args) = ppList ppExp ("(", ",", ")") (ppStrm, args)
108 :    
109 :     and ppIter (ppStrm, (x, e)) = let
110 :     fun sp () = PP.space ppStrm 1
111 :     val string = PP.string ppStrm
112 :     in
113 :     PP.openHBox ppStrm;
114 :     string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x);
115 :     sp(); string "in"; sp(); ppExp(ppStrm, e);
116 :     PP.closeBox ppStrm
117 :     end
118 :    
119 :     fun ppVarDecl ppStrm (x, e) = let
120 :     fun sp () = PP.space ppStrm 1
121 :     val string = PP.string ppStrm
122 :     in
123 :     PP.openHBox ppStrm;
124 :     case Var.kindOf x
125 :     of AST.ConstVar => (string "const"; sp())
126 :     | AST.InputVar => (string "input"; sp())
127 :     | AST.StrandOutputVar => (string "output"; sp())
128 :     | _ => ()
129 :     (* end case *);
130 :     string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x);
131 :     case e
132 :     of SOME e => (sp(); string "="; sp(); ppExp(ppStrm, e); string ";")
133 :     | NONE => ()
134 :     (* end case *);
135 :     PP.closeBox ppStrm
136 :     end
137 :    
138 :     fun ppBlock (ppStrm, stms) = let
139 :     fun sp () = PP.space ppStrm 1
140 :     fun nl () = PP.newline ppStrm
141 :     val string = PP.string ppStrm
142 :     fun ppStmt stmt = (case stmt
143 :     of AST.S_Block stms => ppBlock (ppStrm, stms)
144 :     | AST.S_Decl vdcl => (ppVarDecl ppStrm vdcl; nl())
145 :     | AST.S_IfThenElse(e, AST.S_Block stms, AST.S_Block[]) => (
146 :     PP.openHBox ppStrm;
147 :     string "if"; sp(); ppExp(ppStrm, e);
148 :     sp(); ppBlock (ppStrm, stms);
149 :     PP.closeBox ppStrm)
150 :     | AST.S_IfThenElse(e, s1, AST.S_Block[]) => (
151 :     PP.openVBox ppStrm indent;
152 :     PP.openHBox ppStrm;
153 :     string "if"; sp(); ppExp(ppStrm, e);
154 :     PP.closeBox ppStrm;
155 :     nl();
156 :     ppStmt s1;
157 : jhr 3433 PP.closeBox ppStrm)
158 : jhr 3384 | AST.S_IfThenElse(e, s1, s2) => (
159 :     PP.openHBox ppStrm;
160 :     string "if"; sp(); ppExp(ppStrm, e);
161 :     sp(); ppBlockStmt (ppStrm, s1);
162 :     PP.closeBox ppStrm;
163 :     PP.openHBox ppStrm;
164 :     string "else"; sp(); ppBlockStmt (ppStrm, s2);
165 :     PP.closeBox ppStrm)
166 : jhr 3411 | AST.S_Foreach((x, e), s) => (
167 : jhr 3384 PP.openHBox ppStrm;
168 :     string "foreach"; sp(); string "(";
169 :     ppIter (ppStrm, (x, e));
170 :     string ")"; sp();
171 :     ppBlockStmt (ppStrm, s);
172 :     PP.closeBox ppStrm)
173 : jhr 3411 | AST.S_Assign((x, _), e) => (
174 : jhr 3384 PP.openHBox ppStrm;
175 :     string(Var.nameOf x); sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
176 :     PP.closeBox ppStrm;
177 :     nl())
178 :     | AST.S_New(strand, args) => (
179 :     PP.openHBox ppStrm;
180 :     string "new"; sp(); string(Atom.toString strand); sp();
181 :     ppArgs (ppStrm, args); string ";";
182 :     PP.closeBox ppStrm;
183 :     nl())
184 :     | AST.S_Continue => (string "continue;"; nl())
185 :     | AST.S_Die => (string "die;"; nl())
186 :     | AST.S_Stabilize => (string "stabilize;"; nl())
187 :     | AST.S_Return e => (
188 :     PP.openHBox ppStrm;
189 :     string "return"; sp(); ppExp(ppStrm, e); string ";";
190 :     PP.closeBox ppStrm;
191 :     nl())
192 :     | AST.S_Print args => (
193 :     PP.openHBox ppStrm;
194 :     string "print"; sp(); ppArgs (ppStrm, args); string ";";
195 :     PP.closeBox ppStrm;
196 :     nl())
197 :     (* end case *))
198 :     in
199 :     PP.openVBox ppStrm (PP.Abs 0);
200 : jhr 3425 string "{";
201 : jhr 3384 PP.openVBox ppStrm indent;
202 : jhr 3425 nl();
203 : jhr 3384 List.app ppStmt stms;
204 :     PP.closeBox ppStrm;
205 : jhr 3425 string "}";
206 :     PP.closeBox ppStrm;
207 :     nl()
208 : jhr 3384 end
209 :    
210 :     and ppBlockStmt (ppStrm, AST.S_Block stms) = ppBlock (ppStrm, stms)
211 :     | ppBlockStmt (ppStrm, stm) = ppBlock (ppStrm, [stm])
212 :    
213 :     fun ppParams (ppStrm, params) = let
214 :     fun sp () = PP.space ppStrm 1
215 :     val string = PP.string ppStrm
216 :     in
217 :     ppList
218 :     (fn (_, x) => (string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x)))
219 :     ("(", ",", ")")
220 :     (ppStrm, params)
221 :     end
222 :    
223 : jhr 3452 fun ppStrand (ppStrm, AST.Strand{name, params, state, initM, updateM, stabilizeM}) = let
224 : jhr 3384 fun sp () = PP.space ppStrm 1
225 :     fun nl () = PP.newline ppStrm
226 :     val string = PP.string ppStrm
227 : jhr 3425 (*
228 : jhr 3414 fun ppMethod name (AST.S_Block stms) = (nl(); string name; nl(); ppBlock (ppStrm, stms))
229 :     | ppMethod name stm = (nl(); string name; nl(); ppBlock (ppStrm, [stm]))
230 : jhr 3425 *)
231 :     fun ppMethod name stm = (
232 :     PP.openHBox ppStrm;
233 :     string name; sp();
234 :     ppBlockStmt (ppStrm, stm);
235 :     PP.closeBox ppStrm)
236 : jhr 3384 in
237 :     PP.openHBox ppStrm;
238 :     string "strand"; sp(); string(Atom.toString name); sp();
239 :     ppParams (ppStrm, params);
240 :     PP.closeBox ppStrm;
241 :     nl();
242 :     PP.openVBox ppStrm indent;
243 :     string "{";
244 :     List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) state;
245 : jhr 3425 nl();
246 : jhr 3452 Option.app (ppMethod "initially") initM;
247 :     ppMethod "update" updateM;
248 :     Option.app (ppMethod "stabilize") stabilizeM;
249 : jhr 3384 PP.closeBox ppStrm;
250 :     nl();
251 :     string "}"; nl()
252 :     end
253 :    
254 : jhr 3411 fun ppInput ppStrm = let
255 : jhr 3384 fun sp () = PP.space ppStrm 1
256 :     fun nl () = PP.newline ppStrm
257 :     val string = PP.string ppStrm
258 :     fun var x = string(Var.nameOf x)
259 :     fun ppDesc NONE = ()
260 :     | ppDesc (SOME desc) = (
261 :     string(concat["(\"", String.toString desc, "\")"]); sp())
262 : jhr 3411 in
263 :     fn ((x, SOME e), desc) => (
264 : jhr 3384 PP.openHBox ppStrm;
265 :     string "input"; sp();
266 :     ppDesc desc;
267 : jhr 3411 string(TU.toString(#2(Var.typeOf x))); sp(); var x;
268 :     sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
269 : jhr 3384 PP.closeBox ppStrm;
270 :     nl())
271 : jhr 3411 | ((x, NONE), desc) => (
272 : jhr 3384 PP.openHBox ppStrm;
273 :     string "input"; sp();
274 :     ppDesc desc;
275 : jhr 3411 string(TU.toString(#2(Var.typeOf x))); sp(); var x; string ";";
276 : jhr 3384 PP.closeBox ppStrm;
277 :     nl())
278 : jhr 3411 end
279 :    
280 :     fun ppDecl ppStrm = let
281 :     fun sp () = PP.space ppStrm 1
282 :     fun nl () = PP.newline ppStrm
283 :     val string = PP.string ppStrm
284 :     fun var x = string(Var.nameOf x)
285 :     fun ppDesc NONE = ()
286 :     | ppDesc (SOME desc) = (
287 :     string(concat["(\"", String.toString desc, "\")"]); sp())
288 :     in
289 :     fn AST.D_Var vdcl => (ppVarDecl ppStrm vdcl; nl())
290 : jhr 3384 | AST.D_Func(f, params, body) => (
291 :     PP.openHBox ppStrm;
292 :     string "function"; sp();
293 :     string(TU.toString(TU.rngOf(Var.monoTypeOf f)));
294 :     sp(); var f; sp(); ppParams (ppStrm, params);
295 :     PP.closeBox ppStrm;
296 :     nl();
297 :     case body
298 :     of AST.S_Block stms => ppBlock (ppStrm, stms)
299 :     | stm => ppBlock (ppStrm, [stm])
300 :     (* end case *))
301 :     end
302 :    
303 : jhr 3411 fun ppCreate (ppStrm, cr) = (
304 :     PP.openVBox ppStrm (PP.Abs 0);
305 :     PP.openVBox ppStrm indent;
306 :     case cr
307 :     of AST.C_Grid(d, stmt) => (
308 :     PP.string ppStrm (concat["grid(", Int.toString d, ") "]);
309 :     ppBlockStmt (ppStrm, stmt))
310 :     | AST.C_Collection stmt => (
311 :     PP.string ppStrm "collection ";
312 :     ppBlockStmt (ppStrm, stmt))
313 :     (* end case *);
314 :     PP.closeBox ppStrm;
315 :     PP.newline ppStrm;
316 :     PP.closeBox ppStrm)
317 :    
318 : jhr 3437 fun output (outS, message, prog) = let
319 : jhr 3411 val AST.Program{
320 :     props, const_dcls, input_dcls, globals,
321 :     strand, init, create, update
322 :     } = prog
323 : jhr 3384 val ppStrm = PP.openOut {dst = outS, wid = 120}
324 :     fun sp () = PP.space ppStrm 1
325 :     fun nl () = PP.newline ppStrm
326 :     val string = PP.string ppStrm
327 :     fun ppTopBlock (prefix, SOME stm) = (
328 :     PP.openHBox ppStrm;
329 :     string prefix; sp();
330 :     ppBlockStmt (ppStrm, stm);
331 :     PP.closeBox ppStrm)
332 :     | ppTopBlock _ = ()
333 :     in
334 :     PP.openVBox ppStrm (PP.Abs 0);
335 :     string "/* Program start */"; PP.newline ppStrm;
336 :     PP.openHBox ppStrm;
337 :     PP.string ppStrm "properties:";
338 :     sp();
339 : jhr 3431 string (Properties.propsToString props);
340 : jhr 3384 PP.newline ppStrm;
341 :     PP.closeBox ppStrm;
342 : jhr 3411 List.app (ppVarDecl ppStrm) const_dcls;
343 :     List.app (ppInput ppStrm) input_dcls;
344 : jhr 3384 List.app (ppDecl ppStrm) globals;
345 :     ppStrand (ppStrm, strand);
346 :     ppTopBlock ("initially", init);
347 : jhr 3411 ppCreate (ppStrm, create);
348 : jhr 3384 ppTopBlock ("update", update);
349 :     string "/* Program end */"; PP.newline ppStrm;
350 :     PP.closeBox ppStrm;
351 :     PP.closeStream ppStrm
352 :     end
353 :    
354 :     end

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