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

SCM Repository

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

Annotation of /branches/pure-cfg/src/compiler/ast/ast-pp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3349 - (view) (download)

1 : jhr 93 (* ast-pp.sml
2 :     *
3 : jhr 3349 * 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 :     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 : 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 :     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 : jhr 94 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 : jhr 381 fun ppIndex (ppStrm, NONE) = PP.string ppStrm ":"
52 :     | ppIndex (ppStrm, SOME e) = ppExp (ppStrm, e)
53 : jhr 94 fun pp e = (case e
54 : jhr 170 of AST.E_Var x => var x
55 : jhr 94 | 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 : jhr 96 var f; ppTyArgs (ppStrm, mvs); sp(); ppArgs (ppStrm, args))
60 : jhr 94 | AST.E_Cons 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 94 (* end case *))
68 :     in
69 :     pp e
70 :     end
71 :    
72 :     and ppArgs (ppStrm, args) = ppList ppExp ("(", ",", ")") (ppStrm, args)
73 :    
74 :     fun ppVarDecl ppStrm (AST.VD_Decl(x, e)) = let
75 :     fun sp () = PP.space ppStrm 1
76 :     val string = PP.string ppStrm
77 :     in
78 :     PP.openHBox ppStrm;
79 : jhr 173 case Var.kindOf x
80 :     of AST.InputVar => (string "input"; sp())
81 : jhr 499 | AST.StrandOutputVar => (string "output"; sp())
82 : jhr 173 | _ => ()
83 :     (* end case *);
84 :     string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x);
85 : jhr 94 sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
86 :     PP.closeBox ppStrm
87 :     end
88 :    
89 :     fun ppBlock (ppStrm, stms) = let
90 :     fun sp () = PP.space ppStrm 1
91 :     fun nl () = PP.newline ppStrm
92 :     val string = PP.string ppStrm
93 :     fun var x = string(Var.nameOf x)
94 :     fun ppStmt stmt = (case stmt
95 :     of AST.S_Block stms => ppBlock (ppStrm, stms)
96 :     | AST.S_Decl vdcl => (ppVarDecl ppStrm vdcl; nl())
97 :     | AST.S_IfThenElse(e, AST.S_Block stms, AST.S_Block[]) => (
98 :     PP.openHBox ppStrm;
99 :     string "if"; sp(); ppExp(ppStrm, e);
100 :     sp(); ppBlock (ppStrm, stms);
101 :     PP.closeBox ppStrm)
102 :     | AST.S_IfThenElse(e, s1, AST.S_Block[]) => (
103 :     PP.openVBox ppStrm indent;
104 :     PP.openHBox ppStrm;
105 :     string "if"; sp(); ppExp(ppStrm, e);
106 :     PP.closeBox ppStrm;
107 :     nl();
108 :     ppStmt s1;
109 :     PP.closeBox ppStrm;
110 :     nl())
111 :     | AST.S_IfThenElse(e, AST.S_Block stms1, AST.S_Block stms2) => (
112 :     PP.openHBox ppStrm;
113 :     string "if"; sp(); ppExp(ppStrm, e);
114 : jhr 103 sp(); ppBlock (ppStrm, stms1);
115 : jhr 94 PP.closeBox ppStrm;
116 :     PP.openHBox ppStrm;
117 : jhr 103 string "else"; sp(); ppBlock (ppStrm, stms2);
118 : jhr 94 PP.closeBox ppStrm)
119 : jhr 602 | AST.S_IfThenElse(e, AST.S_Block stms1, s2) => (
120 :     PP.openHBox ppStrm;
121 :     string "if"; sp(); ppExp(ppStrm, e);
122 :     sp(); ppBlock (ppStrm, stms1);
123 :     PP.closeBox ppStrm;
124 :     string "else";
125 :     PP.openVBox ppStrm indent;
126 :     nl(); ppStmt s2;
127 :     PP.closeBox ppStrm)
128 : jhr 94 | AST.S_IfThenElse(e, s1, AST.S_Block stms2) => raise Fail "FIXME"
129 :     | AST.S_IfThenElse(e, s1, s2) => (
130 :     PP.openVBox ppStrm indent;
131 :     PP.openHBox ppStrm;
132 :     string "if"; sp(); ppExp(ppStrm, e);
133 :     PP.closeBox ppStrm;
134 :     nl();
135 :     ppStmt s1;
136 :     PP.closeBox ppStrm;
137 :     nl();
138 :     PP.openVBox ppStrm indent;
139 :     string "else"; nl();
140 :     ppStmt s2;
141 :     PP.closeBox ppStrm;
142 :     nl())
143 :     | AST.S_Assign(x, e) => (
144 :     PP.openHBox ppStrm;
145 :     var x; sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
146 :     PP.closeBox ppStrm;
147 :     nl())
148 : jhr 499 | AST.S_New(strand, args) => (
149 : jhr 94 PP.openHBox ppStrm;
150 : jhr 499 string "new"; sp(); string(Atom.toString strand); sp();
151 : jhr 94 ppArgs (ppStrm, args); string ";";
152 :     PP.closeBox ppStrm;
153 :     nl())
154 :     | AST.S_Die => (string "die;"; nl())
155 :     | AST.S_Stabilize => (string "stabilize;"; nl())
156 : jhr 1623 | AST.S_Print args => (
157 :     PP.openHBox ppStrm;
158 :     string "print"; sp(); ppArgs (ppStrm, args); string ";";
159 :     PP.closeBox ppStrm;
160 :     nl())
161 : jhr 94 (* end case *))
162 :     in
163 :     PP.openVBox ppStrm (PP.Abs 0);
164 :     string "{"; nl();
165 :     PP.openVBox ppStrm indent;
166 :     List.app ppStmt stms;
167 :     PP.closeBox ppStrm;
168 :     string "}"; nl();
169 :     PP.closeBox ppStrm
170 :     end
171 :    
172 : jhr 499 fun ppStrand (ppStrm, {name, params, state, methods}) = let
173 : jhr 94 fun sp () = PP.space ppStrm 1
174 :     fun nl () = PP.newline ppStrm
175 :     val string = PP.string ppStrm
176 :     fun var x = string(Var.nameOf x)
177 :     fun ppMethod (AST.M_Method(name, AST.S_Block stms)) = (
178 : jhr 1505 nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, stms))
179 : jhr 94 | ppMethod (AST.M_Method(name, stm)) = (
180 : jhr 1505 nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, [stm]))
181 : jhr 94 in
182 :     PP.openHBox ppStrm;
183 : jhr 499 string "strand"; sp(); string(Atom.toString name); sp();
184 : jhr 96 ppList (fn (_, x) => (string(TU.toString(#2(Var.typeOf x))); sp(); var x))
185 : jhr 94 ("(", ",", ")") (ppStrm, params);
186 :     PP.closeBox ppStrm;
187 :     nl();
188 :     PP.openVBox ppStrm indent;
189 :     string "{";
190 : jhr 173 List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) state;
191 : jhr 94 List.app ppMethod methods;
192 :     PP.closeBox ppStrm;
193 :     nl();
194 :     string "}"; nl()
195 :     end
196 :    
197 :     fun ppDecl ppStrm = let
198 :     fun sp () = PP.space ppStrm 1
199 :     fun nl () = PP.newline ppStrm
200 :     val string = PP.string ppStrm
201 :     fun var x = string(Var.nameOf x)
202 :     in
203 : jhr 1250 fn AST.D_Input(x, desc, NONE) => (
204 : jhr 94 PP.openHBox ppStrm;
205 :     string "input"; sp();
206 : jhr 1250 string(concat["(\"", String.toString desc, "\")"]); sp();
207 : jhr 96 string(TU.toString(#2(Var.typeOf x))); sp(); var x; string ";";
208 : jhr 94 PP.closeBox ppStrm;
209 :     nl())
210 : jhr 1250 | AST.D_Input(x, desc, SOME e) => (
211 : jhr 94 PP.openHBox ppStrm;
212 :     string "input"; sp();
213 : jhr 1250 string(concat["(\"", String.toString desc, "\")"]); sp();
214 : jhr 96 string(TU.toString(#2(Var.typeOf x))); sp(); var x;
215 : jhr 94 sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
216 :     PP.closeBox ppStrm;
217 :     nl())
218 :     | AST.D_Var vdcl => (ppVarDecl ppStrm vdcl; nl())
219 : jhr 499 | AST.D_Strand def => ppStrand (ppStrm, def)
220 : jhr 94 | AST.D_InitialArray(create, iters) => (* FIXME *) ()
221 :     | AST.D_InitialCollection(create, iters) => (* FIXME *) ()
222 :     end
223 :    
224 :     fun output (outS, AST.Program decls) = let
225 : jhr 93 val ppStrm = PP.openOut {dst = outS, wid = 120}
226 :     in
227 : jhr 94 PP.openVBox ppStrm (PP.Abs 0);
228 :     PP.string ppStrm "/* Program start */"; PP.newline ppStrm;
229 :     List.app (ppDecl ppStrm) decls;
230 :     PP.string ppStrm "/* Program end */"; PP.newline ppStrm;
231 :     PP.closeBox ppStrm;
232 : jhr 93 PP.closeStream ppStrm
233 :     end
234 :    
235 :     end

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