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

SCM Repository

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

Annotation of /branches/vis15/src/compiler/parse-tree/parse-tree-pp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3437 - (view) (download)

1 : jhr 3432 (* parse-tree-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 :    
9 :     structure ParseTreePP : sig
10 :    
11 : jhr 3437 val output : Error.err_stream -> TextIO.outstream * string * ParseTree.program -> unit
12 : jhr 3432
13 :     end = struct
14 :    
15 :     structure PT = ParseTree
16 :     structure E = Error
17 :    
18 :     datatype strm = S of {
19 :     indent : int, (* current indentation level *)
20 :     span : E.span,
21 :     info : strm_info
22 :     }
23 :    
24 :     and strm_info = Info of {
25 :     mark : bool, (* if true, print mark info *)
26 :     errS : Error.err_stream, (* for interpreting spans *)
27 :     outS : TextIO.outstream (* output I/O stream to print to *)
28 :     }
29 :    
30 :     fun new {errS, outS, showMarks} = S{
31 :     indent = 0, span = (0, 0),
32 :     info = Info{mark = showMarks, errS = errS, outS = outS}
33 :     }
34 :    
35 :     (* print text *)
36 :     fun pr (S{info=Info{outS, ...}, ...}, txt) = TextIO.output(outS, txt)
37 :    
38 :     (* print a newline *)
39 :     fun nl (S{info=Info{outS, ...}, ...}) = TextIO.output1 (outS, #"\n")
40 :    
41 :     (* print whitespace to indent the text *)
42 :     fun prIndent (S{indent=n, info=Info{outS, ...}, ...}) = let
43 :     fun lp 0 = ()
44 :     | lp i = (TextIO.output(outS, " "); lp(i-1))
45 :     in
46 :     lp n
47 :     end
48 :    
49 :     (* increment indentation level *)
50 :     fun inc (S{indent, span, info}) = S{indent=indent+1, span=span, info=info}
51 :    
52 :     fun nest strm f = f (inc strm)
53 :    
54 :     (* print location information *)
55 :     fun prLoc (S{span, info, ...}) = (case info
56 :     of Info{mark=true, errS, outS, ...} =>
57 :     TextIO.output (outS, " @ " ^ Error.locToString (Error.location (errS, span)))
58 :     | _ => ()
59 :     (* end case *))
60 :    
61 :     (* update the current span *)
62 :     fun mark (S{indent, info, ...}, {span, tree}) = (S{span=span, indent=indent, info=info}, tree)
63 :    
64 :     fun prStr (strm, s) = (prIndent strm; pr (strm, s); nl strm);
65 :     fun prId (strm, id) = prStr (strm, Atom.toString id)
66 :    
67 :     fun prNode (strm, name) = (prIndent strm; pr (strm, name); prLoc strm; nl strm)
68 :     fun prNode' (strm, name, data) = (
69 :     prIndent strm; pr (strm, concat[name, ": ", data]); prLoc strm; nl strm)
70 :    
71 :     (* print a list of items enclosed in "[" ... "]" *)
72 :     fun prList prItem (strm, []) = (prIndent strm; pr (strm, "[ ]\n"))
73 :     | prList prItem (strm, items) = (
74 :     prIndent strm; pr (strm, "[\n");
75 :     nest strm
76 :     (fn strm' => List.app (fn item => prItem (strm', item)) items);
77 :     prIndent strm; pr (strm, "]\n"))
78 :    
79 :     fun prOpt prItem (strm, NONE) = ()
80 :     | prOpt prItem (strm, SOME item) = prItem (strm, item)
81 :    
82 :     fun program (strm, PT.Program m) = let
83 :     val (strm, prog) = mark (strm, m)
84 :     in
85 :     prNode (strm, "Program");
86 :     nest strm (fn strm => (
87 :     prList globalDcl (strm, #globals prog);
88 :     prOpt stmt (strm, #init prog);
89 :     strandDcl (strm, #strand prog);
90 :     create (strm, #create prog);
91 :     prOpt stmt (strm, #update prog)))
92 :     end
93 :    
94 :     and globalDcl (strm, obj) = (case obj
95 :     of PT.GD_Mark m => globalDcl (mark (strm, m))
96 :     | PT.GD_Const(t, {tree=x, ...}, NONE) =>
97 :     prNode' (strm, "Const", Atom.toString x)
98 :     | PT.GD_Const(t, {tree=x, ...}, SOME e) => (
99 :     prNode' (strm, "Const", Atom.toString x ^ "=");
100 :     nest strm (fn strm => expr (strm, e)))
101 :     | PT.GD_Input(t, {tree=x, ...}, optDesc, NONE) => (
102 :     prNode' (strm, "Input", Atom.toString x);
103 :     case optDesc
104 :     of SOME desc => nest strm (
105 :     fn strm => prStr(strm, concat["\"", String.toString desc, "\""]))
106 :     | NONE => ()
107 :     (* end case *))
108 :     | PT.GD_Input(t, {tree=x, ...}, optDesc, SOME e) => (
109 :     prNode' (strm, "Input", Atom.toString x ^ "=");
110 :     nest strm (fn strm => (
111 :     case optDesc
112 :     of SOME desc => prStr(strm, concat["\"", String.toString desc, "\""])
113 :     | NONE => ()
114 :     (* end case *);
115 :     expr (strm, e))))
116 :     | PT.GD_Var vd => (
117 :     prNode (strm, "Var");
118 :     nest strm (fn strm => varDcl (strm, vd)))
119 :     | PT.GD_Func(t, {tree=f, ...}, params, body) => (
120 :     prNode' (strm, "Func", Atom.toString f);
121 :     nest strm (fn strm => (
122 :     ty (strm, t); prList param (strm, params); funBody (strm, body))))
123 :     (* end case *))
124 :    
125 :     and strandDcl (strm, obj) = (case obj
126 :     of PT.SD_Mark m => strandDcl (mark (strm, m))
127 :     | PT.SD_Strand{name={tree=name, ...}, params, state, methods} => (
128 :     prNode' (strm, "Strand", Atom.toString name);
129 :     nest strm (fn strm => (
130 :     prList param (strm, params);
131 :     prList stateVarDcl (strm, state);
132 :     prList method (strm, methods))))
133 :     (* end case *))
134 :    
135 :     and stateVarDcl (strm, obj) = (case obj
136 :     of PT.SVD_Mark m => stateVarDcl (mark (strm, m))
137 :     | PT.SVD_VarDcl(isOutput, vd) =>
138 :     if isOutput
139 :     then prNode' (strm, "VarDcl", "output")
140 :     else prNode (strm, "VarDcl")
141 :     (* end case *))
142 :    
143 :     and create (strm, obj) = (case obj
144 :     of PT.CR_Mark m => create (mark (strm, m))
145 :     | PT.CR_Collection comp => (
146 :     prNode (strm, "Collection");
147 :     nest strm (fn strm => comprehension (strm, comp)))
148 :     | PT.CR_Grid(e, comp) => (
149 :     prNode (strm, "Grid");
150 :     nest strm (fn strm => (expr (strm, e); comprehension (strm, comp))))
151 :     | PT.CR_Deprecated cr => (
152 :     prNode (strm, "Deprecated");
153 :     nest strm (fn strm => create (strm, cr)))
154 :     (* end case *))
155 :    
156 :     and param (strm, obj) = (case obj
157 :     of PT.P_Mark m => param (mark (strm, m))
158 :     | PT.P_Param(t, {tree=x, ...}) => (
159 :     prNode' (strm, "Param", Atom.toString x);
160 :     nest strm (fn strm => ty (strm, t)))
161 :     (* end case *))
162 :    
163 :     and ty (strm, obj) = (case obj
164 :     of PT.T_Mark m => ty (mark (strm, m))
165 :     | PT.T_Bool => prNode (strm, "Bool")
166 :     | PT.T_Int => prNode (strm, "Int")
167 :     | PT.T_Real => prNode (strm, "Real")
168 :     | PT.T_String => prNode (strm, "String")
169 :     | PT.T_Id id => prNode' (strm, "Id", Atom.toString id)
170 :     | PT.T_Kernel diff => prNode' (strm, "Kernel", "#" ^ IntInf.toString diff)
171 :     | PT.T_Field{diff, dim, shape} => (
172 :     prNode' (strm, "Field", "#" ^ IntInf.toString diff);
173 :     nest strm (fn strm => (expr (strm, dim); prList expr (strm, shape))))
174 :     | PT.T_Tensor shp => (
175 :     prNode (strm, "Tensor");
176 :     nest strm (fn strm => prList expr (strm, shp)))
177 :     | PT.T_Image{dim, shape} => (
178 :     prNode (strm, "Image");
179 :     nest strm (fn strm => (expr (strm, dim); prList expr (strm, shape))))
180 :     | PT.T_Seq(t, e) => (
181 :     prNode (strm, "Seq");
182 :     nest strm (fn strm => (ty (strm, t); expr (strm, e))))
183 :     | PT.T_DynSeq t => (
184 :     prNode (strm, "DynSeq");
185 :     nest strm (fn strm => ty (strm, t)))
186 :     | PT.T_Deprecate(msg, t) => (
187 :     prNode (strm, "Deprecate");
188 :     nest strm (fn strm => (
189 :     prStr (strm, concat["\"", String.toString msg, "\""]);
190 :     ty (strm, t))))
191 :     (* end case *))
192 :    
193 :     and funBody (strm, obj) = (case obj
194 :     of PT.FB_Expr e => (
195 :     prNode (strm, "Expr");
196 :     nest strm (fn strm => expr (strm, e)))
197 :     | PT.FB_Stmt stm => (
198 :     prNode (strm, "Stmt");
199 :     nest strm (fn strm => stmt (strm, stm)))
200 :     (* end case *))
201 :    
202 :     and varDcl (strm, obj) = (case obj
203 :     of PT.VD_Mark m => varDcl (mark (strm, m))
204 :     | PT.VD_Decl(t, {tree=x, ...}, NONE) =>
205 :     prNode' (strm, "Decl", Atom.toString x)
206 :     | PT.VD_Decl(t, {tree=x, ...}, SOME e) => (
207 :     prNode' (strm, "Decl", Atom.toString x ^ "=");
208 :     nest strm (fn strm => expr (strm, e)))
209 :     (* end case *))
210 :    
211 :     and method (strm, obj) = (case obj
212 :     of PT.M_Mark m => method (mark (strm, m))
213 :     | PT.M_Method(name, stm) => (
214 :     prNode' (strm, "Method", StrandUtil.nameToString name);
215 :     nest strm (fn strm => stmt(strm, stm)))
216 :     (* end case *))
217 :    
218 :     and stmt (strm, obj : PT.stmt) = (case obj
219 :     of PT.S_Mark m => stmt (mark (strm, m))
220 :     | PT.S_Block(stms) => (
221 :     prNode (strm, "Block");
222 :     nest strm (fn strm => prList stmt (strm, stms)))
223 :     | PT.S_IfThen(e, stm) => (
224 :     prNode (strm, "IfThen");
225 :     nest strm (fn strm => (expr (strm, e); stmt (strm, stm))))
226 :     | PT.S_IfThenElse(e, stm1, stm2) => (
227 :     prNode (strm, "IfThenElse");
228 :     nest strm (fn strm => (expr (strm, e); stmt (strm, stm1); stmt (strm, stm2))))
229 :     | PT.S_Foreach(t, iter, stm) => (
230 :     prNode (strm, "Foreach");
231 :     nest strm (fn strm => (ty (strm, t); iterator (strm, iter); stmt (strm, stm))))
232 :     | PT.S_Print(es) => (
233 :     prNode (strm, "Print");
234 :     nest strm (fn strm => prList expr (strm, es)))
235 :     | PT.S_New(id, es) => (
236 :     prNode' (strm, "New", Atom.toString id);
237 :     nest strm (fn strm => prList expr (strm, es)))
238 :     | PT.S_Stabilize => prNode (strm, "Stabilize")
239 :     | PT.S_Die => prNode (strm, "Die")
240 :     | PT.S_Continue => prNode (strm, "Continue")
241 :     | PT.S_Return e => (
242 :     prNode (strm, "Return");
243 :     nest strm (fn strm => expr (strm, e)))
244 :     | PT.S_Decl vd => (
245 :     prNode (strm, "Decl");
246 :     nest strm (fn strm => varDcl (strm, vd)))
247 :     | PT.S_Assign({tree=x, ...}, NONE, e) => (
248 :     prNode' (strm, "Assign", Atom.toString x ^ "=");
249 :     nest strm (fn strm => expr (strm, e)))
250 :     | PT.S_Assign({tree=x, ...}, SOME rator, e) => (
251 :     prNode' (strm, "Assign", Atom.toString x ^ Atom.toString rator);
252 :     nest strm (fn strm => expr (strm, e)))
253 :     | PT.S_Deprecate(msg, stm) => (
254 :     prNode (strm, "Deprecate");
255 :     nest strm (fn strm => (
256 :     prStr (strm, concat["\"", String.toString msg, "\""]);
257 :     stmt (strm, stm))))
258 :     (* end case *))
259 :    
260 :     and comprehension (strm, obj) = (case obj
261 :     of PT.COMP_Mark m => comprehension (mark (strm, m))
262 :     | PT.COMP_Comprehension(e, iters) => (
263 :     prNode (strm, "Comprehension");
264 :     nest strm (fn strm => (
265 :     expr (strm, e);
266 :     prList iterator (strm, iters))))
267 :     (* end case *))
268 :    
269 :     and iterator (strm, obj) = (case obj
270 :     of PT.I_Mark m => iterator (mark (strm, m))
271 :     | PT.I_Iterator({tree=x, ...}, e) => (
272 :     prNode' (strm, "Iterator", Atom.toString x);
273 :     nest strm (fn strm => expr (strm, e)))
274 :     (* end case *))
275 :    
276 :     and expr (strm, obj) = (case obj
277 :     of PT.E_Mark m => expr (mark (strm, m))
278 :     | PT.E_Cond(e1, e2, e3) => (
279 :     prNode (strm, "Cond");
280 :     nest strm (fn strm => (expr (strm, e1); expr (strm, e2); expr (strm, e3))))
281 :     | PT.E_Range(e1, e2) => (
282 :     prNode (strm, "Range");
283 :     nest strm (fn strm => (expr (strm, e1); expr (strm, e2))))
284 :     | PT.E_OrElse(e1, e2) => (
285 :     prNode (strm, "OrElse");
286 :     nest strm (fn strm => (expr (strm, e1); expr (strm, e2))))
287 :     | PT.E_AndAlso(e1, e2) => (
288 :     prNode (strm, "AndAlso");
289 :     nest strm (fn strm => (expr (strm, e1); expr (strm, e2))))
290 :     | PT.E_BinOp(e1, rator, e2) => (
291 :     prNode' (strm, "BinOp", Atom.toString rator);
292 :     nest strm (fn strm => (expr (strm, e1); expr (strm, e2))))
293 :     | PT.E_UnaryOp(rator, e) => (
294 :     prNode' (strm, "UnaryOp", Atom.toString rator);
295 :     nest strm (fn strm => expr (strm, e)))
296 :     | PT.E_Apply(e, args) => (
297 :     prNode (strm, "Apply");
298 :     nest strm (fn strm => (expr (strm, e); prList expr (strm, args))))
299 :     | PT.E_Subscript(e, indices) => (
300 :     prNode (strm, "Subscript");
301 :     nest strm (fn strm => (
302 :     expr (strm, e);
303 :     prList (fn (strm, SOME e) => expr (strm, e) | (strm, NONE) => prStr (strm, ":"))
304 :     (strm, indices))))
305 :     | PT.E_Select(e, f) => (
306 :     prNode (strm, "Select");
307 :     nest strm (fn strm => (expr (strm, e); prId (strm, f))))
308 :     | PT.E_Real e => (
309 :     prNode (strm, "Real");
310 :     nest strm (fn strm => expr (strm, e)))
311 :     | PT.E_Load e => (
312 :     prNode (strm, "Load");
313 :     nest strm (fn strm => expr (strm, e)))
314 :     | PT.E_Image e => (
315 :     prNode (strm, "Image");
316 :     nest strm (fn strm => expr (strm, e)))
317 :     | PT.E_Var x => prNode' (strm, "Var", Atom.toString x)
318 :     | PT.E_Kernel(kern, dim) =>
319 :     prNode' (strm, "Kernel", concat[Atom.toString kern, "#", IntInf.toString dim])
320 :     | PT.E_Lit lit => prNode' (strm, "Lit", Literal.toString lit)
321 :     | PT.E_Id e => (
322 :     prNode (strm, "Id");
323 :     nest strm (fn strm => expr (strm, e)))
324 :     | PT.E_Zero es => (
325 :     prNode (strm, "Zero");
326 :     nest strm (fn strm => prList expr (strm, es)))
327 :     | PT.E_NaN es => (
328 :     prNode (strm, "NaN");
329 :     nest strm (fn strm => prList expr (strm, es)))
330 :     | PT.E_Sequence es => (
331 :     prNode (strm, "Sequence");
332 :     nest strm (fn strm => prList expr (strm, es)))
333 :     | PT.E_SeqComp comp => (
334 :     prNode (strm, "SeqComp");
335 :     nest strm (fn strm => comprehension (strm, comp)))
336 :     | PT.E_Cons es => (
337 :     prNode (strm, "Cons");
338 :     nest strm (fn strm => prList expr (strm, es)))
339 :     | PT.E_Deprecate(msg, e) => (
340 :     prNode (strm, "Deprecate");
341 :     nest strm (fn strm => (
342 :     prStr (strm, concat["\"", String.toString msg, "\""]);
343 :     expr (strm, e))))
344 :     (* end case *))
345 :    
346 : jhr 3437 fun output errS (outS, message, prog) = let
347 : jhr 3432 val strm = new{outS = outS, errS = errS, showMarks = true}
348 :     in
349 :     program (strm, prog);
350 :     TextIO.flushOut outS
351 :     end
352 :    
353 :     end

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