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 2011 - (view) (download)

1 : jhr 93 (* ast-pp.sml
2 :     *
3 : jhr 435 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : jhr 93 * All rights reserved.
5 : jhr 96 *
6 :     * Pretty printing for the AST representation.
7 : jhr 93 *)
8 :    
9 :     structure ASTPP : sig
10 :    
11 :     val output : TextIO.outstream * AST.program -> unit
12 :    
13 :     end = struct
14 :    
15 :     structure PP = TextIOPP
16 : jhr 96 structure TU = TypeUtil
17 : jhr 93
18 : jhr 94 val indent = PP.Abs 2
19 :    
20 :     fun ppList ppFn (left, sep, right) (ppStrm, list) = let
21 :     fun sp () = PP.space ppStrm 1
22 :     val string = PP.string ppStrm
23 :     fun pp [] = string right
24 :     | pp [x] = (ppFn(ppStrm, x); string right)
25 :     | pp (x::xs) = (ppFn(ppStrm, x); string sep; sp(); pp xs)
26 :     in
27 :     string left; pp list
28 :     end
29 :    
30 : jhr 96 (* print type arguments; we use "#" to denote differentiation arguments, "$" to denote
31 :     * shape arguments, and "%" to denote dimension arguments.
32 :     *)
33 :     fun ppTyArgs (ppStrm, mvs) = let
34 :     val string = PP.string ppStrm
35 :     fun ppTyArg (_, mv) = (case mv
36 :     of Types.TYPE tv => string(TU.toString(TU.resolve tv))
37 :     | Types.DIFF dv => string("#"^TU.diffToString(TU.resolveDiff dv))
38 :     | Types.SHAPE sv => string("$"^TU.shapeToString(TU.resolveShape sv))
39 :     | Types.DIM dv => string("%"^TU.dimToString(TU.resolveDim dv))
40 :     (* end case *))
41 :     in
42 :     ppList ppTyArg ("<", ";", ">") (ppStrm, mvs)
43 :     end
44 :    
45 : jhr 94 fun ppExp (ppStrm, e) = let
46 :     fun sp () = PP.space ppStrm 1
47 :     val string = PP.string ppStrm
48 :     fun var x = string(Var.nameOf x)
49 : jhr 381 fun ppIndex (ppStrm, NONE) = PP.string ppStrm ":"
50 :     | ppIndex (ppStrm, SOME e) = ppExp (ppStrm, e)
51 : jhr 94 fun pp e = (case e
52 : jhr 170 of AST.E_Var x => var x
53 : jhr 94 | AST.E_Lit lit => string (Literal.toString lit)
54 :     | AST.E_Tuple es => ppArgs (ppStrm, es)
55 :     | AST.E_Apply(f, [], args, _) => (var f; sp(); ppArgs (ppStrm, args))
56 :     | AST.E_Apply(f, mvs, args, _) => (
57 : jhr 96 var f; ppTyArgs (ppStrm, mvs); sp(); ppArgs (ppStrm, args))
58 : jhr 94 | AST.E_Cons es => (
59 :     ppList ppExp ("[", ",", "]") (ppStrm, es))
60 : jhr 1688 | AST.E_Seq es => (
61 :     ppList ppExp ("{", ",", "}") (ppStrm, es))
62 : jhr 399 | AST.E_Slice(e, indices, _) => (
63 : jhr 381 pp e;
64 :     ppList ppIndex ("[", ",", "]") (ppStrm, indices))
65 : jhr 416 | AST.E_Cond(e1, e2, e3, _) => (
66 :     pp e2; sp(); string "if"; sp(); pp e1; sp(); string "else"; sp(); pp e3)
67 : jhr 1996 | AST.E_LoadNrrd(mvs, name, ty) => (
68 :     case TU.pruneHead ty
69 :     of Types.T_DynSequence _ => string "loadSeq"
70 :     | Types.T_Image _ => string "loadImage"
71 :     | _ => raise Fail "impossible"
72 :     (* end case *);
73 :     ppTyArgs (ppStrm, mvs); sp();
74 :     string(concat["(\"", name, "\")"]))
75 : jhr 1687 | AST.E_Coerce{dstTy, e, ...} => (
76 :     PP.openHBox ppStrm;
77 :     string "("; string(TU.toString dstTy); string ")";
78 :     PP.closeBox ppStrm;
79 :     case e
80 :     of AST.E_Var _ => pp e
81 :     | AST.E_Lit _ => pp e
82 :     | AST.E_Tuple _ => pp e
83 :     | AST.E_Cons _ => pp e
84 : jhr 1688 | AST.E_Seq _ => pp e
85 : jhr 1687 | _ => (string "("; pp e; string ")")
86 :     (* end case *))
87 : jhr 94 (* end case *))
88 :     in
89 :     pp e
90 :     end
91 :    
92 :     and ppArgs (ppStrm, args) = ppList ppExp ("(", ",", ")") (ppStrm, args)
93 :    
94 :     fun ppVarDecl ppStrm (AST.VD_Decl(x, e)) = let
95 :     fun sp () = PP.space ppStrm 1
96 :     val string = PP.string ppStrm
97 :     in
98 :     PP.openHBox ppStrm;
99 : jhr 173 case Var.kindOf x
100 :     of AST.InputVar => (string "input"; sp())
101 : jhr 511 | AST.StrandOutputVar => (string "output"; sp())
102 : jhr 173 | _ => ()
103 :     (* end case *);
104 :     string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x);
105 : jhr 94 sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
106 :     PP.closeBox ppStrm
107 :     end
108 :    
109 :     fun ppBlock (ppStrm, stms) = let
110 :     fun sp () = PP.space ppStrm 1
111 :     fun nl () = PP.newline ppStrm
112 :     val string = PP.string ppStrm
113 :     fun var x = string(Var.nameOf x)
114 :     fun ppStmt stmt = (case stmt
115 :     of AST.S_Block stms => ppBlock (ppStrm, stms)
116 :     | AST.S_Decl vdcl => (ppVarDecl ppStrm vdcl; nl())
117 :     | AST.S_IfThenElse(e, AST.S_Block stms, AST.S_Block[]) => (
118 :     PP.openHBox ppStrm;
119 :     string "if"; sp(); ppExp(ppStrm, e);
120 :     sp(); ppBlock (ppStrm, stms);
121 :     PP.closeBox ppStrm)
122 :     | AST.S_IfThenElse(e, s1, AST.S_Block[]) => (
123 :     PP.openVBox ppStrm indent;
124 :     PP.openHBox ppStrm;
125 :     string "if"; sp(); ppExp(ppStrm, e);
126 :     PP.closeBox ppStrm;
127 :     nl();
128 :     ppStmt s1;
129 :     PP.closeBox ppStrm;
130 :     nl())
131 :     | AST.S_IfThenElse(e, AST.S_Block stms1, AST.S_Block stms2) => (
132 :     PP.openHBox ppStrm;
133 :     string "if"; sp(); ppExp(ppStrm, e);
134 : jhr 103 sp(); ppBlock (ppStrm, stms1);
135 : jhr 94 PP.closeBox ppStrm;
136 :     PP.openHBox ppStrm;
137 : jhr 103 string "else"; sp(); ppBlock (ppStrm, stms2);
138 : jhr 94 PP.closeBox ppStrm)
139 : jhr 1113 | AST.S_IfThenElse(e, AST.S_Block stms1, s2) => (
140 :     PP.openHBox ppStrm;
141 :     string "if"; sp(); ppExp(ppStrm, e);
142 :     sp(); ppBlock (ppStrm, stms1);
143 :     PP.closeBox ppStrm;
144 :     string "else";
145 :     PP.openVBox ppStrm indent;
146 :     nl(); ppStmt s2;
147 :     PP.closeBox ppStrm)
148 : jhr 94 | AST.S_IfThenElse(e, s1, AST.S_Block stms2) => raise Fail "FIXME"
149 :     | AST.S_IfThenElse(e, s1, s2) => (
150 :     PP.openVBox ppStrm indent;
151 :     PP.openHBox ppStrm;
152 :     string "if"; sp(); ppExp(ppStrm, e);
153 :     PP.closeBox ppStrm;
154 :     nl();
155 :     ppStmt s1;
156 :     PP.closeBox ppStrm;
157 :     nl();
158 :     PP.openVBox ppStrm indent;
159 :     string "else"; nl();
160 :     ppStmt s2;
161 :     PP.closeBox ppStrm;
162 :     nl())
163 :     | AST.S_Assign(x, e) => (
164 :     PP.openHBox ppStrm;
165 :     var x; sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
166 :     PP.closeBox ppStrm;
167 :     nl())
168 : jhr 511 | AST.S_New(strand, args) => (
169 : jhr 94 PP.openHBox ppStrm;
170 : jhr 511 string "new"; sp(); string(Atom.toString strand); sp();
171 : jhr 94 ppArgs (ppStrm, args); string ";";
172 :     PP.closeBox ppStrm;
173 :     nl())
174 :     | AST.S_Die => (string "die;"; nl())
175 :     | AST.S_Stabilize => (string "stabilize;"; nl())
176 : jhr 1640 | AST.S_Print args => (
177 :     PP.openHBox ppStrm;
178 :     string "print"; sp(); ppArgs (ppStrm, args); string ";";
179 :     PP.closeBox ppStrm;
180 :     nl())
181 : jhr 94 (* end case *))
182 :     in
183 :     PP.openVBox ppStrm (PP.Abs 0);
184 :     string "{"; nl();
185 :     PP.openVBox ppStrm indent;
186 :     List.app ppStmt stms;
187 :     PP.closeBox ppStrm;
188 :     string "}"; nl();
189 :     PP.closeBox ppStrm
190 :     end
191 :    
192 : jhr 511 fun ppStrand (ppStrm, {name, params, state, methods}) = let
193 : jhr 94 fun sp () = PP.space ppStrm 1
194 :     fun nl () = PP.newline ppStrm
195 :     val string = PP.string ppStrm
196 :     fun var x = string(Var.nameOf x)
197 :     fun ppMethod (AST.M_Method(name, AST.S_Block stms)) = (
198 : jhr 1640 nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, stms))
199 : jhr 94 | ppMethod (AST.M_Method(name, stm)) = (
200 : jhr 1640 nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, [stm]))
201 : jhr 94 in
202 :     PP.openHBox ppStrm;
203 : jhr 511 string "strand"; sp(); string(Atom.toString name); sp();
204 : jhr 96 ppList (fn (_, x) => (string(TU.toString(#2(Var.typeOf x))); sp(); var x))
205 : jhr 94 ("(", ",", ")") (ppStrm, params);
206 :     PP.closeBox ppStrm;
207 :     nl();
208 :     PP.openVBox ppStrm indent;
209 :     string "{";
210 : jhr 173 List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) state;
211 : jhr 94 List.app ppMethod methods;
212 :     PP.closeBox ppStrm;
213 :     nl();
214 :     string "}"; nl()
215 :     end
216 :    
217 :     fun ppDecl ppStrm = let
218 :     fun sp () = PP.space ppStrm 1
219 :     fun nl () = PP.newline ppStrm
220 :     val string = PP.string ppStrm
221 :     fun var x = string(Var.nameOf x)
222 : jhr 2011 fun ppDesc NONE = ()
223 :     | ppDesc (SOME desc) = (
224 :     string(concat["(\"", String.toString desc, "\")"]); sp())
225 : jhr 94 in
226 : jhr 1301 fn AST.D_Input(x, desc, NONE) => (
227 : jhr 94 PP.openHBox ppStrm;
228 :     string "input"; sp();
229 : jhr 2011 ppDesc desc;
230 : jhr 96 string(TU.toString(#2(Var.typeOf x))); sp(); var x; string ";";
231 : jhr 94 PP.closeBox ppStrm;
232 :     nl())
233 : jhr 1301 | AST.D_Input(x, desc, SOME e) => (
234 : jhr 94 PP.openHBox ppStrm;
235 :     string "input"; sp();
236 : jhr 2011 ppDesc desc;
237 : jhr 96 string(TU.toString(#2(Var.typeOf x))); sp(); var x;
238 : jhr 94 sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
239 :     PP.closeBox ppStrm;
240 :     nl())
241 :     | AST.D_Var vdcl => (ppVarDecl ppStrm vdcl; nl())
242 : jhr 511 | AST.D_Strand def => ppStrand (ppStrm, def)
243 : jhr 94 | AST.D_InitialArray(create, iters) => (* FIXME *) ()
244 :     | AST.D_InitialCollection(create, iters) => (* FIXME *) ()
245 :     end
246 :    
247 :     fun output (outS, AST.Program decls) = let
248 : jhr 93 val ppStrm = PP.openOut {dst = outS, wid = 120}
249 :     in
250 : jhr 94 PP.openVBox ppStrm (PP.Abs 0);
251 :     PP.string ppStrm "/* Program start */"; PP.newline ppStrm;
252 :     List.app (ppDecl ppStrm) decls;
253 :     PP.string ppStrm "/* Program end */"; PP.newline ppStrm;
254 :     PP.closeBox ppStrm;
255 : jhr 93 PP.closeStream ppStrm
256 :     end
257 :    
258 :     end

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