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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3291 - (view) (download)

1 : jhr 93 (* ast-pp.sml
2 :     *
3 : jhr 3291 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 : jhr 93 * All rights reserved.
7 : jhr 96 *
8 :     * Pretty printing for the AST representation.
9 : jhr 93 *)
10 :    
11 :     structure ASTPP : sig
12 :    
13 :     val output : TextIO.outstream * AST.program -> unit
14 :    
15 :     end = struct
16 :    
17 :     structure PP = TextIOPP
18 : jhr 96 structure TU = TypeUtil
19 : jhr 93
20 : jhr 94 val indent = PP.Abs 2
21 :    
22 :     fun ppList ppFn (left, sep, right) (ppStrm, list) = let
23 : jhr 2279 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 : jhr 94
32 : jhr 96 (* 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 : jhr 2279 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 : jhr 96
47 : jhr 94 fun ppExp (ppStrm, e) = let
48 : jhr 2279 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 :     of AST.E_Var x => var x
55 :     | AST.E_Lit lit => string (Literal.toString lit)
56 :     | AST.E_Tuple es => ppArgs (ppStrm, es)
57 :     | AST.E_Apply(f, [], args, _) => (var f; sp(); ppArgs (ppStrm, args))
58 :     | AST.E_Apply(f, mvs, args, _) => (
59 :     var f; ppTyArgs (ppStrm, mvs); sp(); ppArgs (ppStrm, args))
60 :     | AST.E_Cons es => (
61 :     ppList ppExp ("[", ",", "]") (ppStrm, es))
62 : jhr 2722 | AST.E_Seq(es, _) => (
63 : jhr 2279 ppList ppExp ("{", ",", "}") (ppStrm, es))
64 :     | AST.E_Slice(e, indices, _) => (
65 :     pp e;
66 :     ppList ppIndex ("[", ",", "]") (ppStrm, indices))
67 :     | AST.E_Cond(e1, e2, e3, _) => (
68 :     pp e2; sp(); string "if"; sp(); pp e1; sp(); string "else"; sp(); pp e3)
69 : jhr 1996 | AST.E_LoadNrrd(mvs, name, ty) => (
70 :     case TU.pruneHead ty
71 :     of Types.T_DynSequence _ => string "loadSeq"
72 :     | Types.T_Image _ => string "loadImage"
73 :     | _ => raise Fail "impossible"
74 :     (* end case *);
75 :     ppTyArgs (ppStrm, mvs); sp();
76 :     string(concat["(\"", name, "\")"]))
77 : jhr 1687 | AST.E_Coerce{dstTy, e, ...} => (
78 :     PP.openHBox ppStrm;
79 :     string "("; string(TU.toString dstTy); string ")";
80 :     PP.closeBox ppStrm;
81 :     case e
82 :     of AST.E_Var _ => pp e
83 :     | AST.E_Lit _ => pp e
84 :     | AST.E_Tuple _ => pp e
85 :     | AST.E_Cons _ => pp e
86 : jhr 1688 | AST.E_Seq _ => pp e
87 : jhr 1687 | _ => (string "("; pp e; string ")")
88 :     (* end case *))
89 : jhr 2279 (* end case *))
90 :     in
91 :     pp e
92 :     end
93 : jhr 94
94 :     and ppArgs (ppStrm, args) = ppList ppExp ("(", ",", ")") (ppStrm, args)
95 :    
96 :     fun ppVarDecl ppStrm (AST.VD_Decl(x, e)) = let
97 : jhr 2279 fun sp () = PP.space ppStrm 1
98 :     val string = PP.string ppStrm
99 :     in
100 :     PP.openHBox ppStrm;
101 :     case Var.kindOf x
102 :     of AST.InputVar => (string "input"; sp())
103 :     | AST.StrandOutputVar => (string "output"; sp())
104 :     | _ => ()
105 :     (* end case *);
106 :     string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x);
107 :     sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
108 :     PP.closeBox ppStrm
109 :     end
110 : jhr 94
111 :     fun ppBlock (ppStrm, stms) = let
112 : jhr 2279 fun sp () = PP.space ppStrm 1
113 :     fun nl () = PP.newline ppStrm
114 :     val string = PP.string ppStrm
115 :     fun var x = string(Var.nameOf x)
116 :     fun ppStmt stmt = (case stmt
117 :     of AST.S_Block stms => ppBlock (ppStrm, stms)
118 :     | AST.S_Decl vdcl => (ppVarDecl ppStrm vdcl; nl())
119 :     | AST.S_IfThenElse(e, AST.S_Block stms, AST.S_Block[]) => (
120 : jhr 2133 PP.openHBox ppStrm;
121 : jhr 2279 string "if"; sp(); ppExp(ppStrm, e);
122 :     sp(); ppBlock (ppStrm, stms);
123 :     PP.closeBox ppStrm)
124 :     | AST.S_IfThenElse(e, s1, AST.S_Block[]) => (
125 :     PP.openVBox ppStrm indent;
126 :     PP.openHBox ppStrm;
127 :     string "if"; sp(); ppExp(ppStrm, e);
128 :     PP.closeBox ppStrm;
129 :     nl();
130 :     ppStmt s1;
131 :     PP.closeBox ppStrm;
132 :     nl())
133 :     | AST.S_IfThenElse(e, AST.S_Block stms1, AST.S_Block stms2) => (
134 :     PP.openHBox ppStrm;
135 :     string "if"; sp(); ppExp(ppStrm, e);
136 :     sp(); ppBlock (ppStrm, stms1);
137 :     PP.closeBox ppStrm;
138 :     PP.openHBox ppStrm;
139 :     string "else"; sp(); ppBlock (ppStrm, stms2);
140 :     PP.closeBox ppStrm)
141 :     | AST.S_IfThenElse(e, AST.S_Block stms1, s2) => (
142 :     PP.openHBox ppStrm;
143 :     string "if"; sp(); ppExp(ppStrm, e);
144 :     sp(); ppBlock (ppStrm, stms1);
145 :     PP.closeBox ppStrm;
146 :     string "else";
147 :     PP.openVBox ppStrm indent;
148 :     nl(); ppStmt s2;
149 :     PP.closeBox ppStrm)
150 :     | AST.S_IfThenElse(e, s1, AST.S_Block stms2) => raise Fail "FIXME"
151 :     | AST.S_IfThenElse(e, s1, s2) => (
152 :     PP.openVBox ppStrm indent;
153 :     PP.openHBox ppStrm;
154 :     string "if"; sp(); ppExp(ppStrm, e);
155 :     PP.closeBox ppStrm;
156 :     nl();
157 :     ppStmt s1;
158 :     PP.closeBox ppStrm;
159 :     nl();
160 :     PP.openVBox ppStrm indent;
161 :     string "else"; nl();
162 :     ppStmt s2;
163 :     PP.closeBox ppStrm;
164 :     nl())
165 :     | AST.S_Assign(x, e) => (
166 :     PP.openHBox ppStrm;
167 :     var 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 : jhr 3191 | AST.S_Continue => (string "continue;"; nl())
177 : jhr 2279 | AST.S_Die => (string "die;"; nl())
178 :     | AST.S_Stabilize => (string "stabilize;"; nl())
179 :     | AST.S_Return e => (
180 :     PP.openHBox ppStrm;
181 : jhr 2133 string "return"; sp(); ppExp(ppStrm, e); string ";";
182 :     PP.closeBox ppStrm;
183 :     nl())
184 : jhr 1640 | AST.S_Print args => (
185 :     PP.openHBox ppStrm;
186 :     string "print"; sp(); ppArgs (ppStrm, args); string ";";
187 :     PP.closeBox ppStrm;
188 :     nl())
189 : jhr 2279 (* end case *))
190 :     in
191 :     PP.openVBox ppStrm (PP.Abs 0);
192 :     string "{"; nl();
193 :     PP.openVBox ppStrm indent;
194 :     List.app ppStmt stms;
195 :     PP.closeBox ppStrm;
196 :     string "}"; nl();
197 :     PP.closeBox ppStrm
198 :     end
199 : jhr 94
200 : jhr 2133 fun ppParams (ppStrm, params) = let
201 : jhr 2279 fun sp () = PP.space ppStrm 1
202 :     val string = PP.string ppStrm
203 :     in
204 :     ppList
205 :     (fn (_, x) => (string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x)))
206 :     ("(", ",", ")")
207 :     (ppStrm, params)
208 :     end
209 : jhr 2133
210 : jhr 2211 fun ppStrand (ppStrm, AST.Strand{name, params, state, methods}) = let
211 : jhr 2279 fun sp () = PP.space ppStrm 1
212 :     fun nl () = PP.newline ppStrm
213 :     val string = PP.string ppStrm
214 :     fun var x = string(Var.nameOf x)
215 :     fun ppMethod (AST.M_Method(name, AST.S_Block stms)) = (
216 :     nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, stms))
217 :     | ppMethod (AST.M_Method(name, stm)) = (
218 :     nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, [stm]))
219 :     in
220 :     PP.openHBox ppStrm;
221 :     string "strand"; sp(); string(Atom.toString name); sp();
222 :     ppParams (ppStrm, params);
223 :     PP.closeBox ppStrm;
224 :     nl();
225 :     PP.openVBox ppStrm indent;
226 :     string "{";
227 :     List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) state;
228 :     List.app ppMethod methods;
229 :     PP.closeBox ppStrm;
230 :     nl();
231 :     string "}"; nl()
232 :     end
233 : jhr 94
234 :     fun ppDecl ppStrm = let
235 : jhr 2279 fun sp () = PP.space ppStrm 1
236 :     fun nl () = PP.newline ppStrm
237 :     val string = PP.string ppStrm
238 :     fun var x = string(Var.nameOf x)
239 :     fun ppDesc NONE = ()
240 :     | ppDesc (SOME desc) = (
241 :     string(concat["(\"", String.toString desc, "\")"]); sp())
242 :     in
243 :     fn AST.D_Input(x, desc, NONE) => (
244 :     PP.openHBox ppStrm;
245 :     string "input"; sp();
246 :     ppDesc desc;
247 :     string(TU.toString(#2(Var.typeOf x))); sp(); var x; string ";";
248 :     PP.closeBox ppStrm;
249 :     nl())
250 :     | AST.D_Input(x, desc, SOME e) => (
251 :     PP.openHBox ppStrm;
252 :     string "input"; sp();
253 :     ppDesc desc;
254 :     string(TU.toString(#2(Var.typeOf x))); sp(); var x;
255 :     sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
256 :     PP.closeBox ppStrm;
257 :     nl())
258 :     | AST.D_Var vdcl => (ppVarDecl ppStrm vdcl; nl())
259 :     | AST.D_Func(f, params, body) => (
260 :     PP.openHBox ppStrm;
261 :     string "function"; sp();
262 :     string(TU.toString(TU.rngOf(Var.monoTypeOf f)));
263 :     sp(); var f; sp(); ppParams (ppStrm, params);
264 :     PP.closeBox ppStrm;
265 :     nl();
266 :     case body
267 :     of AST.S_Block stms => ppBlock (ppStrm, stms)
268 :     | stm => ppBlock (ppStrm, [stm])
269 :     (* end case *))
270 :     | AST.D_Strand def => ppStrand (ppStrm, def)
271 :     | AST.D_InitialArray(create, iters) => (* FIXME *) ()
272 :     | AST.D_InitialCollection(create, iters) => (* FIXME *) ()
273 :     end
274 : jhr 94
275 : jhr 2365 fun output (outS, AST.Program{props, decls}) = let
276 : jhr 2279 val ppStrm = PP.openOut {dst = outS, wid = 120}
277 :     in
278 :     PP.openVBox ppStrm (PP.Abs 0);
279 :     PP.string ppStrm "/* Program start */"; PP.newline ppStrm;
280 : jhr 2365 PP.openHBox ppStrm;
281 :     PP.string ppStrm "properties:";
282 :     PP.space ppStrm 1;
283 :     PP.string ppStrm (StrandUtil.propsToString props);
284 :     PP.newline ppStrm;
285 :     PP.closeBox ppStrm;
286 : jhr 2279 List.app (ppDecl ppStrm) decls;
287 :     PP.string ppStrm "/* Program end */"; PP.newline ppStrm;
288 :     PP.closeBox ppStrm;
289 :     PP.closeStream ppStrm
290 :     end
291 : jhr 93
292 :     end

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