Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/Elaborator/print/ppabsyn.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Elaborator/print/ppabsyn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1641 - (view) (download)

1 : blume 902 (* Copyright 1992 by AT&T Bell Laboratories *)
2 :     (* absyn/ppabsyn.sml *)
3 :    
4 :     signature PPABSYN =
5 :     sig
6 : macqueen 1344 val ppPat : StaticEnv.staticEnv -> PrettyPrint.stream
7 : blume 902 -> Absyn.pat * int -> unit
8 :     val ppExp : StaticEnv.staticEnv * Source.inputSource option
9 : macqueen 1344 -> PrettyPrint.stream -> Absyn.exp * int -> unit
10 : blume 902 val ppRule : StaticEnv.staticEnv * Source.inputSource option
11 : macqueen 1344 -> PrettyPrint.stream -> Absyn.rule * int -> unit
12 : blume 902 val ppVB : StaticEnv.staticEnv * Source.inputSource option
13 : macqueen 1344 -> PrettyPrint.stream -> Absyn.vb * int -> unit
14 : blume 902 val ppRVB : StaticEnv.staticEnv * Source.inputSource option
15 : macqueen 1344 -> PrettyPrint.stream -> Absyn.rvb * int -> unit
16 : blume 902 val ppDec : StaticEnv.staticEnv * Source.inputSource option
17 : macqueen 1344 -> PrettyPrint.stream -> Absyn.dec * int -> unit
18 : blume 902
19 :     val ppStrexp : StaticEnv.staticEnv * Source.inputSource option
20 : macqueen 1344 -> PrettyPrint.stream -> Absyn.strexp * int -> unit
21 : blume 902
22 :     val lineprint : bool ref
23 :    
24 :     val debugging : bool ref
25 :    
26 :     end (* signature PPABSYN *)
27 :    
28 :    
29 :     structure PPAbsyn: PPABSYN =
30 :     struct
31 :    
32 :     local structure EM = ErrorMsg
33 :     structure M = Modules
34 :     structure B = Bindings
35 :     structure S = Symbol
36 : macqueen 1344 structure PP = PrettyPrint
37 : blume 902
38 :     open Absyn Tuples Fixity VarCon Types PrettyPrint PPUtil PPType PPVal
39 :     in
40 :    
41 :     (* debugging *)
42 :     val say = Control_Print.say
43 :     val debugging = ref false
44 :     fun debugmsg (msg: string) =
45 :     if !debugging then (say msg; say "\n") else ()
46 :     fun bug msg = ErrorMsg.impossible("PPAbsyn: "^msg)
47 :    
48 :     val internals = ElabControl.internals
49 :    
50 :     val lineprint = ref false
51 :    
52 :     fun C f x y = f y x
53 :    
54 :     val nullFix = INfix(0,0)
55 :     val infFix = INfix(1000000,100000)
56 :     fun strongerL(INfix(_,m),INfix(n,_)) = m >= n
57 :     | strongerL _ = false (* should not matter *)
58 :     fun strongerR(INfix(_,m),INfix(n,_)) = n > m
59 :     | strongerR _ = true (* should not matter *)
60 :    
61 : macqueen 1344 fun prpos(ppstrm: PrettyPrint.stream,
62 : blume 902 source: Source.inputSource, charpos: int) =
63 :     if (!lineprint) then
64 :     let val (file:string,line:int,pos:int) = Source.filepos source charpos
65 : macqueen 1344 in PP.string ppstrm (Int.toString line);
66 :     PP.string ppstrm ".";
67 :     PP.string ppstrm (Int.toString pos)
68 : blume 902 end
69 : macqueen 1344 else PP.string ppstrm (Int.toString charpos)
70 : blume 902
71 :    
72 :     fun checkpat (n,nil) = true
73 :     | checkpat (n, (sym,_)::fields) =
74 :     S.eq(sym, numlabel n) andalso checkpat(n+1,fields)
75 :    
76 :     fun checkexp (n,nil) = true
77 :     | checkexp (n, (LABEL{name=sym,...},_)::fields) =
78 :     S.eq(sym, numlabel n) andalso checkexp(n+1,fields)
79 :    
80 :     fun isTUPLEpat (RECORDpat{fields=[_],...}) = false
81 :     | isTUPLEpat (RECORDpat{flex=false,fields,...}) = checkpat(1,fields)
82 :     | isTUPLEpat _ = false
83 :    
84 :     fun isTUPLEexp (RECORDexp [_]) = false
85 :     | isTUPLEexp (RECORDexp fields) = checkexp(1,fields)
86 :     | isTUPLEexp (MARKexp(a,_)) = isTUPLEexp a
87 :     | isTUPLEexp _ = false
88 :    
89 :     fun lookFIX (env,sym) =
90 :     Lookup.lookFix (env,S.fixSymbol(S.name sym))
91 :    
92 :     fun stripMark (MARKexp(a,_)) = stripMark a
93 :     | stripMark x = x
94 :    
95 :     fun ppPat env ppstrm =
96 : macqueen 1344 let val ppsay = PP.string ppstrm
97 : blume 902 fun ppPat' (_,0) = ppsay "<pat>"
98 :     | ppPat' (VARpat v,_) = ppVar ppstrm v
99 :     | ppPat' (WILDpat,_) = ppsay "_"
100 :     | ppPat' (INTpat(i,t),_) = ppsay(IntInf.toString i)
101 :     (* (begin_block ppstrm INCONSISTENT 2;
102 :     ppsay "("; ppsay(IntInf.toString i);
103 : macqueen 1344 ppsay " :"; break ppstrm {nsp=1,offset=1};
104 : blume 902 ppType env ppstrm t; ppsay ")";
105 :     end_block ppstrm) *)
106 :     | ppPat' (WORDpat(w,t),_) = ppsay(IntInf.toString w)
107 : macqueen 1344 (* (openStyleBox INCONSISTENT ppstrm (PP.Rel 2);
108 : blume 902 ppsay "("; ppsay(IntInf.toString w);
109 : macqueen 1344 ppsay " :"; break ppstrm {nsp=1,offset=1};
110 : blume 902 ppType env ppstrm t; ppsay ")";
111 : macqueen 1344 closeBox ppstrm) *)
112 : blume 902 | ppPat' (REALpat r,_) = ppsay r
113 :     | ppPat' (STRINGpat s,_) = pp_mlstr ppstrm s
114 :     | ppPat' (CHARpat s,_) = (ppsay "#"; pp_mlstr ppstrm s)
115 :     | ppPat' (LAYEREDpat (v,p),d) =
116 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
117 : blume 902 ppPat'(v,d); ppsay " as "; ppPat'(p,d-1);
118 : macqueen 1344 closeBox ppstrm)
119 : blume 902 (* Handle 0 length case specially to avoid {,...}: *)
120 :     | ppPat' (RECORDpat{fields=[],flex,...},_) =
121 :     if flex then ppsay "{...}"
122 :     else ppsay "()"
123 :     | ppPat' (r as RECORDpat{fields,flex,...},d) =
124 :     if isTUPLEpat r
125 :     then ppClosedSequence ppstrm
126 : macqueen 1344 {front=(C PP.string "("),
127 :     sep=(fn ppstrm => (PP.string ppstrm ",";
128 :     break ppstrm {nsp=0,offset=0})),
129 :     back=(C PP.string ")"),
130 : blume 902 pr=(fn _ => fn (sym,pat) => ppPat'(pat,d-1)),
131 :     style=INCONSISTENT}
132 :     fields
133 :     else ppClosedSequence ppstrm
134 : macqueen 1344 {front=(C PP.string "{"),
135 :     sep=(fn ppstrm => (PP.string ppstrm ",";
136 :     break ppstrm {nsp=0,offset=0})),
137 :     back=(fn ppstrm => if flex then PP.string ppstrm ",...}"
138 :     else PP.string ppstrm "}"),
139 : blume 902 pr=(fn ppstrm => fn (sym,pat) =>
140 : macqueen 1344 (ppSym ppstrm sym; PP.string ppstrm "=";
141 : blume 902 ppPat'(pat,d-1))),
142 :     style=INCONSISTENT}
143 :     fields
144 :     | ppPat' (VECTORpat(nil,_), d) = ppsay "#[]"
145 :     | ppPat' (VECTORpat(pats,_), d) =
146 :     let fun pr _ pat = ppPat'(pat, d-1)
147 :     in ppClosedSequence ppstrm
148 : macqueen 1344 {front=(C PP.string "#["),
149 :     sep=(fn ppstrm => (PP.string ppstrm ",";
150 :     break ppstrm {nsp=0,offset=0})),
151 :     back=(C PP.string "]"),
152 : blume 902 pr=pr,
153 :     style=INCONSISTENT}
154 :     pats
155 :     end
156 :     | ppPat' (pat as (ORpat _), d) = let
157 :     fun mkList (ORpat(hd, tl)) = hd :: mkList tl
158 :     | mkList p = [p]
159 :     fun pr _ pat = ppPat'(pat, d-1)
160 :     in
161 :     ppClosedSequence ppstrm {
162 : macqueen 1344 front = (C PP.string "("),
163 :     sep = fn ppstrm => (break ppstrm {nsp=1,offset=0};
164 :     PP.string ppstrm "| "),
165 :     back = (C PP.string ")"),
166 : blume 902 pr = pr,
167 :     style = INCONSISTENT
168 :     } (mkList pat)
169 :     end
170 :     | ppPat' (CONpat(e,_),_) = ppDcon ppstrm e
171 :     | ppPat' (p as APPpat _, d) =
172 :     ppDconPat (env,ppstrm) (p,nullFix,nullFix,d)
173 :     | ppPat' (CONSTRAINTpat (p,t),d) =
174 : macqueen 1344 (openStyleBox INCONSISTENT ppstrm (PP.Rel 0);
175 : blume 902 ppPat'(p,d-1); ppsay " :";
176 : macqueen 1344 break ppstrm {nsp=1,offset=2};
177 : blume 902 ppType env ppstrm t;
178 : macqueen 1344 closeBox ppstrm)
179 : blume 902 | ppPat' _ = bug "ppPat'"
180 :     in ppPat'
181 :     end
182 :    
183 :     and ppDconPat(env,ppstrm) =
184 : macqueen 1344 let val ppsay = PP.string ppstrm
185 : blume 902 fun lpcond(atom) = if atom then ppsay "(" else ()
186 :     fun rpcond(atom) = if atom then ppsay ")" else ()
187 :     fun ppDconPat'(_,_,_,0) = ppsay "<pat>"
188 :     | ppDconPat'(CONpat(DATACON{name,...},_),l:fixity,r:fixity,_) =
189 :     ppSym ppstrm name
190 :     | ppDconPat'(CONSTRAINTpat(p,t),l,r,d) =
191 : macqueen 1344 (openStyleBox INCONSISTENT ppstrm (PP.Rel 0);
192 : blume 902 ppsay "("; ppPat env ppstrm (p,d-1); ppsay " :";
193 : macqueen 1344 break ppstrm {nsp=1,offset=2};
194 : blume 902 ppType env ppstrm t; ppsay ")";
195 : macqueen 1344 closeBox ppstrm)
196 : blume 902 | ppDconPat'(LAYEREDpat(v,p),l,r,d) =
197 : macqueen 1344 (openStyleBox INCONSISTENT ppstrm (PP.Rel 0);
198 :     ppsay "("; ppPat env ppstrm (v,d); break ppstrm {nsp=1,offset=2};
199 : blume 902 ppsay " as "; ppPat env ppstrm (p,d-1); ppsay ")";
200 : macqueen 1344 closeBox ppstrm)
201 : blume 902 | ppDconPat'(APPpat(DATACON{name,...},_,p),l,r,d) =
202 :     let val dname = S.name name
203 :     (* should really have original path, like for VARexp *)
204 :     val thisFix = lookFIX(env,name)
205 :     val effFix = case thisFix of NONfix => infFix | x => x
206 :     val atom = strongerR(effFix,r) orelse strongerL(l,effFix)
207 : macqueen 1344 in openStyleBox INCONSISTENT ppstrm (PP.Rel 2);
208 : blume 902 lpcond(atom);
209 :     case (thisFix,p)
210 :     of (INfix _, RECORDpat{fields=[(_,pl),(_,pr)],...}) =>
211 :     let val (left,right) =
212 :     if atom then (nullFix,nullFix)
213 :     else (l,r)
214 :     in ppDconPat' (pl,left,thisFix,d-1);
215 : macqueen 1344 break ppstrm {nsp=1,offset=0};
216 : blume 902 ppsay dname;
217 : macqueen 1344 break ppstrm {nsp=1,offset=0};
218 : blume 902 ppDconPat' (pr,thisFix,right,d-1)
219 :     end
220 :     | _ =>
221 : macqueen 1344 (ppsay dname; break ppstrm {nsp=1,offset=0};
222 : blume 902 ppDconPat'(p,infFix,infFix,d-1));
223 :     rpcond(atom);
224 : macqueen 1344 closeBox ppstrm
225 : blume 902 end
226 :     | ppDconPat' (p,_,_,d) = ppPat env ppstrm (p,d)
227 :     in ppDconPat'
228 :     end
229 :    
230 :     fun trim [x] = []
231 :     | trim (a::b) = a::trim b
232 :     | trim [] = []
233 :    
234 :     fun ppExp (context as (env,source_opt)) ppstrm =
235 : macqueen 1344 let val ppsay = PP.string ppstrm
236 : blume 902 fun lparen() = ppsay "("
237 :     fun rparen() = ppsay ")"
238 :     fun lpcond(atom) = if atom then ppsay "(" else ()
239 :     fun rpcond(atom) = if atom then ppsay ")" else ()
240 :     fun ppExp'(_,_,0) = ppsay "<exp>"
241 :     | ppExp'(VARexp(ref var,_),_,_) = ppVar ppstrm var
242 :     | ppExp'(CONexp(con,_),_,_) = ppDcon ppstrm con
243 :     | ppExp'(INTexp (i,t),_,_) = ppsay(IntInf.toString i)
244 :     | ppExp'(WORDexp(w,t),_,_) = ppsay(IntInf.toString w)
245 :     | ppExp'(REALexp r,_,_) = ppsay r
246 :     | ppExp'(STRINGexp s,_,_) = pp_mlstr ppstrm s
247 :     | ppExp'(CHARexp s,_,_) = (ppsay "#"; pp_mlstr ppstrm s)
248 :     | ppExp'(r as RECORDexp fields,_,d) =
249 :     if isTUPLEexp r
250 :     then ppClosedSequence ppstrm
251 : macqueen 1344 {front=(C PP.string "("),
252 :     sep=(fn ppstrm => (PP.string ppstrm ",";
253 :     break ppstrm {nsp=0,offset=0})),
254 :     back=(C PP.string ")"),
255 : blume 902 pr=(fn _ => fn (_,exp) => ppExp'(exp,false,d-1)),
256 :     style=INCONSISTENT}
257 :     fields
258 :     else ppClosedSequence ppstrm
259 : macqueen 1344 {front=(C PP.string "{"),
260 :     sep=(fn ppstrm => (PP.string ppstrm ",";
261 :     break ppstrm {nsp=0,offset=0})),
262 :     back=(C PP.string "}"),
263 : blume 902 pr=(fn ppstrm => fn (LABEL{name,...},exp) =>
264 :     (ppSym ppstrm name; ppsay "=";
265 :     ppExp'(exp,false,d))),
266 :     style=INCONSISTENT}
267 :     fields
268 :     | ppExp'(SELECTexp (LABEL{name,...},exp),atom,d) =
269 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
270 : blume 902 lpcond(atom);
271 :     ppsay "#"; ppSym ppstrm name;
272 :     ppExp'(exp,true,d-1); ppsay ">";
273 :     rpcond(atom);
274 : macqueen 1344 closeBox ppstrm)
275 : blume 902 | ppExp'(VECTORexp(nil,_),_,d) = ppsay "#[]"
276 :     | ppExp'(VECTORexp(exps,_),_,d) =
277 :     let fun pr _ exp = ppExp'(exp,false,d-1)
278 :     in ppClosedSequence ppstrm
279 : macqueen 1344 {front=(C PP.string "#["),
280 :     sep=(fn ppstrm => (PP.string ppstrm ",";
281 :     break ppstrm {nsp=1,offset=0})),
282 :     back=(C PP.string "]"),
283 : blume 902 pr=pr,
284 :     style=INCONSISTENT}
285 :     exps
286 :     end
287 :     | ppExp'(PACKexp (e, t, tcs),atom,d) =
288 :     if !internals then
289 : macqueen 1344 (openStyleBox INCONSISTENT ppstrm (PP.Rel 0);
290 : blume 902 ppsay "<PACK: "; ppExp'(e,false,d); ppsay "; ";
291 : macqueen 1344 break ppstrm {nsp=1,offset=2};
292 : blume 902 ppType env ppstrm t; ppsay ">";
293 : macqueen 1344 closeBox ppstrm)
294 : blume 902 else ppExp'(e,atom,d)
295 :     | ppExp'(SEQexp exps,_,d) =
296 :     ppClosedSequence ppstrm
297 : macqueen 1344 {front=(C PP.string "("),
298 :     sep=(fn ppstrm => (PP.string ppstrm ";";
299 :     break ppstrm {nsp=1,offset=0})),
300 :     back=(C PP.string ")"),
301 : blume 902 pr=(fn _ => fn exp => ppExp'(exp,false,d-1)),
302 :     style=INCONSISTENT}
303 :     exps
304 :     | ppExp'(e as APPexp _,atom,d) =
305 :     let val infix0 = INfix(0,0)
306 :     in lpcond(atom);
307 :     ppAppExp(e,nullFix,nullFix,d);
308 :     rpcond(atom)
309 :     end
310 :     | ppExp'(CONSTRAINTexp(e, t),atom,d) =
311 : macqueen 1344 (openStyleBox INCONSISTENT ppstrm (PP.Rel 0);
312 : blume 902 lpcond(atom);
313 :     ppExp'(e,false,d); ppsay ":";
314 : macqueen 1344 break ppstrm {nsp=1,offset=2};
315 : blume 902 ppType env ppstrm t;
316 :     rpcond(atom);
317 : macqueen 1344 closeBox ppstrm)
318 : mblume 1641 | ppExp'(HANDLEexp(exp, (rules,_)),atom,d) =
319 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
320 : blume 902 lpcond(atom);
321 : macqueen 1344 ppExp'(exp,atom,d-1); newline ppstrm; ppsay "handle ";
322 : blume 902 nl_indent ppstrm 2;
323 :     ppvlist ppstrm (" ","| ",
324 :     (fn ppstrm => fn r => ppRule context ppstrm (r,d-1)), rules);
325 :     rpcond(atom);
326 : macqueen 1344 closeBox ppstrm)
327 : blume 902 | ppExp'(RAISEexp(exp,_),atom,d) =
328 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
329 : blume 902 lpcond(atom);
330 :     ppsay "raise "; ppExp'(exp,true,d-1);
331 :     rpcond(atom);
332 : macqueen 1344 closeBox ppstrm)
333 : blume 902 | ppExp'(LETexp(dec, exp),_,d) =
334 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
335 : blume 902 ppsay "let ";
336 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
337 : blume 902 ppDec context ppstrm (dec,d-1);
338 : macqueen 1344 closeBox ppstrm;
339 :     break ppstrm {nsp=1,offset=0};
340 : blume 902 ppsay "in ";
341 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
342 : blume 902 ppExp'(exp,false,d-1);
343 : macqueen 1344 closeBox ppstrm;
344 :     break ppstrm {nsp=1,offset=0};
345 : blume 902 ppsay "end";
346 : macqueen 1344 closeBox ppstrm)
347 : blume 902 | ppExp'(CASEexp(exp, rules, _),_,d) =
348 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
349 : blume 902 ppsay "(case "; ppExp'(exp,true,d-1); nl_indent ppstrm 2;
350 :     ppvlist ppstrm ("of "," | ",
351 :     (fn ppstrm => fn r => ppRule context ppstrm (r,d-1)),
352 :     trim rules);
353 :     rparen();
354 : macqueen 1344 closeBox ppstrm)
355 : mblume 1332 | ppExp' (IFexp { test, thenCase, elseCase },atom,d) =
356 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
357 : mblume 1332 lpcond(atom);
358 :     ppsay "if ";
359 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
360 : mblume 1332 ppExp' (test, false, d-1);
361 : macqueen 1344 closeBox ppstrm;
362 :     break ppstrm {nsp=1,offset= 0};
363 : mblume 1332 ppsay "then ";
364 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
365 : mblume 1332 ppExp' (thenCase, false, d-1);
366 : macqueen 1344 closeBox ppstrm;
367 :     break ppstrm {nsp=1,offset= 0};
368 : mblume 1332 ppsay "else ";
369 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
370 : mblume 1332 ppExp' (elseCase, false, d-1);
371 : macqueen 1344 closeBox ppstrm;
372 : mblume 1332 rpcond(atom);
373 : macqueen 1344 closeBox ppstrm)
374 : mblume 1332 | ppExp' (ANDALSOexp (e1, e2),atom,d) =
375 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
376 : mblume 1332 lpcond(atom);
377 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
378 : mblume 1332 ppExp' (e1,true,d-1);
379 : macqueen 1344 closeBox ppstrm;
380 :     break ppstrm {nsp=1,offset= 0};
381 : mblume 1332 ppsay "andalso ";
382 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
383 : mblume 1332 ppExp' (e2,true,d-1);
384 : macqueen 1344 closeBox ppstrm;
385 : mblume 1332 rpcond(atom);
386 : macqueen 1344 closeBox ppstrm)
387 : mblume 1332 | ppExp' (ORELSEexp (e1, e2),atom,d) =
388 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
389 : mblume 1332 lpcond(atom);
390 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
391 : mblume 1332 ppExp' (e1,true,d-1);
392 : macqueen 1344 closeBox ppstrm;
393 :     break ppstrm {nsp=1,offset= 0};
394 : mblume 1332 ppsay "orelse ";
395 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
396 : mblume 1332 ppExp' (e2,true,d-1);
397 : macqueen 1344 closeBox ppstrm;
398 : mblume 1332 rpcond(atom);
399 : macqueen 1344 closeBox ppstrm)
400 : mblume 1332 | ppExp' (WHILEexp { test, expr },atom,d) =
401 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
402 : mblume 1332 ppsay "while ";
403 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
404 : mblume 1332 ppExp'(test,false,d-1);
405 : macqueen 1344 closeBox ppstrm;
406 :     break ppstrm {nsp=1,offset= 0};
407 : mblume 1332 ppsay "do ";
408 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
409 : mblume 1332 ppExp'(expr,false,d-1);
410 : macqueen 1344 closeBox ppstrm;
411 :     closeBox ppstrm)
412 : blume 902 | ppExp'(FNexp(rules,_),_,d) =
413 : macqueen 1344 (openHVBox ppstrm (PP.Rel 0);
414 : blume 902 ppvlist ppstrm ("(fn "," | ",
415 :     (fn ppstrm => fn r =>
416 :     ppRule context ppstrm (r,d-1)),
417 :     trim rules);
418 :     rparen();
419 : macqueen 1344 closeBox ppstrm)
420 : blume 902 | ppExp'(MARKexp (exp,(s,e)),atom,d) =
421 :     (case source_opt
422 :     of SOME source =>
423 :     if !internals
424 :     then (ppsay "<MARK(";
425 :     prpos(ppstrm,source,s); ppsay ",";
426 :     prpos(ppstrm,source,e); ppsay "): ";
427 :     ppExp'(exp,false,d); ppsay ">")
428 :     else ppExp'(exp,atom,d)
429 :     | NONE => ppExp'(exp,atom,d))
430 :    
431 : macqueen 1344 and ppAppExp (_,_,_,0) = PP.string ppstrm "<exp>"
432 : blume 902 | ppAppExp arg =
433 : macqueen 1344 let val ppsay = PP.string ppstrm
434 : blume 902 fun fixitypp(name,rand,leftFix,rightFix,d) =
435 :     let val dname = SymPath.toString(SymPath.SPATH name)
436 :     val thisFix = case name
437 :     of [id] => lookFIX(env,id)
438 :     | _ => NONfix
439 :     fun prNon exp =
440 : macqueen 1344 (openStyleBox INCONSISTENT ppstrm (PP.Rel 2);
441 :     ppsay dname; break ppstrm {nsp=1,offset=0};
442 : blume 902 ppExp'(exp,true,d-1);
443 : macqueen 1344 closeBox ppstrm)
444 : blume 902 in case thisFix
445 :     of INfix _ =>
446 :     (case stripMark rand
447 :     of RECORDexp[(_,pl),(_,pr)] =>
448 :     let val atom = strongerL(leftFix,thisFix)
449 :     orelse strongerR(thisFix,rightFix)
450 :     val (left,right) =
451 :     if atom then (nullFix,nullFix)
452 :     else (leftFix,rightFix)
453 : macqueen 1344 in (openStyleBox INCONSISTENT ppstrm (PP.Rel 2);
454 : blume 902 lpcond(atom);
455 :     ppAppExp (pl,left,thisFix,d-1);
456 : macqueen 1344 break ppstrm {nsp=1,offset=0};
457 : blume 902 ppsay dname;
458 : macqueen 1344 break ppstrm {nsp=1,offset=0};
459 : blume 902 ppAppExp (pr,thisFix,right,d-1);
460 :     rpcond(atom);
461 : macqueen 1344 closeBox ppstrm)
462 : blume 902 end
463 :     | e' => prNon e')
464 :     | NONfix => prNon rand
465 :     end
466 :     fun appPrint(_,_,_,0) = ppsay "#"
467 :     | appPrint(APPexp(rator,rand),l,r,d) =
468 :     (case stripMark rator
469 :     of CONexp(DATACON{name,...},_) =>
470 :     fixitypp([name],rand,l,r,d)
471 :     | VARexp(v,_) =>
472 :     let val path =
473 :     case !v
474 :     of VALvar{path=SymPath.SPATH p,...} => p
475 :     | OVLDvar{name,...} => [name]
476 :     | ERRORvar => [S.varSymbol "<errorvar>"]
477 :     in fixitypp(path,rand,l,r,d)
478 :     end
479 :     | rator =>
480 : macqueen 1344 (openStyleBox INCONSISTENT ppstrm (PP.Rel 2);
481 :     ppExp'(rator,true,d-1); break ppstrm {nsp=1,offset=2};
482 : blume 902 ppExp'(rand,true,d-1);
483 : macqueen 1344 closeBox ppstrm))
484 : blume 902 | appPrint(MARKexp(exp,(s,e)),l,r,d) =
485 :     (case source_opt
486 :     of SOME source =>
487 :     if !internals
488 :     then (ppsay "<MARK(";
489 :     prpos(ppstrm,source,s); ppsay ",";
490 :     prpos(ppstrm,source,e); ppsay "): ";
491 :     ppExp'(exp,false,d); ppsay ">")
492 :     else appPrint(exp,l,r,d)
493 :     | NONE => appPrint(exp,l,r,d))
494 :     | appPrint (e,_,_,d) = ppExp'(e,true,d)
495 :     in appPrint arg
496 :     end
497 :     in (fn (exp,depth) => ppExp'(exp,false,depth))
498 :     end
499 :    
500 :     and ppRule (context as (env,source_opt)) ppstrm (RULE(pat,exp),d) =
501 :     if d>0
502 : macqueen 1344 then (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
503 : blume 902 ppPat env ppstrm (pat,d-1);
504 : macqueen 1344 PP.string ppstrm " =>"; break ppstrm {nsp=1,offset=2};
505 : blume 902 ppExp context ppstrm (exp,d-1);
506 : macqueen 1344 closeBox ppstrm)
507 :     else PP.string ppstrm "<rule>"
508 : blume 902
509 :     and ppVB (context as (env,source_opt)) ppstrm (VB{pat,exp,...},d) =
510 :     if d>0
511 : macqueen 1344 then (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
512 :     ppPat env ppstrm (pat,d-1); PP.string ppstrm " =";
513 :     break ppstrm {nsp=1,offset=2}; ppExp context ppstrm (exp,d-1);
514 :     closeBox ppstrm)
515 :     else PP.string ppstrm "<binding>"
516 : blume 902
517 :     and ppRVB context ppstrm (RVB{var, exp, ...},d) =
518 :     if d>0
519 : macqueen 1344 then (openStyleBox INCONSISTENT ppstrm (PP.Rel 0);
520 :     ppVar ppstrm var; PP.string ppstrm " =";
521 :     break ppstrm {nsp=1,offset=2}; ppExp context ppstrm (exp,d-1);
522 :     closeBox ppstrm)
523 :     else PP.string ppstrm "<rec binding>"
524 : blume 902
525 :     and ppDec (context as (env,source_opt)) ppstrm =
526 : macqueen 1344 let val ppsay = PP.string ppstrm
527 : blume 902
528 :     fun ppDec'(_,0) = ppsay "<dec>"
529 :     | ppDec'(VALdec vbs,d) =
530 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
531 : blume 902 ppvlist ppstrm ("val ","and ",
532 :     (fn ppstrm => fn vb => ppVB context ppstrm (vb,d-1)),vbs);
533 : macqueen 1344 closeBox ppstrm)
534 : blume 902 | ppDec'(VALRECdec rvbs,d) =
535 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
536 : blume 902 ppvlist ppstrm ("val rec ","and ",
537 :     (fn ppstrm => fn rvb => ppRVB context ppstrm (rvb,d-1)),rvbs);
538 : macqueen 1344 closeBox ppstrm)
539 : blume 902 | ppDec'(TYPEdec tycs,d) = let
540 :     fun f ppstrm (DEFtyc{path, tyfun=TYFUN{arity,body},...}) =
541 :     (case arity
542 :     of 0 => ()
543 :     | 1 => (ppsay "'a ")
544 : macqueen 1344 | n => (ppTuple ppstrm PP.string (typeFormals n);
545 : blume 902 ppsay " ");
546 :     ppSym ppstrm (InvPath.last path);
547 :     ppsay " = "; ppType env ppstrm body)
548 :     | f _ _ = bug "ppDec'(TYPEdec)"
549 :     in
550 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
551 : blume 902 ppvlist ppstrm ("type "," and ", f, tycs);
552 : macqueen 1344 closeBox ppstrm
553 : blume 902 end
554 :     | ppDec'(DATATYPEdec{datatycs,withtycs},d) = let
555 :     fun ppDATA ppstrm (GENtyc { path, arity, kind, ... }) =
556 :     (case kind of
557 :     DATATYPE(_) =>
558 :     (case arity
559 :     of 0 => ()
560 :     | 1 => (ppsay "'a ")
561 : macqueen 1344 | n => (ppTuple ppstrm PP.string (typeFormals n);
562 : blume 902 ppsay " ");
563 :     ppSym ppstrm (InvPath.last path); ppsay " = ..."(*;
564 :     ppSequence ppstrm
565 : macqueen 1344 {sep=(fn ppstrm => (PP.string ppstrm " |";
566 :     break ppstrm {nsp=1,offset=0})),
567 : blume 902 pr=(fn ppstrm => fn (DATACON{name,...}) =>
568 :     ppSym ppstrm name),
569 :     style=INCONSISTENT}
570 :     dcons*))
571 :     | _ => bug "ppDec'(DATATYPEdec) 1.1")
572 :     | ppDATA _ _ = bug "ppDec'(DATATYPEdec) 1.2"
573 :     fun ppWITH ppstrm (DEFtyc{path, tyfun=TYFUN{arity,body},...}) =
574 :     (case arity
575 :     of 0 => ()
576 :     | 1 => (ppsay "'a ")
577 : macqueen 1344 | n => (ppTuple ppstrm PP.string (typeFormals n);
578 : blume 902 ppsay " ");
579 :     ppSym ppstrm (InvPath.last path);
580 :     ppsay " = "; ppType env ppstrm body)
581 :     | ppWITH _ _ = bug "ppDec'(DATATYPEdec) 2"
582 :     in
583 :     (* could call PPDec.ppDec here *)
584 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
585 : blume 902 ppvlist ppstrm ("datatype ","and ", ppDATA, datatycs);
586 : macqueen 1344 newline ppstrm;
587 : blume 902 ppvlist ppstrm ("withtype ","and ", ppWITH, withtycs);
588 : macqueen 1344 closeBox ppstrm
589 : blume 902 end
590 :     | ppDec'(ABSTYPEdec _,d) = ppsay "abstype"
591 :    
592 :     | ppDec'(EXCEPTIONdec ebs,d) = let
593 :     fun f ppstrm (EBgen{exn=DATACON{name,...},etype,...}) =
594 :     (ppSym ppstrm name;
595 :     case etype
596 :     of NONE => ()
597 :     | SOME ty' => (ppsay " of "; ppType env ppstrm ty'))
598 :     | f ppstrm (EBdef{exn=DATACON{name,...},
599 :     edef=DATACON{name=dname,...}}) =
600 :     (ppSym ppstrm name; ppsay "="; ppSym ppstrm dname)
601 :     in
602 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
603 : blume 902 ppvlist ppstrm ("exception ","and ", f, ebs);
604 : macqueen 1344 closeBox ppstrm
605 : blume 902 end
606 :     | ppDec'(STRdec sbs,d) = let
607 :     fun f ppstrm (STRB{name, str=M.STR { access, ... }, def}) =
608 :     (ppSym ppstrm name;
609 :     ppAccess ppstrm access;
610 :     ppsay " = ";
611 : macqueen 1344 break ppstrm {nsp=1,offset=2};
612 : blume 902 ppStrexp context ppstrm (def,d-1))
613 :     | f _ _ = bug "ppDec:STRdec:STRB"
614 :     in
615 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
616 : blume 902 ppvlist ppstrm ("structure ","and ", f, sbs);
617 : macqueen 1344 closeBox ppstrm
618 : blume 902 end
619 :     | ppDec'(ABSdec sbs,d) = let
620 :     fun f ppstrm (STRB{name, str=M.STR { access, ... }, def}) =
621 :     (ppSym ppstrm name;
622 :     ppAccess ppstrm access;
623 :     ppsay " = ";
624 : macqueen 1344 break ppstrm {nsp=1,offset=2};
625 : blume 902 ppStrexp context ppstrm (def,d-1))
626 :     | f _ _ = bug "ppDec':ABSdec"
627 :     in
628 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
629 : blume 902 ppvlist ppstrm ("abstraction ","and ", f, sbs);
630 : macqueen 1344 closeBox ppstrm
631 : blume 902 end
632 :     | ppDec'(FCTdec fbs,d) = let
633 :     fun f ppstrm (FCTB{name=fname, fct=M.FCT { access, ... }, def}) =
634 :     (ppSym ppstrm fname;
635 :     ppAccess ppstrm access;
636 :     ppsay " = ";
637 : macqueen 1344 break ppstrm {nsp=1,offset= 2};
638 : blume 902 ppFctexp context ppstrm (def,d-1))
639 :     | f _ _ = bug "ppDec':FCTdec"
640 :     in
641 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
642 : blume 902 ppvlist ppstrm ("functor ","and ", f, fbs);
643 : macqueen 1344 closeBox ppstrm
644 : blume 902 end
645 :     | ppDec'(SIGdec sigvars,d) = let
646 :     fun f ppstrm (M.SIG { name, ... }) =
647 :     (ppsay "signature ";
648 :     case name of
649 :     SOME s => ppSym ppstrm s
650 :     | NONE => ppsay "ANONYMOUS")
651 :     | f _ _ = bug "ppDec':SIGdec"
652 :     in
653 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
654 :     ppSequence ppstrm {sep=newline, pr=f,
655 : blume 902 style=CONSISTENT} sigvars;
656 : macqueen 1344 closeBox ppstrm
657 : blume 902 end
658 :     | ppDec'(FSIGdec sigvars,d) = let
659 :     fun f ppstrm (M.FSIG{kind, ...}) =
660 :     (ppsay "funsig ";
661 :     case kind of SOME s => ppSym ppstrm s
662 :     | NONE => ppsay "ANONYMOUS")
663 :     | f _ _ = bug "ppDec':FSIGdec"
664 :     in
665 : macqueen 1344 openStyleBox CONSISTENT ppstrm (PP.Rel 0);
666 : blume 902 ppSequence ppstrm
667 : macqueen 1344 {sep=newline, pr = f, style = CONSISTENT} sigvars;
668 :     closeBox ppstrm
669 : blume 902 end
670 :     | ppDec'(LOCALdec(inner,outer),d) =
671 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
672 : blume 902 ppsay "local"; nl_indent ppstrm 2;
673 : macqueen 1344 ppDec'(inner,d-1); newline ppstrm;
674 : blume 902 ppsay "in ";
675 : macqueen 1344 ppDec'(outer,d-1); newline ppstrm;
676 : blume 902 ppsay "end";
677 : macqueen 1344 closeBox ppstrm)
678 : blume 902 | ppDec'(SEQdec decs,d) =
679 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
680 : blume 902 ppSequence ppstrm
681 : macqueen 1344 {sep=newline,
682 : blume 902 pr=(fn ppstrm => fn dec => ppDec'(dec,d)),
683 :     style=CONSISTENT}
684 :     decs;
685 : macqueen 1344 closeBox ppstrm)
686 : blume 902 | ppDec'(FIXdec {fixity,ops},d) =
687 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
688 : blume 902 case fixity
689 :     of NONfix => ppsay "nonfix "
690 :     | INfix (i,_) =>
691 :     (if i mod 2 = 0 then
692 :     ppsay "infix "
693 :     else ppsay "infixr ";
694 :     if i div 2 > 0 then
695 :     (ppsay(Int.toString(i div 2));
696 :     ppsay " ")
697 :     else ());
698 :     ppSequence ppstrm
699 : macqueen 1344 {sep=(fn ppstrm => break ppstrm {nsp=1,offset=0}),
700 : blume 902 pr=ppSym,style=INCONSISTENT}
701 :     ops;
702 : macqueen 1344 closeBox ppstrm)
703 : blume 902
704 :     | ppDec'(OVLDdec ovldvar,d) =
705 :     (ppsay "overload "; ppVar ppstrm ovldvar)
706 :    
707 :     | ppDec'(OPENdec strbs,d) =
708 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
709 : blume 902 ppsay "open ";
710 :     ppSequence ppstrm
711 : macqueen 1344 {sep=(fn ppstrm => break ppstrm {nsp=1,offset=0}),
712 : blume 902 pr=(fn ppstrm => fn (sp,_) =>
713 :     ppsay (SymPath.toString sp)),
714 :     style=INCONSISTENT}
715 :     strbs;
716 : macqueen 1344 closeBox ppstrm)
717 : blume 902
718 :     | ppDec'(MARKdec(dec,(s,e)),d) =
719 :     (case source_opt
720 :     of SOME source =>
721 :     (ppsay "MARKdec(";
722 :     ppDec'(dec,d); ppsay ",";
723 :     prpos(ppstrm,source,s); ppsay ",";
724 :     prpos(ppstrm,source,e); ppsay ")")
725 :    
726 :     | NONE => ppDec'(dec,d))
727 :    
728 :     in ppDec'
729 :     end
730 :    
731 :     and ppStrexp (context as (_,source_opt)) ppstrm =
732 : macqueen 1344 let val ppsay = PP.string ppstrm
733 : blume 902 fun ppStrexp'(_,0) = ppsay "<strexp>"
734 :    
735 :     | ppStrexp'(VARstr (M.STR { access, ... }), d) = ppAccess ppstrm access
736 :    
737 :     | ppStrexp'(APPstr{oper=M.FCT { access = fa, ... },
738 :     arg=M.STR { access = sa, ... }, ...}, d) =
739 :     (ppAccess ppstrm fa; ppsay"("; ppAccess ppstrm sa; ppsay")")
740 :     | ppStrexp'(STRstr bindings, d) =
741 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
742 : blume 902 ppsay "struct"; nl_indent ppstrm 2;
743 :     ppsay "...";
744 :     (* ppBinding not yet undefined *)
745 :     (*
746 :     ppSequence ppstrm
747 : macqueen 1344 {sep=newline,
748 : blume 902 pr=(fn ppstrm => fn b => ppBinding context ppstrm (b,d-1)),
749 :     style=CONSISTENT}
750 :     bindings;
751 :     *)
752 :     ppsay "end";
753 : macqueen 1344 closeBox ppstrm)
754 : blume 902 | ppStrexp'(LETstr(dec,body),d) =
755 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
756 : blume 902 ppsay "let "; ppDec context ppstrm (dec,d-1);
757 : macqueen 1344 newline ppstrm;
758 :     ppsay " in "; ppStrexp'(body,d-1); newline ppstrm;
759 : blume 902 ppsay "end";
760 : macqueen 1344 closeBox ppstrm)
761 : blume 902 | ppStrexp'(MARKstr(body,(s,e)),d) =
762 :     (case source_opt
763 :     of SOME source =>
764 :     (ppsay "MARKstr(";
765 :     ppStrexp'(body,d); ppsay ",";
766 :     prpos(ppstrm,source,s); ppsay ",";
767 :     prpos(ppstrm,source,e); ppsay ")")
768 :     | NONE => ppStrexp'(body,d))
769 :    
770 :     | ppStrexp' _ = bug "unexpected structure expression in ppStrexp'"
771 :    
772 :     in ppStrexp'
773 :     end
774 :    
775 :     and ppFctexp (context as (_,source_opt)) ppstrm =
776 : macqueen 1344 let val ppsay = PP.string ppstrm
777 : blume 902
778 :     fun ppFctexp'(_, 0) = ppsay "<fctexp>"
779 :     | ppFctexp'(VARfct (M.FCT { access, ... }), d) = ppAccess ppstrm access
780 :    
781 :     | ppFctexp'(FCTfct{param=M.STR { access, ... }, def, ...}, d) =
782 :     (ppsay " FCT(";
783 :     ppAccess ppstrm access;
784 : macqueen 1344 ppsay ") => "; newline ppstrm;
785 : blume 902 ppStrexp context ppstrm (def,d-1))
786 :    
787 :     | ppFctexp'(LETfct(dec,body),d) =
788 : macqueen 1344 (openStyleBox CONSISTENT ppstrm (PP.Rel 0);
789 : blume 902 ppsay "let "; ppDec context ppstrm (dec,d-1);
790 : macqueen 1344 newline ppstrm;
791 :     ppsay " in "; ppFctexp'(body,d-1); newline ppstrm;
792 : blume 902 ppsay "end";
793 : macqueen 1344 closeBox ppstrm)
794 : blume 902
795 :     | ppFctexp'(MARKfct(body,(s,e)),d) =
796 :     (case source_opt
797 :     of SOME source =>
798 :     (ppsay "MARKfct(";
799 :     ppFctexp'(body,d); ppsay ",";
800 :     prpos(ppstrm,source,s); ppsay ",";
801 :     prpos(ppstrm,source,e); ppsay ")")
802 :     | NONE => ppFctexp'(body,d))
803 :    
804 :     | ppFctexp' _ = bug "unexpected functor expression in ppFctexp'"
805 :    
806 :     in ppFctexp'
807 :     end
808 :    
809 :     end (* top-level local *)
810 :     end (* structure PPAbsyn *)

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