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@1
|
53 and p_kind k = p_kind' false k
|
adamc@1
|
54
|
adamc@1
|
55 fun p_explicitness e =
|
adamc@1
|
56 case e of
|
adamc@1
|
57 Explicit => string "::"
|
adamc@1
|
58 | Implicit => string ":::"
|
adamc@1
|
59
|
adamc@1
|
60 fun p_con' par (c, _) =
|
adamc@1
|
61 case c of
|
adamc@1
|
62 CAnnot (c, k) => box [string "(",
|
adamc@1
|
63 p_con c,
|
adamc@1
|
64 space,
|
adamc@1
|
65 string "::",
|
adamc@1
|
66 space,
|
adamc@1
|
67 p_kind k,
|
adamc@1
|
68 string ")"]
|
adamc@1
|
69
|
adamc@1
|
70 | TFun (t1, t2) => parenIf par (box [p_con' true t1,
|
adamc@1
|
71 space,
|
adamc@1
|
72 string "->",
|
adamc@1
|
73 space,
|
adamc@1
|
74 p_con t2])
|
adamc@1
|
75 | TCFun (e, x, k, c) => parenIf par (box [string x,
|
adamc@1
|
76 space,
|
adamc@1
|
77 p_explicitness e,
|
adamc@1
|
78 space,
|
adamc@1
|
79 p_kind k,
|
adamc@1
|
80 space,
|
adamc@1
|
81 string "->",
|
adamc@1
|
82 space,
|
adamc@1
|
83 p_con c])
|
adamc@1
|
84 | TRecord (CRecord xcs, _) => box [string "{",
|
adamc@1
|
85 p_list (fn (x, c) =>
|
adamc@20
|
86 box [p_name x,
|
adamc@1
|
87 space,
|
adamc@1
|
88 string ":",
|
adamc@1
|
89 space,
|
adamc@1
|
90 p_con c]) xcs,
|
adamc@1
|
91 string "}"]
|
adamc@1
|
92 | TRecord c => box [string "$",
|
adamc@1
|
93 p_con' true c]
|
adamc@1
|
94
|
adamc@34
|
95 | CVar (ss, s) => p_list_sep (string ".") string (ss @ [s])
|
adamc@1
|
96 | CApp (c1, c2) => parenIf par (box [p_con c1,
|
adamc@1
|
97 space,
|
adamc@1
|
98 p_con' true c2])
|
adamc@67
|
99 | CAbs (x, NONE, c) => parenIf par (box [string "fn",
|
adamc@67
|
100 space,
|
adamc@67
|
101 string x,
|
adamc@67
|
102 space,
|
adamc@67
|
103 string "=>",
|
adamc@67
|
104 space,
|
adamc@67
|
105 p_con c])
|
adamc@67
|
106 | CAbs (x, SOME k, c) => parenIf par (box [string "fn",
|
adamc@67
|
107 space,
|
adamc@67
|
108 string x,
|
adamc@67
|
109 space,
|
adamc@67
|
110 string "::",
|
adamc@67
|
111 space,
|
adamc@67
|
112 p_kind k,
|
adamc@67
|
113 space,
|
adamc@67
|
114 string "=>",
|
adamc@67
|
115 space,
|
adamc@67
|
116 p_con c])
|
adamc@84
|
117 | CDisjoint (c1, c2, c3) => parenIf par (box [p_con c1,
|
adamc@84
|
118 space,
|
adamc@84
|
119 string "~",
|
adamc@84
|
120 space,
|
adamc@84
|
121 p_con c2,
|
adamc@84
|
122 space,
|
adamc@84
|
123 string "=>",
|
adamc@84
|
124 space,
|
adamc@84
|
125 p_con c3])
|
adamc@1
|
126
|
adamc@1
|
127 | CName s => box [string "#", string s]
|
adamc@1
|
128
|
adamc@1
|
129 | CRecord xcs => box [string "[",
|
adamc@1
|
130 p_list (fn (x, c) =>
|
adamc@1
|
131 box [p_con x,
|
adamc@1
|
132 space,
|
adamc@1
|
133 string "=",
|
adamc@1
|
134 space,
|
adamc@1
|
135 p_con c]) xcs,
|
adamc@1
|
136 string "]"]
|
adamc@1
|
137 | CConcat (c1, c2) => parenIf par (box [p_con' true c1,
|
adamc@1
|
138 space,
|
adamc@1
|
139 string "++",
|
adamc@1
|
140 space,
|
adamc@1
|
141 p_con c2])
|
adamc@67
|
142 | CFold => string "fold"
|
adamc@82
|
143
|
adamc@82
|
144 | CUnit => string "()"
|
adamc@82
|
145
|
adamc@18
|
146 | CWild k => box [string "(_",
|
adamc@18
|
147 space,
|
adamc@18
|
148 string "::",
|
adamc@18
|
149 space,
|
adamc@223
|
150 p_kind k,
|
adamc@223
|
151 string ")"]
|
adamc@207
|
152
|
adamc@207
|
153 | CTuple cs => box [string "(",
|
adamc@207
|
154 p_list p_con cs,
|
adamc@207
|
155 string ")"]
|
adamc@207
|
156 | CProj (c, n) => box [p_con c,
|
adamc@207
|
157 string ".",
|
adamc@207
|
158 string (Int.toString n)]
|
adamc@1
|
159
|
adamc@1
|
160 and p_con c = p_con' false c
|
adamc@1
|
161
|
adamc@20
|
162 and p_name (all as (c, _)) =
|
adamc@20
|
163 case c of
|
adamc@20
|
164 CName s => string s
|
adamc@20
|
165 | _ => p_con all
|
adamc@20
|
166
|
adamc@170
|
167 fun p_pat' par (p, _) =
|
adamc@170
|
168 case p of
|
adamc@170
|
169 PWild => string "_"
|
adamc@170
|
170 | PVar s => string s
|
adamc@173
|
171 | PPrim p => Prim.p_t p
|
adamc@170
|
172 | PCon (ms, x, NONE) => p_list_sep (string ".") string (ms @ [x])
|
adamc@170
|
173 | PCon (ms, x, SOME p) => parenIf par (box [p_list_sep (string ".") string (ms @ [x]),
|
adamc@170
|
174 space,
|
adamc@170
|
175 p_pat' true p])
|
adamc@174
|
176 | PRecord (xps, flex) =>
|
adamc@174
|
177 let
|
adamc@175
|
178 val pps = map (fn (x, p) => box [string x, space, string "=", space, p_pat p]) xps
|
adamc@174
|
179 in
|
adamc@174
|
180 box [string "{",
|
adamc@174
|
181 p_list_sep (box [string ",", space]) (fn x => x)
|
adamc@174
|
182 (if flex then
|
adamc@175
|
183 pps @ [string "..."]
|
adamc@174
|
184 else
|
adamc@175
|
185 pps),
|
adamc@174
|
186 string "}"]
|
adamc@174
|
187 end
|
adamc@170
|
188
|
adamc@174
|
189 and p_pat x = p_pat' false x
|
adamc@170
|
190
|
adamc@8
|
191 fun p_exp' par (e, _) =
|
adamc@8
|
192 case e of
|
adamc@8
|
193 EAnnot (e, t) => box [string "(",
|
adamc@8
|
194 p_exp e,
|
adamc@8
|
195 space,
|
adamc@8
|
196 string ":",
|
adamc@8
|
197 space,
|
adamc@8
|
198 p_con t,
|
adamc@8
|
199 string ")"]
|
adamc@8
|
200
|
adamc@14
|
201 | EPrim p => Prim.p_t p
|
adamc@403
|
202 | EVar (ss, s, _) => p_list_sep (string ".") string (ss @ [s])
|
adamc@8
|
203 | EApp (e1, e2) => parenIf par (box [p_exp e1,
|
adamc@8
|
204 space,
|
adamc@8
|
205 p_exp' true e2])
|
adamc@8
|
206 | EAbs (x, NONE, e) => parenIf par (box [string "fn",
|
adamc@8
|
207 space,
|
adamc@8
|
208 string x,
|
adamc@8
|
209 space,
|
adamc@8
|
210 string "=>",
|
adamc@8
|
211 space,
|
adamc@8
|
212 p_exp e])
|
adamc@8
|
213 | EAbs (x, SOME t, e) => parenIf par (box [string "fn",
|
adamc@8
|
214 space,
|
adamc@8
|
215 string x,
|
adamc@8
|
216 space,
|
adamc@8
|
217 string ":",
|
adamc@8
|
218 space,
|
adamc@8
|
219 p_con t,
|
adamc@8
|
220 space,
|
adamc@8
|
221 string "=>",
|
adamc@8
|
222 space,
|
adamc@8
|
223 p_exp e])
|
adamc@8
|
224 | ECApp (e, c) => parenIf par (box [p_exp e,
|
adamc@8
|
225 space,
|
adamc@8
|
226 string "[",
|
adamc@8
|
227 p_con c,
|
adamc@8
|
228 string "]"])
|
adamc@8
|
229 | ECAbs (exp, x, k, e) => parenIf par (box [string "fn",
|
adamc@8
|
230 space,
|
adamc@8
|
231 string x,
|
adamc@8
|
232 space,
|
adamc@8
|
233 p_explicitness exp,
|
adamc@8
|
234 space,
|
adamc@8
|
235 p_kind k,
|
adamc@8
|
236 space,
|
adamc@8
|
237 string "=>",
|
adamc@8
|
238 space,
|
adamc@8
|
239 p_exp e])
|
adamc@85
|
240 | EDisjoint (c1, c2, e) => parenIf par (box [p_con c1,
|
adamc@85
|
241 space,
|
adamc@85
|
242 string "~",
|
adamc@85
|
243 space,
|
adamc@85
|
244 p_con c2,
|
adamc@85
|
245 space,
|
adamc@85
|
246 string "=>",
|
adamc@85
|
247 space,
|
adamc@85
|
248 p_exp e])
|
adamc@8
|
249
|
adamc@12
|
250 | ERecord xes => box [string "{",
|
adamc@12
|
251 p_list (fn (x, e) =>
|
adamc@21
|
252 box [p_name x,
|
adamc@12
|
253 space,
|
adamc@12
|
254 string "=",
|
adamc@12
|
255 space,
|
adamc@12
|
256 p_exp e]) xes,
|
adamc@12
|
257 string "}"]
|
adamc@12
|
258 | EField (e, c) => box [p_exp' true e,
|
adamc@12
|
259 string ".",
|
adamc@12
|
260 p_con' true c]
|
adamc@339
|
261 | EWith (e1, c, e2) => parenIf par (box [p_exp e1,
|
adamc@339
|
262 space,
|
adamc@339
|
263 string "with",
|
adamc@339
|
264 space,
|
adamc@339
|
265 p_con' true c,
|
adamc@339
|
266 space,
|
adamc@339
|
267 p_exp' true e2])
|
adamc@149
|
268 | ECut (e, c) => parenIf par (box [p_exp' true e,
|
adamc@149
|
269 space,
|
adamc@149
|
270 string "--",
|
adamc@149
|
271 space,
|
adamc@149
|
272 p_con' true c])
|
adamc@71
|
273 | EFold => string "fold"
|
adamc@12
|
274
|
adamc@170
|
275 | ECase (e, pes) => parenIf par (box [string "case",
|
adamc@170
|
276 space,
|
adamc@171
|
277 p_exp e,
|
adamc@170
|
278 space,
|
adamc@170
|
279 string "of",
|
adamc@170
|
280 space,
|
adamc@170
|
281 p_list_sep (box [space, string "|", space])
|
adamc@170
|
282 (fn (p, e) => box [p_pat p,
|
adamc@170
|
283 space,
|
adamc@170
|
284 string "=>",
|
adamc@170
|
285 space,
|
adamc@170
|
286 p_exp e]) pes])
|
adamc@170
|
287
|
adamc@219
|
288 | EWild => string "_"
|
adamc@210
|
289
|
adamc@8
|
290 and p_exp e = p_exp' false e
|
adamc@8
|
291
|
adamc@191
|
292 fun p_datatype (x, xs, cons) =
|
adamc@156
|
293 box [string "datatype",
|
adamc@156
|
294 space,
|
adamc@156
|
295 string x,
|
adamc@191
|
296 p_list_sep (box []) (fn x => box [space, string x]) xs,
|
adamc@156
|
297 space,
|
adamc@156
|
298 string "=",
|
adamc@156
|
299 space,
|
adamc@156
|
300 p_list_sep (box [space, string "|", space])
|
adamc@156
|
301 (fn (x, NONE) => string x
|
adamc@156
|
302 | (x, SOME t) => box [string x, space, string "of", space, p_con t])
|
adamc@156
|
303 cons]
|
adamc@156
|
304
|
adamc@30
|
305 fun p_sgn_item (sgi, _) =
|
adamc@30
|
306 case sgi of
|
adamc@30
|
307 SgiConAbs (x, k) => box [string "con",
|
adamc@30
|
308 space,
|
adamc@30
|
309 string x,
|
adamc@30
|
310 space,
|
adamc@30
|
311 string "::",
|
adamc@30
|
312 space,
|
adamc@30
|
313 p_kind k]
|
adamc@30
|
314 | SgiCon (x, NONE, c) => box [string "con",
|
adamc@30
|
315 space,
|
adamc@30
|
316 string x,
|
adamc@30
|
317 space,
|
adamc@30
|
318 string "=",
|
adamc@30
|
319 space,
|
adamc@30
|
320 p_con c]
|
adamc@30
|
321 | SgiCon (x, SOME k, c) => box [string "con",
|
adamc@30
|
322 space,
|
adamc@30
|
323 string x,
|
adamc@30
|
324 space,
|
adamc@30
|
325 string "::",
|
adamc@30
|
326 space,
|
adamc@30
|
327 p_kind k,
|
adamc@30
|
328 space,
|
adamc@30
|
329 string "=",
|
adamc@30
|
330 space,
|
adamc@30
|
331 p_con c]
|
adamc@156
|
332 | SgiDatatype x => p_datatype x
|
adamc@156
|
333 | SgiDatatypeImp (x, ms, x') =>
|
adamc@156
|
334 box [string "datatype",
|
adamc@156
|
335 space,
|
adamc@156
|
336 string x,
|
adamc@156
|
337 space,
|
adamc@156
|
338 string "=",
|
adamc@156
|
339 space,
|
adamc@156
|
340 string "datatype",
|
adamc@156
|
341 space,
|
adamc@156
|
342 p_list_sep (string ".") string (ms @ [x'])]
|
adamc@30
|
343 | SgiVal (x, c) => box [string "val",
|
adamc@30
|
344 space,
|
adamc@30
|
345 string x,
|
adamc@30
|
346 space,
|
adamc@30
|
347 string ":",
|
adamc@30
|
348 space,
|
adamc@30
|
349 p_con c]
|
adamc@30
|
350 | SgiStr (x, sgn) => box [string "structure",
|
adamc@30
|
351 space,
|
adamc@30
|
352 string x,
|
adamc@30
|
353 space,
|
adamc@30
|
354 string ":",
|
adamc@30
|
355 space,
|
adamc@30
|
356 p_sgn sgn]
|
adamc@59
|
357 | SgiSgn (x, sgn) => box [string "signature",
|
adamc@59
|
358 space,
|
adamc@59
|
359 string x,
|
adamc@59
|
360 space,
|
adamc@59
|
361 string "=",
|
adamc@59
|
362 space,
|
adamc@59
|
363 p_sgn sgn]
|
adamc@58
|
364 | SgiInclude sgn => box [string "include",
|
adamc@58
|
365 space,
|
adamc@58
|
366 p_sgn sgn]
|
adamc@88
|
367 | SgiConstraint (c1, c2) => box [string "constraint",
|
adamc@88
|
368 space,
|
adamc@88
|
369 p_con c1,
|
adamc@88
|
370 space,
|
adamc@88
|
371 string "~",
|
adamc@88
|
372 space,
|
adamc@88
|
373 p_con c2]
|
adamc@203
|
374 | SgiTable (x, c) => box [string "table",
|
adamc@203
|
375 space,
|
adamc@203
|
376 string x,
|
adamc@203
|
377 space,
|
adamc@203
|
378 string ":",
|
adamc@203
|
379 space,
|
adamc@203
|
380 p_con c]
|
adamc@338
|
381 | SgiSequence x => box [string "sequence",
|
adamc@338
|
382 space,
|
adamc@338
|
383 string x]
|
adamc@211
|
384 | SgiClassAbs x => box [string "class",
|
adamc@211
|
385 space,
|
adamc@211
|
386 string x]
|
adamc@211
|
387 | SgiClass (x, c) => box [string "class",
|
adamc@211
|
388 space,
|
adamc@211
|
389 string x,
|
adamc@211
|
390 space,
|
adamc@211
|
391 string "=",
|
adamc@211
|
392 space,
|
adamc@211
|
393 p_con c]
|
adamc@30
|
394
|
adamc@30
|
395 and p_sgn (sgn, _) =
|
adamc@30
|
396 case sgn of
|
adamc@30
|
397 SgnConst sgis => box [string "sig",
|
adamc@30
|
398 newline,
|
adamc@30
|
399 p_list_sep newline p_sgn_item sgis,
|
adamc@30
|
400 newline,
|
adamc@30
|
401 string "end"]
|
adamc@30
|
402 | SgnVar x => string x
|
adamc@40
|
403 | SgnFun (x, sgn, sgn') => box [string "functor",
|
adamc@40
|
404 space,
|
adamc@40
|
405 string "(",
|
adamc@40
|
406 string x,
|
adamc@40
|
407 space,
|
adamc@40
|
408 string ":",
|
adamc@40
|
409 p_sgn sgn,
|
adamc@40
|
410 string ")",
|
adamc@40
|
411 space,
|
adamc@40
|
412 string ":",
|
adamc@40
|
413 space,
|
adamc@40
|
414 p_sgn sgn']
|
adamc@42
|
415 | SgnWhere (sgn, x, c) => box [p_sgn sgn,
|
adamc@42
|
416 space,
|
adamc@42
|
417 string "where",
|
adamc@42
|
418 space,
|
adamc@42
|
419 string "con",
|
adamc@42
|
420 space,
|
adamc@42
|
421 string x,
|
adamc@42
|
422 space,
|
adamc@42
|
423 string "=",
|
adamc@42
|
424 space,
|
adamc@42
|
425 p_con c]
|
adamc@59
|
426 | SgnProj (m, ms, x) => p_list_sep (string ".") string (m :: ms @ [x])
|
adamc@59
|
427
|
adamc@42
|
428
|
adamc@123
|
429 fun p_vali (x, co, e) =
|
adamc@123
|
430 case co of
|
adamc@123
|
431 NONE => box [string x,
|
adamc@123
|
432 space,
|
adamc@123
|
433 string "=",
|
adamc@123
|
434 space,
|
adamc@123
|
435 p_exp e]
|
adamc@123
|
436 | SOME t => box [string x,
|
adamc@123
|
437 space,
|
adamc@123
|
438 string ":",
|
adamc@123
|
439 space,
|
adamc@123
|
440 p_con t,
|
adamc@123
|
441 space,
|
adamc@123
|
442 string "=",
|
adamc@123
|
443 space,
|
adamc@123
|
444 p_exp e]
|
adamc@123
|
445
|
adamc@1
|
446 fun p_decl ((d, _) : decl) =
|
adamc@1
|
447 case d of
|
adamc@1
|
448 DCon (x, NONE, c) => box [string "con",
|
adamc@1
|
449 space,
|
adamc@1
|
450 string x,
|
adamc@1
|
451 space,
|
adamc@1
|
452 string "=",
|
adamc@1
|
453 space,
|
adamc@1
|
454 p_con c]
|
adamc@1
|
455 | DCon (x, SOME k, c) => box [string "con",
|
adamc@1
|
456 space,
|
adamc@1
|
457 string x,
|
adamc@1
|
458 space,
|
adamc@1
|
459 string "::",
|
adamc@1
|
460 space,
|
adamc@1
|
461 p_kind k,
|
adamc@1
|
462 space,
|
adamc@1
|
463 string "=",
|
adamc@1
|
464 space,
|
adamc@1
|
465 p_con c]
|
adamc@156
|
466 | DDatatype x => p_datatype x
|
adamc@156
|
467 | DDatatypeImp (x, ms, x') =>
|
adamc@156
|
468 box [string "datatype",
|
adamc@156
|
469 space,
|
adamc@156
|
470 string x,
|
adamc@156
|
471 space,
|
adamc@156
|
472 string "=",
|
adamc@156
|
473 space,
|
adamc@156
|
474 string "datatype",
|
adamc@156
|
475 space,
|
adamc@156
|
476 p_list_sep (string ".") string (ms @ [x'])]
|
adamc@123
|
477 | DVal vi => box [string "val",
|
adamc@123
|
478 space,
|
adamc@123
|
479 p_vali vi]
|
adamc@123
|
480 | DValRec vis => box [string "val",
|
adamc@123
|
481 space,
|
adamc@123
|
482 string "rec",
|
adamc@123
|
483 space,
|
adamc@123
|
484 p_list_sep (box [newline, string "and", space]) p_vali vis]
|
adamc@1
|
485
|
adamc@30
|
486 | DSgn (x, sgn) => box [string "signature",
|
adamc@30
|
487 space,
|
adamc@30
|
488 string x,
|
adamc@30
|
489 space,
|
adamc@30
|
490 string "=",
|
adamc@30
|
491 space,
|
adamc@30
|
492 p_sgn sgn]
|
adamc@30
|
493 | DStr (x, NONE, str) => box [string "structure",
|
adamc@30
|
494 space,
|
adamc@30
|
495 string x,
|
adamc@30
|
496 space,
|
adamc@30
|
497 string "=",
|
adamc@30
|
498 space,
|
adamc@30
|
499 p_str str]
|
adamc@30
|
500 | DStr (x, SOME sgn, str) => box [string "structure",
|
adamc@30
|
501 space,
|
adamc@30
|
502 string x,
|
adamc@30
|
503 space,
|
adamc@30
|
504 string ":",
|
adamc@30
|
505 space,
|
adamc@30
|
506 p_sgn sgn,
|
adamc@30
|
507 space,
|
adamc@30
|
508 string "=",
|
adamc@30
|
509 space,
|
adamc@30
|
510 p_str str]
|
adamc@48
|
511 | DFfiStr (x, sgn) => box [string "extern",
|
adamc@48
|
512 space,
|
adamc@48
|
513 string "structure",
|
adamc@48
|
514 space,
|
adamc@48
|
515 string x,
|
adamc@48
|
516 space,
|
adamc@48
|
517 string ":",
|
adamc@48
|
518 space,
|
adamc@48
|
519 p_sgn sgn]
|
adamc@61
|
520 | DOpen (m, ms) => box [string "open",
|
adamc@61
|
521 space,
|
adamc@61
|
522 p_list_sep (string ".") string (m :: ms)]
|
adamc@88
|
523 | DConstraint (c1, c2) => box [string "constraint",
|
adamc@88
|
524 space,
|
adamc@88
|
525 p_con c1,
|
adamc@88
|
526 space,
|
adamc@88
|
527 string "~",
|
adamc@88
|
528 space,
|
adamc@88
|
529 p_con c2]
|
adamc@88
|
530 | DOpenConstraints (m, ms) => box [string "open",
|
adamc@88
|
531 space,
|
adamc@88
|
532 string "constraints",
|
adamc@88
|
533 space,
|
adamc@88
|
534 p_list_sep (string ".") string (m :: ms)]
|
adamc@30
|
535
|
adamc@109
|
536 | DExport str => box [string "export",
|
adamc@109
|
537 space,
|
adamc@109
|
538 p_str str]
|
adamc@203
|
539 | DTable (x, c) => box [string "table",
|
adamc@203
|
540 space,
|
adamc@203
|
541 string x,
|
adamc@203
|
542 space,
|
adamc@203
|
543 string ":",
|
adamc@203
|
544 space,
|
adamc@203
|
545 p_con c]
|
adamc@338
|
546 | DSequence x => box [string "sequence",
|
adamc@338
|
547 space,
|
adamc@338
|
548 string x]
|
adamc@211
|
549 | DClass (x, c) => box [string "class",
|
adamc@211
|
550 space,
|
adamc@211
|
551 string x,
|
adamc@211
|
552 space,
|
adamc@211
|
553 string "=",
|
adamc@211
|
554 space,
|
adamc@211
|
555 p_con c]
|
adamc@100
|
556
|
adamc@271
|
557 | DDatabase s => box [string "database",
|
adamc@271
|
558 space,
|
adamc@271
|
559 string s]
|
adamc@271
|
560
|
adamc@30
|
561 and p_str (str, _) =
|
adamc@30
|
562 case str of
|
adamc@30
|
563 StrConst ds => box [string "struct",
|
adamc@30
|
564 newline,
|
adamc@30
|
565 p_list_sep newline p_decl ds,
|
adamc@30
|
566 newline,
|
adamc@30
|
567 string "end"]
|
adamc@30
|
568 | StrVar x => string x
|
adamc@34
|
569 | StrProj (str, x) => box [p_str str,
|
adamc@34
|
570 string ".",
|
adamc@34
|
571 string x]
|
adamc@40
|
572 | StrFun (x, sgn, NONE, str) => box [string "functor",
|
adamc@40
|
573 space,
|
adamc@40
|
574 string "(",
|
adamc@40
|
575 string x,
|
adamc@40
|
576 space,
|
adamc@40
|
577 string ":",
|
adamc@40
|
578 p_sgn sgn,
|
adamc@40
|
579 string ")",
|
adamc@40
|
580 space,
|
adamc@40
|
581 string "=>",
|
adamc@40
|
582 space,
|
adamc@40
|
583 p_str str]
|
adamc@40
|
584 | StrFun (x, sgn, SOME sgn', str) => box [string "functor",
|
adamc@40
|
585 space,
|
adamc@40
|
586 string "(",
|
adamc@40
|
587 string x,
|
adamc@40
|
588 space,
|
adamc@40
|
589 string ":",
|
adamc@40
|
590 p_sgn sgn,
|
adamc@40
|
591 string ")",
|
adamc@40
|
592 space,
|
adamc@40
|
593 string ":",
|
adamc@40
|
594 space,
|
adamc@40
|
595 p_sgn sgn',
|
adamc@40
|
596 space,
|
adamc@40
|
597 string "=>",
|
adamc@40
|
598 space,
|
adamc@40
|
599 p_str str]
|
adamc@44
|
600 | StrApp (str1, str2) => box [p_str str1,
|
adamc@44
|
601 string "(",
|
adamc@44
|
602 p_str str2,
|
adamc@44
|
603 string ")"]
|
adamc@30
|
604
|
adamc@1
|
605 val p_file = p_list_sep newline p_decl
|
adamc@1
|
606
|
adamc@1
|
607 end
|