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 3452 - (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 3406 | AST.E_Tensor(es, _) => (
67 : jhr 3384 ppList ppExp ("[", ",", "]") (ppStrm, es))
68 :     | AST.E_Seq(es, _) => (
69 :     ppList ppExp ("{", ",", "}") (ppStrm, es))
70 :     | AST.E_Slice(e, indices, _) => (
71 :     pp e;
72 :     ppList ppIndex ("[", ",", "]") (ppStrm, indices))
73 :     | AST.E_Cond(e1, e2, e3, _) => (
74 :     pp e2; sp(); string "if"; sp(); pp e1; sp(); string "else"; sp(); pp e3)
75 :     | AST.E_LoadNrrd(mvs, name, ty) => (
76 :     case TU.pruneHead ty
77 : jhr 3398 of Types.T_Sequence _ => string "loadSeq"
78 : jhr 3384 | Types.T_Image _ => string "loadImage"
79 :     | _ => raise Fail "impossible"
80 :     (* end case *);
81 :     ppTyArgs (ppStrm, mvs); sp();
82 :     string(concat["(\"", name, "\")"]))
83 :     | AST.E_Coerce{dstTy, e, ...} => (
84 :     PP.openHBox ppStrm;
85 :     string "("; string(TU.toString dstTy); string ")";
86 :     PP.closeBox ppStrm;
87 :     case e
88 :     of AST.E_Var _ => pp e
89 :     | AST.E_Lit _ => pp e
90 : jhr 3406 | AST.E_Tensor _ => pp e
91 : jhr 3384 | AST.E_Seq _ => pp e
92 :     | _ => (string "("; pp e; string ")")
93 :     (* end case *))
94 :     (* end case *))
95 :     in
96 :     pp e
97 :     end
98 :    
99 :     and ppArgs (ppStrm, args) = ppList ppExp ("(", ",", ")") (ppStrm, args)
100 :    
101 :     and ppIter (ppStrm, (x, e)) = let
102 :     fun sp () = PP.space ppStrm 1
103 :     val string = PP.string ppStrm
104 :     in
105 :     PP.openHBox ppStrm;
106 :     string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x);
107 :     sp(); string "in"; sp(); ppExp(ppStrm, e);
108 :     PP.closeBox ppStrm
109 :     end
110 :    
111 :     fun ppVarDecl ppStrm (x, e) = let
112 :     fun sp () = PP.space ppStrm 1
113 :     val string = PP.string ppStrm
114 :     in
115 :     PP.openHBox ppStrm;
116 :     case Var.kindOf x
117 :     of AST.ConstVar => (string "const"; sp())
118 :     | AST.InputVar => (string "input"; sp())
119 :     | AST.StrandOutputVar => (string "output"; sp())
120 :     | _ => ()
121 :     (* end case *);
122 :     string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x);
123 :     case e
124 :     of SOME e => (sp(); string "="; sp(); ppExp(ppStrm, e); string ";")
125 :     | NONE => ()
126 :     (* end case *);
127 :     PP.closeBox ppStrm
128 :     end
129 :    
130 :     fun ppBlock (ppStrm, stms) = let
131 :     fun sp () = PP.space ppStrm 1
132 :     fun nl () = PP.newline ppStrm
133 :     val string = PP.string ppStrm
134 :     fun ppStmt stmt = (case stmt
135 :     of AST.S_Block stms => ppBlock (ppStrm, stms)
136 :     | AST.S_Decl vdcl => (ppVarDecl ppStrm vdcl; nl())
137 :     | AST.S_IfThenElse(e, AST.S_Block stms, AST.S_Block[]) => (
138 :     PP.openHBox ppStrm;
139 :     string "if"; sp(); ppExp(ppStrm, e);
140 :     sp(); ppBlock (ppStrm, stms);
141 :     PP.closeBox ppStrm)
142 :     | AST.S_IfThenElse(e, s1, AST.S_Block[]) => (
143 :     PP.openVBox ppStrm indent;
144 :     PP.openHBox ppStrm;
145 :     string "if"; sp(); ppExp(ppStrm, e);
146 :     PP.closeBox ppStrm;
147 :     nl();
148 :     ppStmt s1;
149 : jhr 3433 PP.closeBox ppStrm)
150 : jhr 3384 | AST.S_IfThenElse(e, s1, s2) => (
151 :     PP.openHBox ppStrm;
152 :     string "if"; sp(); ppExp(ppStrm, e);
153 :     sp(); ppBlockStmt (ppStrm, s1);
154 :     PP.closeBox ppStrm;
155 :     PP.openHBox ppStrm;
156 :     string "else"; sp(); ppBlockStmt (ppStrm, s2);
157 :     PP.closeBox ppStrm)
158 : jhr 3411 | AST.S_Foreach((x, e), s) => (
159 : jhr 3384 PP.openHBox ppStrm;
160 :     string "foreach"; sp(); string "(";
161 :     ppIter (ppStrm, (x, e));
162 :     string ")"; sp();
163 :     ppBlockStmt (ppStrm, s);
164 :     PP.closeBox ppStrm)
165 : jhr 3411 | AST.S_Assign((x, _), e) => (
166 : jhr 3384 PP.openHBox ppStrm;
167 :     string(Var.nameOf x); sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
168 :     PP.closeBox ppStrm;
169 :     nl())
170 :     | AST.S_New(strand, args) => (
171 :     PP.openHBox ppStrm;
172 :     string "new"; sp(); string(Atom.toString strand); sp();
173 :     ppArgs (ppStrm, args); string ";";
174 :     PP.closeBox ppStrm;
175 :     nl())
176 :     | AST.S_Continue => (string "continue;"; nl())
177 :     | AST.S_Die => (string "die;"; nl())
178 :     | AST.S_Stabilize => (string "stabilize;"; nl())
179 :     | AST.S_Return e => (
180 :     PP.openHBox ppStrm;
181 :     string "return"; sp(); ppExp(ppStrm, e); string ";";
182 :     PP.closeBox ppStrm;
183 :     nl())
184 :     | AST.S_Print args => (
185 :     PP.openHBox ppStrm;
186 :     string "print"; sp(); ppArgs (ppStrm, args); string ";";
187 :     PP.closeBox ppStrm;
188 :     nl())
189 :     (* end case *))
190 :     in
191 :     PP.openVBox ppStrm (PP.Abs 0);
192 : jhr 3425 string "{";
193 : jhr 3384 PP.openVBox ppStrm indent;
194 : jhr 3425 nl();
195 : jhr 3384 List.app ppStmt stms;
196 :     PP.closeBox ppStrm;
197 : jhr 3425 string "}";
198 :     PP.closeBox ppStrm;
199 :     nl()
200 : jhr 3384 end
201 :    
202 :     and ppBlockStmt (ppStrm, AST.S_Block stms) = ppBlock (ppStrm, stms)
203 :     | ppBlockStmt (ppStrm, stm) = ppBlock (ppStrm, [stm])
204 :    
205 :     fun ppParams (ppStrm, params) = let
206 :     fun sp () = PP.space ppStrm 1
207 :     val string = PP.string ppStrm
208 :     in
209 :     ppList
210 :     (fn (_, x) => (string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x)))
211 :     ("(", ",", ")")
212 :     (ppStrm, params)
213 :     end
214 :    
215 : jhr 3452 fun ppStrand (ppStrm, AST.Strand{name, params, state, initM, updateM, stabilizeM}) = let
216 : jhr 3384 fun sp () = PP.space ppStrm 1
217 :     fun nl () = PP.newline ppStrm
218 :     val string = PP.string ppStrm
219 : jhr 3425 (*
220 : jhr 3414 fun ppMethod name (AST.S_Block stms) = (nl(); string name; nl(); ppBlock (ppStrm, stms))
221 :     | ppMethod name stm = (nl(); string name; nl(); ppBlock (ppStrm, [stm]))
222 : jhr 3425 *)
223 :     fun ppMethod name stm = (
224 :     PP.openHBox ppStrm;
225 :     string name; sp();
226 :     ppBlockStmt (ppStrm, stm);
227 :     PP.closeBox ppStrm)
228 : jhr 3384 in
229 :     PP.openHBox ppStrm;
230 :     string "strand"; sp(); string(Atom.toString name); sp();
231 :     ppParams (ppStrm, params);
232 :     PP.closeBox ppStrm;
233 :     nl();
234 :     PP.openVBox ppStrm indent;
235 :     string "{";
236 :     List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) state;
237 : jhr 3425 nl();
238 : jhr 3452 Option.app (ppMethod "initially") initM;
239 :     ppMethod "update" updateM;
240 :     Option.app (ppMethod "stabilize") stabilizeM;
241 : jhr 3384 PP.closeBox ppStrm;
242 :     nl();
243 :     string "}"; nl()
244 :     end
245 :    
246 : jhr 3411 fun ppInput ppStrm = let
247 : jhr 3384 fun sp () = PP.space ppStrm 1
248 :     fun nl () = PP.newline ppStrm
249 :     val string = PP.string ppStrm
250 :     fun var x = string(Var.nameOf x)
251 :     fun ppDesc NONE = ()
252 :     | ppDesc (SOME desc) = (
253 :     string(concat["(\"", String.toString desc, "\")"]); sp())
254 : jhr 3411 in
255 :     fn ((x, SOME e), desc) => (
256 : jhr 3384 PP.openHBox ppStrm;
257 :     string "input"; sp();
258 :     ppDesc desc;
259 : jhr 3411 string(TU.toString(#2(Var.typeOf x))); sp(); var x;
260 :     sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
261 : jhr 3384 PP.closeBox ppStrm;
262 :     nl())
263 : jhr 3411 | ((x, NONE), 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; string ";";
268 : jhr 3384 PP.closeBox ppStrm;
269 :     nl())
270 : jhr 3411 end
271 :    
272 :     fun ppDecl ppStrm = let
273 :     fun sp () = PP.space ppStrm 1
274 :     fun nl () = PP.newline ppStrm
275 :     val string = PP.string ppStrm
276 :     fun var x = string(Var.nameOf x)
277 :     fun ppDesc NONE = ()
278 :     | ppDesc (SOME desc) = (
279 :     string(concat["(\"", String.toString desc, "\")"]); sp())
280 :     in
281 :     fn AST.D_Var vdcl => (ppVarDecl ppStrm vdcl; nl())
282 : jhr 3384 | AST.D_Func(f, params, body) => (
283 :     PP.openHBox ppStrm;
284 :     string "function"; sp();
285 :     string(TU.toString(TU.rngOf(Var.monoTypeOf f)));
286 :     sp(); var f; sp(); ppParams (ppStrm, params);
287 :     PP.closeBox ppStrm;
288 :     nl();
289 :     case body
290 :     of AST.S_Block stms => ppBlock (ppStrm, stms)
291 :     | stm => ppBlock (ppStrm, [stm])
292 :     (* end case *))
293 :     end
294 :    
295 : jhr 3411 fun ppCreate (ppStrm, cr) = (
296 :     PP.openVBox ppStrm (PP.Abs 0);
297 :     PP.openVBox ppStrm indent;
298 :     case cr
299 :     of AST.C_Grid(d, stmt) => (
300 :     PP.string ppStrm (concat["grid(", Int.toString d, ") "]);
301 :     ppBlockStmt (ppStrm, stmt))
302 :     | AST.C_Collection stmt => (
303 :     PP.string ppStrm "collection ";
304 :     ppBlockStmt (ppStrm, stmt))
305 :     (* end case *);
306 :     PP.closeBox ppStrm;
307 :     PP.newline ppStrm;
308 :     PP.closeBox ppStrm)
309 :    
310 : jhr 3437 fun output (outS, message, prog) = let
311 : jhr 3411 val AST.Program{
312 :     props, const_dcls, input_dcls, globals,
313 :     strand, init, create, update
314 :     } = prog
315 : jhr 3384 val ppStrm = PP.openOut {dst = outS, wid = 120}
316 :     fun sp () = PP.space ppStrm 1
317 :     fun nl () = PP.newline ppStrm
318 :     val string = PP.string ppStrm
319 :     fun ppTopBlock (prefix, SOME stm) = (
320 :     PP.openHBox ppStrm;
321 :     string prefix; sp();
322 :     ppBlockStmt (ppStrm, stm);
323 :     PP.closeBox ppStrm)
324 :     | ppTopBlock _ = ()
325 :     in
326 :     PP.openVBox ppStrm (PP.Abs 0);
327 :     string "/* Program start */"; PP.newline ppStrm;
328 :     PP.openHBox ppStrm;
329 :     PP.string ppStrm "properties:";
330 :     sp();
331 : jhr 3431 string (Properties.propsToString props);
332 : jhr 3384 PP.newline ppStrm;
333 :     PP.closeBox ppStrm;
334 : jhr 3411 List.app (ppVarDecl ppStrm) const_dcls;
335 :     List.app (ppInput ppStrm) input_dcls;
336 : jhr 3384 List.app (ppDecl ppStrm) globals;
337 :     ppStrand (ppStrm, strand);
338 :     ppTopBlock ("initially", init);
339 : jhr 3411 ppCreate (ppStrm, create);
340 : jhr 3384 ppTopBlock ("update", update);
341 :     string "/* Program end */"; PP.newline ppStrm;
342 :     PP.closeBox ppStrm;
343 :     PP.closeStream ppStrm
344 :     end
345 :    
346 :     end

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