Annotation of /trunk/src/compiler/ast/ast-pp.sml

Parent Directory | Revision Log

---

Revision 173 - (view) (download)

1 :	jhr	93	(* ast-pp.sml
2 :			*
3 :			* COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :			* 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 :			fun pp e = (case e
50 :	jhr	170	of AST.E_Var x => var x
51 :	jhr	94	| AST.E_Lit lit => string (Literal.toString lit)
52 :			| AST.E_Tuple es => ppArgs (ppStrm, es)
53 :			| AST.E_Apply(f, [], args, _) => (var f; sp(); ppArgs (ppStrm, args))
54 :			| AST.E_Apply(f, mvs, args, _) => (
55 :	jhr	96	var f; ppTyArgs (ppStrm, mvs); sp(); ppArgs (ppStrm, args))
56 :	jhr	94	| AST.E_Cons es => (
57 :			ppList ppExp ("[", ",", "]") (ppStrm, es))
58 :			| AST.E_Cond(e1, e2, e3) => (
59 :			pp e1; sp(); string "?"; sp(); pp e2; sp(); string ":"; sp(); pp e3)
60 :			(* end case *))
61 :			in
62 :			pp e
63 :			end
64 :
65 :			and ppArgs (ppStrm, args) = ppList ppExp ("(", ",", ")") (ppStrm, args)
66 :
67 :			fun ppVarDecl ppStrm (AST.VD_Decl(x, e)) = let
68 :			fun sp () = PP.space ppStrm 1
69 :			val string = PP.string ppStrm
70 :			in
71 :			PP.openHBox ppStrm;
72 :	jhr	173	case Var.kindOf x
73 :			of AST.InputVar => (string "input"; sp())
74 :			| AST.ActorOutputVar => (string "output"; sp())
75 :			| _ => ()
76 :			(* end case *);
77 :			string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x);
78 :	jhr	94	sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
79 :			PP.closeBox ppStrm
80 :			end
81 :
82 :			fun ppBlock (ppStrm, stms) = let
83 :			fun sp () = PP.space ppStrm 1
84 :			fun nl () = PP.newline ppStrm
85 :			val string = PP.string ppStrm
86 :			fun var x = string(Var.nameOf x)
87 :			fun ppStmt stmt = (case stmt
88 :			of AST.S_Block stms => ppBlock (ppStrm, stms)
89 :			| AST.S_Decl vdcl => (ppVarDecl ppStrm vdcl; nl())
90 :			| AST.S_IfThenElse(e, AST.S_Block stms, AST.S_Block[]) => (
91 :			PP.openHBox ppStrm;
92 :			string "if"; sp(); ppExp(ppStrm, e);
93 :			sp(); ppBlock (ppStrm, stms);
94 :			PP.closeBox ppStrm)
95 :			| AST.S_IfThenElse(e, s1, AST.S_Block[]) => (
96 :			PP.openVBox ppStrm indent;
97 :			PP.openHBox ppStrm;
98 :			string "if"; sp(); ppExp(ppStrm, e);
99 :			PP.closeBox ppStrm;
100 :			nl();
101 :			ppStmt s1;
102 :			PP.closeBox ppStrm;
103 :			nl())
104 :			| AST.S_IfThenElse(e, AST.S_Block stms1, AST.S_Block stms2) => (
105 :			PP.openHBox ppStrm;
106 :			string "if"; sp(); ppExp(ppStrm, e);
107 :	jhr	103	sp(); ppBlock (ppStrm, stms1);
108 :	jhr	94	PP.closeBox ppStrm;
109 :			PP.openHBox ppStrm;
110 :	jhr	103	string "else"; sp(); ppBlock (ppStrm, stms2);
111 :	jhr	94	PP.closeBox ppStrm)
112 :			| AST.S_IfThenElse(e, AST.S_Block stms1, s2) => raise Fail "FIXME"
113 :			| AST.S_IfThenElse(e, s1, AST.S_Block stms2) => raise Fail "FIXME"
114 :			| AST.S_IfThenElse(e, s1, s2) => (
115 :			PP.openVBox ppStrm indent;
116 :			PP.openHBox ppStrm;
117 :			string "if"; sp(); ppExp(ppStrm, e);
118 :			PP.closeBox ppStrm;
119 :			nl();
120 :			ppStmt s1;
121 :			PP.closeBox ppStrm;
122 :			nl();
123 :			PP.openVBox ppStrm indent;
124 :			string "else"; nl();
125 :			ppStmt s2;
126 :			PP.closeBox ppStrm;
127 :			nl())
128 :			| AST.S_Assign(x, e) => (
129 :			PP.openHBox ppStrm;
130 :			var x; sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
131 :			PP.closeBox ppStrm;
132 :			nl())
133 :			| AST.S_New(actor, args) => (
134 :			PP.openHBox ppStrm;
135 :			string "new"; sp(); string(Atom.toString actor); sp();
136 :			ppArgs (ppStrm, args); string ";";
137 :			PP.closeBox ppStrm;
138 :			nl())
139 :			| AST.S_Die => (string "die;"; nl())
140 :			| AST.S_Stabilize => (string "stabilize;"; nl())
141 :			(* end case *))
142 :			in
143 :			PP.openVBox ppStrm (PP.Abs 0);
144 :			string "{"; nl();
145 :			PP.openVBox ppStrm indent;
146 :			List.app ppStmt stms;
147 :			PP.closeBox ppStrm;
148 :			string "}"; nl();
149 :			PP.closeBox ppStrm
150 :			end
151 :
152 :			fun ppActor (ppStrm, {name, params, state, methods}) = let
153 :			fun sp () = PP.space ppStrm 1
154 :			fun nl () = PP.newline ppStrm
155 :			val string = PP.string ppStrm
156 :			fun var x = string(Var.nameOf x)
157 :			fun ppMethod (AST.M_Method(name, AST.S_Block stms)) = (
158 :			nl(); string(Atom.toString name); nl(); ppBlock (ppStrm, stms))
159 :			| ppMethod (AST.M_Method(name, stm)) = (
160 :			nl(); string(Atom.toString name); nl(); ppBlock (ppStrm, [stm]))
161 :			in
162 :			PP.openHBox ppStrm;
163 :			string "actor"; sp(); string(Atom.toString name); sp();
164 :	jhr	96	ppList (fn (_, x) => (string(TU.toString(#2(Var.typeOf x))); sp(); var x))
165 :	jhr	94	("(", ",", ")") (ppStrm, params);
166 :			PP.closeBox ppStrm;
167 :			nl();
168 :			PP.openVBox ppStrm indent;
169 :			string "{";
170 :	jhr	173	List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) state;
171 :	jhr	94	List.app ppMethod methods;
172 :			PP.closeBox ppStrm;
173 :			nl();
174 :			string "}"; nl()
175 :			end
176 :
177 :			fun ppDecl ppStrm = let
178 :			fun sp () = PP.space ppStrm 1
179 :			fun nl () = PP.newline ppStrm
180 :			val string = PP.string ppStrm
181 :			fun var x = string(Var.nameOf x)
182 :			in
183 :			fn AST.D_Input(x, NONE) => (
184 :			PP.openHBox ppStrm;
185 :			string "input"; sp();
186 :	jhr	96	string(TU.toString(#2(Var.typeOf x))); sp(); var x; string ";";
187 :	jhr	94	PP.closeBox ppStrm;
188 :			nl())
189 :			| AST.D_Input(x, SOME e) => (
190 :			PP.openHBox ppStrm;
191 :			string "input"; sp();
192 :	jhr	96	string(TU.toString(#2(Var.typeOf x))); sp(); var x;
193 :	jhr	94	sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
194 :			PP.closeBox ppStrm;
195 :			nl())
196 :			| AST.D_Var vdcl => (ppVarDecl ppStrm vdcl; nl())
197 :			| AST.D_Actor def => ppActor (ppStrm, def)
198 :			| AST.D_InitialArray(create, iters) => (* FIXME *) ()
199 :			| AST.D_InitialCollection(create, iters) => (* FIXME *) ()
200 :			end
201 :
202 :			fun output (outS, AST.Program decls) = let
203 :	jhr	93	val ppStrm = PP.openOut {dst = outS, wid = 120}
204 :			in
205 :	jhr	94	PP.openVBox ppStrm (PP.Abs 0);
206 :			PP.string ppStrm "/* Program start */"; PP.newline ppStrm;
207 :			List.app (ppDecl ppStrm) decls;
208 :			PP.string ppStrm "/* Program end */"; PP.newline ppStrm;
209 :			PP.closeBox ppStrm;
210 :	jhr	93	PP.closeStream ppStrm
211 :			end
212 :
213 :			end

---

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