adamc@1
|
1 (* Copyright (c) 2008, Adam Chlipala
|
adamc@1
|
2 * All rights reserved.
|
adamc@1
|
3 *
|
adamc@1
|
4 * Redistribution and use in source and binary forms, with or without
|
adamc@1
|
5 * modification, are permitted provided that the following conditions are met:
|
adamc@1
|
6 *
|
adamc@1
|
7 * - Redistributions of source code must retain the above copyright notice,
|
adamc@1
|
8 * this list of conditions and the following disclaimer.
|
adamc@1
|
9 * - Redistributions in binary form must reproduce the above copyright notice,
|
adamc@1
|
10 * this list of conditions and the following disclaimer in the documentation
|
adamc@1
|
11 * and/or other materials provided with the distribution.
|
adamc@1
|
12 * - The names of contributors may not be used to endorse or promote products
|
adamc@1
|
13 * derived from this software without specific prior written permission.
|
adamc@1
|
14 *
|
adamc@1
|
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
adamc@1
|
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
adamc@1
|
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
adamc@1
|
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
adamc@1
|
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
adamc@1
|
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
adamc@1
|
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
adamc@1
|
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
adamc@1
|
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
adamc@1
|
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
adamc@1
|
25 * POSSIBILITY OF SUCH DAMAGE.
|
adamc@1
|
26 *)
|
adamc@1
|
27
|
adamc@244
|
28 (* Pretty-printing Ur/Web *)
|
adamc@1
|
29
|
adamc@4
|
30 structure SourcePrint :> SOURCE_PRINT = struct
|
adamc@1
|
31
|
adamc@1
|
32 open Print.PD
|
adamc@1
|
33 open Print
|
adamc@1
|
34
|
adamc@4
|
35 open Source
|
adamc@1
|
36
|
adamc@1
|
37 fun p_kind' par (k, _) =
|
adamc@1
|
38 case k of
|
adamc@1
|
39 KType => string "Type"
|
adamc@1
|
40 | KArrow (k1, k2) => parenIf par (box [p_kind' true k1,
|
adamc@1
|
41 space,
|
adamc@1
|
42 string "->",
|
adamc@1
|
43 space,
|
adamc@1
|
44 p_kind k2])
|
adamc@1
|
45 | KName => string "Name"
|
adamc@1
|
46 | KRecord k => box [string "{", p_kind k, string "}"]
|
adamc@82
|
47 | KUnit => string "Unit"
|
adamc@18
|
48 | KWild => string "_"
|
adamc@207
|
49 | KTuple ks => box [string "(",
|
adamc@207
|
50 p_list_sep (box [space, string "*", space]) p_kind ks,
|
adamc@207
|
51 string ")"]
|
adamc@1
|
52
|
adamc@623
|
53 | KVar x => string x
|
adamc@623
|
54 | KFun (x, k) => box [string x,
|
adamc@623
|
55 space,
|
adamc@623
|
56 string "-->",
|
adamc@623
|
57 space,
|
adamc@623
|
58 p_kind k]
|
adamc@623
|
59
|
adamc@1
|
60 and p_kind k = p_kind' false k
|
adamc@1
|
61
|
adamc@1
|
62 fun p_explicitness e =
|
adamc@1
|
63 case e of
|
adamc@1
|
64 Explicit => string "::"
|
adamc@1
|
65 | Implicit => string ":::"
|
adamc@1
|
66
|
adamc@1
|
67 fun p_con' par (c, _) =
|
adamc@1
|
68 case c of
|
adamc@1
|
69 CAnnot (c, k) => box [string "(",
|
adamc@1
|
70 p_con c,
|
adamc@1
|
71 space,
|
adamc@1
|
72 string "::",
|
adamc@1
|
73 space,
|
adamc@1
|
74 p_kind k,
|
adamc@1
|
75 string ")"]
|
adamc@1
|
76
|
adamc@1
|
77 | TFun (t1, t2) => parenIf par (box [p_con' true t1,
|
adamc@1
|
78 space,
|
adamc@1
|
79 string "->",
|
adamc@1
|
80 space,
|
adamc@1
|
81 p_con t2])
|
adamc@1
|
82 | TCFun (e, x, k, c) => parenIf par (box [string x,
|
adamc@1
|
83 space,
|
adamc@1
|
84 p_explicitness e,
|
adamc@1
|
85 space,
|
adamc@1
|
86 p_kind k,
|
adamc@1
|
87 space,
|
adamc@1
|
88 string "->",
|
adamc@1
|
89 space,
|
adamc@1
|
90 p_con c])
|
adamc@1
|
91 | TRecord (CRecord xcs, _) => box [string "{",
|
adamc@1
|
92 p_list (fn (x, c) =>
|
adamc@20
|
93 box [p_name x,
|
adamc@1
|
94 space,
|
adamc@1
|
95 string ":",
|
adamc@1
|
96 space,
|
adamc@1
|
97 p_con c]) xcs,
|
adamc@1
|
98 string "}"]
|
adamc@1
|
99 | TRecord c => box [string "$",
|
adamc@1
|
100 p_con' true c]
|
adamc@628
|
101 | TDisjoint (c1, c2, c3) => parenIf par (box [string "[",
|
adamc@628
|
102 p_con c1,
|
adamc@628
|
103 space,
|
adamc@628
|
104 string "~",
|
adamc@628
|
105 space,
|
adamc@628
|
106 p_con c2,
|
adamc@628
|
107 string "]",
|
adamc@628
|
108 space,
|
adamc@628
|
109 string "=>",
|
adamc@628
|
110 space,
|
adamc@628
|
111 p_con c3])
|
adamc@1
|
112
|
adamc@34
|
113 | CVar (ss, s) => p_list_sep (string ".") string (ss @ [s])
|
adamc@1
|
114 | CApp (c1, c2) => parenIf par (box [p_con c1,
|
adamc@1
|
115 space,
|
adamc@1
|
116 p_con' true c2])
|
adamc@67
|
117 | CAbs (x, NONE, c) => parenIf par (box [string "fn",
|
adamc@67
|
118 space,
|
adamc@67
|
119 string x,
|
adamc@67
|
120 space,
|
adamc@67
|
121 string "=>",
|
adamc@67
|
122 space,
|
adamc@67
|
123 p_con c])
|
adamc@67
|
124 | CAbs (x, SOME k, c) => parenIf par (box [string "fn",
|
adamc@67
|
125 space,
|
adamc@67
|
126 string x,
|
adamc@67
|
127 space,
|
adamc@67
|
128 string "::",
|
adamc@67
|
129 space,
|
adamc@67
|
130 p_kind k,
|
adamc@67
|
131 space,
|
adamc@67
|
132 string "=>",
|
adamc@67
|
133 space,
|
adamc@67
|
134 p_con c])
|
adamc@628
|
135
|
adamc@1
|
136
|
adamc@1
|
137 | CName s => box [string "#", string s]
|
adamc@1
|
138
|
adamc@1
|
139 | CRecord xcs => box [string "[",
|
adamc@1
|
140 p_list (fn (x, c) =>
|
adamc@1
|
141 box [p_con x,
|
adamc@1
|
142 space,
|
adamc@1
|
143 string "=",
|
adamc@1
|
144 space,
|
adamc@1
|
145 p_con c]) xcs,
|
adamc@1
|
146 string "]"]
|
adamc@1
|
147 | CConcat (c1, c2) => parenIf par (box [p_con' true c1,
|
adamc@1
|
148 space,
|
adamc@1
|
149 string "++",
|
adamc@1
|
150 space,
|
adamc@1
|
151 p_con c2])
|
adamc@621
|
152 | CMap => string "map"
|
adamc@82
|
153
|
adamc@82
|
154 | CUnit => string "()"
|
adamc@82
|
155
|
adamc@18
|
156 | CWild k => box [string "(_",
|
adamc@18
|
157 space,
|
adamc@18
|
158 string "::",
|
adamc@18
|
159 space,
|
adamc@223
|
160 p_kind k,
|
adamc@223
|
161 string ")"]
|
adamc@207
|
162
|
adamc@207
|
163 | CTuple cs => box [string "(",
|
adamc@207
|
164 p_list p_con cs,
|
adamc@207
|
165 string ")"]
|
adamc@207
|
166 | CProj (c, n) => box [p_con c,
|
adamc@207
|
167 string ".",
|
adamc@207
|
168 string (Int.toString n)]
|
adamc@623
|
169
|
adamc@623
|
170 | CKAbs (x, c) => box [string x,
|
adamc@623
|
171 space,
|
adamc@623
|
172 string "==>",
|
adamc@623
|
173 space,
|
adamc@623
|
174 p_con c]
|
adamc@623
|
175 | TKFun (x, c) => box [string x,
|
adamc@623
|
176 space,
|
adamc@623
|
177 string "-->",
|
adamc@623
|
178 space,
|
adamc@623
|
179 p_con c]
|
adamc@1
|
180
|
adamc@1
|
181 and p_con c = p_con' false c
|
adamc@1
|
182
|
adamc@20
|
183 and p_name (all as (c, _)) =
|
adamc@20
|
184 case c of
|
adamc@20
|
185 CName s => string s
|
adamc@20
|
186 | _ => p_con all
|
adamc@20
|
187
|
adamc@170
|
188 fun p_pat' par (p, _) =
|
adamc@170
|
189 case p of
|
adamc@170
|
190 PWild => string "_"
|
adamc@170
|
191 | PVar s => string s
|
adamc@173
|
192 | PPrim p => Prim.p_t p
|
adamc@170
|
193 | PCon (ms, x, NONE) => p_list_sep (string ".") string (ms @ [x])
|
adamc@170
|
194 | PCon (ms, x, SOME p) => parenIf par (box [p_list_sep (string ".") string (ms @ [x]),
|
adamc@170
|
195 space,
|
adamc@170
|
196 p_pat' true p])
|
adamc@174
|
197 | PRecord (xps, flex) =>
|
adamc@174
|
198 let
|
adamc@175
|
199 val pps = map (fn (x, p) => box [string x, space, string "=", space, p_pat p]) xps
|
adamc@174
|
200 in
|
adamc@174
|
201 box [string "{",
|
adamc@174
|
202 p_list_sep (box [string ",", space]) (fn x => x)
|
adamc@174
|
203 (if flex then
|
adamc@175
|
204 pps @ [string "..."]
|
adamc@174
|
205 else
|
adamc@175
|
206 pps),
|
adamc@174
|
207 string "}"]
|
adamc@174
|
208 end
|
adamc@170
|
209
|
adamc@174
|
210 and p_pat x = p_pat' false x
|
adamc@170
|
211
|
adamc@8
|
212 fun p_exp' par (e, _) =
|
adamc@8
|
213 case e of
|
adamc@8
|
214 EAnnot (e, t) => box [string "(",
|
adamc@8
|
215 p_exp e,
|
adamc@8
|
216 space,
|
adamc@8
|
217 string ":",
|
adamc@8
|
218 space,
|
adamc@8
|
219 p_con t,
|
adamc@8
|
220 string ")"]
|
adamc@8
|
221
|
adamc@14
|
222 | EPrim p => Prim.p_t p
|
adamc@403
|
223 | EVar (ss, s, _) => p_list_sep (string ".") string (ss @ [s])
|
adamc@8
|
224 | EApp (e1, e2) => parenIf par (box [p_exp e1,
|
adamc@8
|
225 space,
|
adamc@8
|
226 p_exp' true e2])
|
adamc@8
|
227 | EAbs (x, NONE, e) => parenIf par (box [string "fn",
|
adamc@8
|
228 space,
|
adamc@8
|
229 string x,
|
adamc@8
|
230 space,
|
adamc@8
|
231 string "=>",
|
adamc@8
|
232 space,
|
adamc@8
|
233 p_exp e])
|
adamc@8
|
234 | EAbs (x, SOME t, e) => parenIf par (box [string "fn",
|
adamc@8
|
235 space,
|
adamc@8
|
236 string x,
|
adamc@8
|
237 space,
|
adamc@8
|
238 string ":",
|
adamc@8
|
239 space,
|
adamc@8
|
240 p_con t,
|
adamc@8
|
241 space,
|
adamc@8
|
242 string "=>",
|
adamc@8
|
243 space,
|
adamc@8
|
244 p_exp e])
|
adamc@8
|
245 | ECApp (e, c) => parenIf par (box [p_exp e,
|
adamc@8
|
246 space,
|
adamc@8
|
247 string "[",
|
adamc@8
|
248 p_con c,
|
adamc@8
|
249 string "]"])
|
adamc@8
|
250 | ECAbs (exp, x, k, e) => parenIf par (box [string "fn",
|
adamc@8
|
251 space,
|
adamc@8
|
252 string x,
|
adamc@8
|
253 space,
|
adamc@8
|
254 p_explicitness exp,
|
adamc@8
|
255 space,
|
adamc@8
|
256 p_kind k,
|
adamc@8
|
257 space,
|
adamc@8
|
258 string "=>",
|
adamc@8
|
259 space,
|
adamc@8
|
260 p_exp e])
|
adamc@85
|
261 | EDisjoint (c1, c2, e) => parenIf par (box [p_con c1,
|
adamc@85
|
262 space,
|
adamc@85
|
263 string "~",
|
adamc@85
|
264 space,
|
adamc@85
|
265 p_con c2,
|
adamc@85
|
266 space,
|
adamc@85
|
267 string "=>",
|
adamc@85
|
268 space,
|
adamc@85
|
269 p_exp e])
|
adamc@629
|
270 | EDisjointApp e => parenIf par (box [p_exp e,
|
adamc@629
|
271 space,
|
adamc@629
|
272 string "!"])
|
adamc@8
|
273
|
adamc@12
|
274 | ERecord xes => box [string "{",
|
adamc@12
|
275 p_list (fn (x, e) =>
|
adamc@21
|
276 box [p_name x,
|
adamc@12
|
277 space,
|
adamc@12
|
278 string "=",
|
adamc@12
|
279 space,
|
adamc@12
|
280 p_exp e]) xes,
|
adamc@12
|
281 string "}"]
|
adamc@12
|
282 | EField (e, c) => box [p_exp' true e,
|
adamc@12
|
283 string ".",
|
adamc@12
|
284 p_con' true c]
|
adamc@445
|
285 | EConcat (e1, e2) => parenIf par (box [p_exp' true e1,
|
adamc@445
|
286 space,
|
adamc@445
|
287 string "++",
|
adamc@445
|
288 space,
|
adamc@445
|
289 p_exp' true e2])
|
adamc@149
|
290 | ECut (e, c) => parenIf par (box [p_exp' true e,
|
adamc@149
|
291 space,
|
adamc@149
|
292 string "--",
|
adamc@149
|
293 space,
|
adamc@149
|
294 p_con' true c])
|
adamc@493
|
295 | ECutMulti (e, c) => parenIf par (box [p_exp' true e,
|
adamc@493
|
296 space,
|
adamc@493
|
297 string "---",
|
adamc@493
|
298 space,
|
adamc@493
|
299 p_con' true c])
|
adamc@170
|
300 | ECase (e, pes) => parenIf par (box [string "case",
|
adamc@170
|
301 space,
|
adamc@171
|
302 p_exp e,
|
adamc@170
|
303 space,
|
adamc@170
|
304 string "of",
|
adamc@170
|
305 space,
|
adamc@170
|
306 p_list_sep (box [space, string "|", space])
|
adamc@170
|
307 (fn (p, e) => box [p_pat p,
|
adamc@170
|
308 space,
|
adamc@170
|
309 string "=>",
|
adamc@170
|
310 space,
|
adamc@170
|
311 p_exp e]) pes])
|
adamc@170
|
312
|
adamc@219
|
313 | EWild => string "_"
|
adamc@210
|
314
|
adamc@446
|
315 | ELet (ds, e) => box [string "let",
|
adamc@446
|
316 newline,
|
adamc@446
|
317 box [p_list_sep newline p_edecl ds],
|
adamc@446
|
318 newline,
|
adamc@446
|
319 string "in",
|
adamc@446
|
320 newline,
|
adamc@446
|
321 box [p_exp e],
|
adamc@446
|
322 newline,
|
adamc@446
|
323 string "end"]
|
adamc@446
|
324
|
adamc@623
|
325 | EKAbs (x, e) => box [string x,
|
adamc@623
|
326 space,
|
adamc@623
|
327 string "-->",
|
adamc@623
|
328 space,
|
adamc@623
|
329 p_exp e]
|
adamc@623
|
330
|
adamc@8
|
331 and p_exp e = p_exp' false e
|
adamc@8
|
332
|
adamc@446
|
333 and p_edecl (d, _) =
|
adamc@446
|
334 case d of
|
adamc@446
|
335 EDVal vi => box [string "val",
|
adamc@446
|
336 space,
|
adamc@446
|
337 p_vali vi]
|
adamc@446
|
338 | EDValRec vis => box [string "val",
|
adamc@446
|
339 space,
|
adamc@446
|
340 string "rec",
|
adamc@446
|
341 space,
|
adamc@446
|
342 p_list_sep (box [newline, string "and", space]) p_vali vis]
|
adamc@446
|
343
|
adamc@446
|
344 and p_vali (x, co, e) =
|
adamc@446
|
345 case co of
|
adamc@446
|
346 NONE => box [string x,
|
adamc@446
|
347 space,
|
adamc@446
|
348 string "=",
|
adamc@446
|
349 space,
|
adamc@446
|
350 p_exp e]
|
adamc@446
|
351 | SOME t => box [string x,
|
adamc@446
|
352 space,
|
adamc@446
|
353 string ":",
|
adamc@446
|
354 space,
|
adamc@446
|
355 p_con t,
|
adamc@446
|
356 space,
|
adamc@446
|
357 string "=",
|
adamc@446
|
358 space,
|
adamc@446
|
359 p_exp e]
|
adamc@446
|
360
|
adamc@446
|
361
|
adamc@191
|
362 fun p_datatype (x, xs, cons) =
|
adamc@156
|
363 box [string "datatype",
|
adamc@156
|
364 space,
|
adamc@156
|
365 string x,
|
adamc@191
|
366 p_list_sep (box []) (fn x => box [space, string x]) xs,
|
adamc@156
|
367 space,
|
adamc@156
|
368 string "=",
|
adamc@156
|
369 space,
|
adamc@156
|
370 p_list_sep (box [space, string "|", space])
|
adamc@156
|
371 (fn (x, NONE) => string x
|
adamc@156
|
372 | (x, SOME t) => box [string x, space, string "of", space, p_con t])
|
adamc@156
|
373 cons]
|
adamc@156
|
374
|
adamc@30
|
375 fun p_sgn_item (sgi, _) =
|
adamc@30
|
376 case sgi of
|
adamc@30
|
377 SgiConAbs (x, k) => box [string "con",
|
adamc@30
|
378 space,
|
adamc@30
|
379 string x,
|
adamc@30
|
380 space,
|
adamc@30
|
381 string "::",
|
adamc@30
|
382 space,
|
adamc@30
|
383 p_kind k]
|
adamc@30
|
384 | SgiCon (x, NONE, c) => box [string "con",
|
adamc@30
|
385 space,
|
adamc@30
|
386 string x,
|
adamc@30
|
387 space,
|
adamc@30
|
388 string "=",
|
adamc@30
|
389 space,
|
adamc@30
|
390 p_con c]
|
adamc@30
|
391 | SgiCon (x, SOME k, c) => box [string "con",
|
adamc@30
|
392 space,
|
adamc@30
|
393 string x,
|
adamc@30
|
394 space,
|
adamc@30
|
395 string "::",
|
adamc@30
|
396 space,
|
adamc@30
|
397 p_kind k,
|
adamc@30
|
398 space,
|
adamc@30
|
399 string "=",
|
adamc@30
|
400 space,
|
adamc@30
|
401 p_con c]
|
adamc@156
|
402 | SgiDatatype x => p_datatype x
|
adamc@156
|
403 | SgiDatatypeImp (x, ms, x') =>
|
adamc@156
|
404 box [string "datatype",
|
adamc@156
|
405 space,
|
adamc@156
|
406 string x,
|
adamc@156
|
407 space,
|
adamc@156
|
408 string "=",
|
adamc@156
|
409 space,
|
adamc@156
|
410 string "datatype",
|
adamc@156
|
411 space,
|
adamc@156
|
412 p_list_sep (string ".") string (ms @ [x'])]
|
adamc@30
|
413 | SgiVal (x, c) => box [string "val",
|
adamc@30
|
414 space,
|
adamc@30
|
415 string x,
|
adamc@30
|
416 space,
|
adamc@30
|
417 string ":",
|
adamc@30
|
418 space,
|
adamc@30
|
419 p_con c]
|
adamc@707
|
420 | SgiTable (x, c, pe, ce) => box [string "table",
|
adamc@707
|
421 space,
|
adamc@707
|
422 string x,
|
adamc@707
|
423 space,
|
adamc@707
|
424 string ":",
|
adamc@707
|
425 space,
|
adamc@707
|
426 p_con c,
|
adamc@707
|
427 space,
|
adamc@707
|
428 string "keys",
|
adamc@707
|
429 space,
|
adamc@707
|
430 p_exp pe,
|
adamc@707
|
431 space,
|
adamc@707
|
432 string "constraints",
|
adamc@707
|
433 space,
|
adamc@707
|
434 p_exp ce]
|
adamc@30
|
435 | SgiStr (x, sgn) => box [string "structure",
|
adamc@30
|
436 space,
|
adamc@30
|
437 string x,
|
adamc@30
|
438 space,
|
adamc@30
|
439 string ":",
|
adamc@30
|
440 space,
|
adamc@30
|
441 p_sgn sgn]
|
adamc@59
|
442 | SgiSgn (x, sgn) => box [string "signature",
|
adamc@59
|
443 space,
|
adamc@59
|
444 string x,
|
adamc@59
|
445 space,
|
adamc@59
|
446 string "=",
|
adamc@59
|
447 space,
|
adamc@59
|
448 p_sgn sgn]
|
adamc@58
|
449 | SgiInclude sgn => box [string "include",
|
adamc@58
|
450 space,
|
adamc@58
|
451 p_sgn sgn]
|
adamc@88
|
452 | SgiConstraint (c1, c2) => box [string "constraint",
|
adamc@88
|
453 space,
|
adamc@88
|
454 p_con c1,
|
adamc@88
|
455 space,
|
adamc@88
|
456 string "~",
|
adamc@88
|
457 space,
|
adamc@88
|
458 p_con c2]
|
adamc@563
|
459 | SgiClassAbs (x, k) => box [string "class",
|
adamc@563
|
460 space,
|
adamc@563
|
461 string x,
|
adamc@563
|
462 space,
|
adamc@563
|
463 string "::",
|
adamc@563
|
464 space,
|
adamc@563
|
465 p_kind k]
|
adamc@563
|
466 | SgiClass (x, k, c) => box [string "class",
|
adamc@563
|
467 space,
|
adamc@563
|
468 string x,
|
adamc@563
|
469 space,
|
adamc@563
|
470 string "::",
|
adamc@563
|
471 space,
|
adamc@563
|
472 p_kind k,
|
adamc@563
|
473 space,
|
adamc@563
|
474 string "=",
|
adamc@563
|
475 space,
|
adamc@563
|
476 p_con c]
|
adamc@563
|
477
|
adamc@30
|
478 and p_sgn (sgn, _) =
|
adamc@30
|
479 case sgn of
|
adamc@30
|
480 SgnConst sgis => box [string "sig",
|
adamc@30
|
481 newline,
|
adamc@30
|
482 p_list_sep newline p_sgn_item sgis,
|
adamc@30
|
483 newline,
|
adamc@30
|
484 string "end"]
|
adamc@30
|
485 | SgnVar x => string x
|
adamc@40
|
486 | SgnFun (x, sgn, sgn') => box [string "functor",
|
adamc@40
|
487 space,
|
adamc@40
|
488 string "(",
|
adamc@40
|
489 string x,
|
adamc@40
|
490 space,
|
adamc@40
|
491 string ":",
|
adamc@40
|
492 p_sgn sgn,
|
adamc@40
|
493 string ")",
|
adamc@40
|
494 space,
|
adamc@40
|
495 string ":",
|
adamc@40
|
496 space,
|
adamc@40
|
497 p_sgn sgn']
|
adamc@42
|
498 | SgnWhere (sgn, x, c) => box [p_sgn sgn,
|
adamc@42
|
499 space,
|
adamc@42
|
500 string "where",
|
adamc@42
|
501 space,
|
adamc@42
|
502 string "con",
|
adamc@42
|
503 space,
|
adamc@42
|
504 string x,
|
adamc@42
|
505 space,
|
adamc@42
|
506 string "=",
|
adamc@42
|
507 space,
|
adamc@42
|
508 p_con c]
|
adamc@59
|
509 | SgnProj (m, ms, x) => p_list_sep (string ".") string (m :: ms @ [x])
|
adamc@59
|
510
|
adamc@42
|
511
|
adamc@123
|
512
|
adamc@1
|
513 fun p_decl ((d, _) : decl) =
|
adamc@1
|
514 case d of
|
adamc@1
|
515 DCon (x, NONE, c) => box [string "con",
|
adamc@1
|
516 space,
|
adamc@1
|
517 string x,
|
adamc@1
|
518 space,
|
adamc@1
|
519 string "=",
|
adamc@1
|
520 space,
|
adamc@1
|
521 p_con c]
|
adamc@1
|
522 | DCon (x, SOME k, c) => box [string "con",
|
adamc@1
|
523 space,
|
adamc@1
|
524 string x,
|
adamc@1
|
525 space,
|
adamc@1
|
526 string "::",
|
adamc@1
|
527 space,
|
adamc@1
|
528 p_kind k,
|
adamc@1
|
529 space,
|
adamc@1
|
530 string "=",
|
adamc@1
|
531 space,
|
adamc@1
|
532 p_con c]
|
adamc@156
|
533 | DDatatype x => p_datatype x
|
adamc@156
|
534 | DDatatypeImp (x, ms, x') =>
|
adamc@156
|
535 box [string "datatype",
|
adamc@156
|
536 space,
|
adamc@156
|
537 string x,
|
adamc@156
|
538 space,
|
adamc@156
|
539 string "=",
|
adamc@156
|
540 space,
|
adamc@156
|
541 string "datatype",
|
adamc@156
|
542 space,
|
adamc@156
|
543 p_list_sep (string ".") string (ms @ [x'])]
|
adamc@123
|
544 | DVal vi => box [string "val",
|
adamc@123
|
545 space,
|
adamc@123
|
546 p_vali vi]
|
adamc@123
|
547 | DValRec vis => box [string "val",
|
adamc@123
|
548 space,
|
adamc@123
|
549 string "rec",
|
adamc@123
|
550 space,
|
adamc@123
|
551 p_list_sep (box [newline, string "and", space]) p_vali vis]
|
adamc@1
|
552
|
adamc@30
|
553 | DSgn (x, sgn) => box [string "signature",
|
adamc@30
|
554 space,
|
adamc@30
|
555 string x,
|
adamc@30
|
556 space,
|
adamc@30
|
557 string "=",
|
adamc@30
|
558 space,
|
adamc@30
|
559 p_sgn sgn]
|
adamc@30
|
560 | DStr (x, NONE, str) => box [string "structure",
|
adamc@30
|
561 space,
|
adamc@30
|
562 string x,
|
adamc@30
|
563 space,
|
adamc@30
|
564 string "=",
|
adamc@30
|
565 space,
|
adamc@30
|
566 p_str str]
|
adamc@30
|
567 | DStr (x, SOME sgn, str) => box [string "structure",
|
adamc@30
|
568 space,
|
adamc@30
|
569 string x,
|
adamc@30
|
570 space,
|
adamc@30
|
571 string ":",
|
adamc@30
|
572 space,
|
adamc@30
|
573 p_sgn sgn,
|
adamc@30
|
574 space,
|
adamc@30
|
575 string "=",
|
adamc@30
|
576 space,
|
adamc@30
|
577 p_str str]
|
adamc@48
|
578 | DFfiStr (x, sgn) => box [string "extern",
|
adamc@48
|
579 space,
|
adamc@48
|
580 string "structure",
|
adamc@48
|
581 space,
|
adamc@48
|
582 string x,
|
adamc@48
|
583 space,
|
adamc@48
|
584 string ":",
|
adamc@48
|
585 space,
|
adamc@48
|
586 p_sgn sgn]
|
adamc@61
|
587 | DOpen (m, ms) => box [string "open",
|
adamc@61
|
588 space,
|
adamc@61
|
589 p_list_sep (string ".") string (m :: ms)]
|
adamc@88
|
590 | DConstraint (c1, c2) => box [string "constraint",
|
adamc@88
|
591 space,
|
adamc@88
|
592 p_con c1,
|
adamc@88
|
593 space,
|
adamc@88
|
594 string "~",
|
adamc@88
|
595 space,
|
adamc@88
|
596 p_con c2]
|
adamc@88
|
597 | DOpenConstraints (m, ms) => box [string "open",
|
adamc@88
|
598 space,
|
adamc@88
|
599 string "constraints",
|
adamc@88
|
600 space,
|
adamc@88
|
601 p_list_sep (string ".") string (m :: ms)]
|
adamc@30
|
602
|
adamc@109
|
603 | DExport str => box [string "export",
|
adamc@109
|
604 space,
|
adamc@109
|
605 p_str str]
|
adamc@707
|
606 | DTable (x, c, pe, ce) => box [string "table",
|
adamc@707
|
607 space,
|
adamc@707
|
608 string x,
|
adamc@707
|
609 space,
|
adamc@707
|
610 string ":",
|
adamc@707
|
611 space,
|
adamc@707
|
612 p_con c,
|
adamc@707
|
613 space,
|
adamc@707
|
614 string "keys",
|
adamc@707
|
615 space,
|
adamc@707
|
616 p_exp pe,
|
adamc@707
|
617 space,
|
adamc@707
|
618 string "constraints",
|
adamc@707
|
619 space,
|
adamc@707
|
620 p_exp ce]
|
adamc@338
|
621 | DSequence x => box [string "sequence",
|
adamc@338
|
622 space,
|
adamc@338
|
623 string x]
|
adamc@563
|
624 | DClass (x, k, c) => box [string "class",
|
adamc@563
|
625 space,
|
adamc@563
|
626 string x,
|
adamc@563
|
627 space,
|
adamc@563
|
628 string "=",
|
adamc@563
|
629 space,
|
adamc@563
|
630 p_con c]
|
adamc@100
|
631
|
adamc@271
|
632 | DDatabase s => box [string "database",
|
adamc@271
|
633 space,
|
adamc@271
|
634 string s]
|
adamc@271
|
635
|
adamc@459
|
636 | DCookie (x, c) => box [string "cookie",
|
adamc@459
|
637 space,
|
adamc@459
|
638 string x,
|
adamc@459
|
639 space,
|
adamc@459
|
640 string ":",
|
adamc@459
|
641 space,
|
adamc@459
|
642 p_con c]
|
adamc@718
|
643 | DStyle (x, c) => box [string "style",
|
adamc@718
|
644 space,
|
adamc@718
|
645 string x,
|
adamc@718
|
646 space,
|
adamc@718
|
647 string ":",
|
adamc@718
|
648 space,
|
adamc@718
|
649 p_con c]
|
adamc@459
|
650
|
adamc@30
|
651 and p_str (str, _) =
|
adamc@30
|
652 case str of
|
adamc@30
|
653 StrConst ds => box [string "struct",
|
adamc@30
|
654 newline,
|
adamc@30
|
655 p_list_sep newline p_decl ds,
|
adamc@30
|
656 newline,
|
adamc@30
|
657 string "end"]
|
adamc@30
|
658 | StrVar x => string x
|
adamc@34
|
659 | StrProj (str, x) => box [p_str str,
|
adamc@34
|
660 string ".",
|
adamc@34
|
661 string x]
|
adamc@40
|
662 | StrFun (x, sgn, NONE, str) => box [string "functor",
|
adamc@40
|
663 space,
|
adamc@40
|
664 string "(",
|
adamc@40
|
665 string x,
|
adamc@40
|
666 space,
|
adamc@40
|
667 string ":",
|
adamc@40
|
668 p_sgn sgn,
|
adamc@40
|
669 string ")",
|
adamc@40
|
670 space,
|
adamc@40
|
671 string "=>",
|
adamc@40
|
672 space,
|
adamc@40
|
673 p_str str]
|
adamc@40
|
674 | StrFun (x, sgn, SOME sgn', str) => box [string "functor",
|
adamc@40
|
675 space,
|
adamc@40
|
676 string "(",
|
adamc@40
|
677 string x,
|
adamc@40
|
678 space,
|
adamc@40
|
679 string ":",
|
adamc@40
|
680 p_sgn sgn,
|
adamc@40
|
681 string ")",
|
adamc@40
|
682 space,
|
adamc@40
|
683 string ":",
|
adamc@40
|
684 space,
|
adamc@40
|
685 p_sgn sgn',
|
adamc@40
|
686 space,
|
adamc@40
|
687 string "=>",
|
adamc@40
|
688 space,
|
adamc@40
|
689 p_str str]
|
adamc@44
|
690 | StrApp (str1, str2) => box [p_str str1,
|
adamc@44
|
691 string "(",
|
adamc@44
|
692 p_str str2,
|
adamc@44
|
693 string ")"]
|
adamc@30
|
694
|
adamc@1
|
695 val p_file = p_list_sep newline p_decl
|
adamc@1
|
696
|
adamc@1
|
697 end
|