adamc@25
|
1 (* Copyright (c) 2008, Adam Chlipala
|
adamc@25
|
2 * All rights reserved.
|
adamc@25
|
3 *
|
adamc@25
|
4 * Redistribution and use in source and binary forms, with or without
|
adamc@25
|
5 * modification, are permitted provided that the following conditions are met:
|
adamc@25
|
6 *
|
adamc@25
|
7 * - Redistributions of source code must retain the above copyright notice,
|
adamc@25
|
8 * this list of conditions and the following disclaimer.
|
adamc@25
|
9 * - Redistributions in binary form must reproduce the above copyright notice,
|
adamc@25
|
10 * this list of conditions and the following disclaimer in the documentation
|
adamc@25
|
11 * and/or other materials provided with the distribution.
|
adamc@25
|
12 * - The names of contributors may not be used to endorse or promote products
|
adamc@25
|
13 * derived from this software without specific prior written permission.
|
adamc@25
|
14 *
|
adamc@25
|
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
adamc@25
|
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
adamc@25
|
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
adamc@25
|
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
adamc@25
|
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
adamc@25
|
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
adamc@25
|
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
adamc@25
|
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
adamc@25
|
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
adamc@25
|
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
adamc@25
|
25 * POSSIBILITY OF SUCH DAMAGE.
|
adamc@25
|
26 *)
|
adamc@25
|
27
|
adamc@244
|
28 (* Pretty-printing monomorphic Ur/Web *)
|
adamc@25
|
29
|
adamc@25
|
30 structure MonoPrint :> MONO_PRINT = struct
|
adamc@25
|
31
|
adamc@25
|
32 open Print.PD
|
adamc@25
|
33 open Print
|
adamc@25
|
34
|
adamc@25
|
35 open Mono
|
adamc@25
|
36
|
adamc@25
|
37 structure E = MonoEnv
|
adamc@25
|
38
|
adamc@25
|
39 val debug = ref false
|
adamc@25
|
40
|
adamc@252
|
41 val dummyt = (TRecord [], ErrorMsg.dummySpan)
|
adamc@252
|
42
|
adamc@25
|
43 fun p_typ' par env (t, _) =
|
adamc@25
|
44 case t of
|
adamc@25
|
45 TFun (t1, t2) => parenIf par (box [p_typ' true env t1,
|
adamc@25
|
46 space,
|
adamc@25
|
47 string "->",
|
adamc@25
|
48 space,
|
adamc@25
|
49 p_typ env t2])
|
adamc@25
|
50 | TRecord xcs => box [string "{",
|
adamc@25
|
51 p_list (fn (x, t) =>
|
adamc@25
|
52 box [string x,
|
adamc@25
|
53 space,
|
adamc@25
|
54 string ":",
|
adamc@25
|
55 space,
|
adamc@25
|
56 p_typ env t]) xcs,
|
adamc@25
|
57 string "}"]
|
adamc@841
|
58 | TDatatype (n, ref (dk, _)) =>
|
adamc@178
|
59 ((if !debug then
|
adamc@841
|
60 string (#1 (E.lookupDatatype env n) ^ "__" ^ Int.toString n ^ "["
|
adamc@841
|
61 ^ (case dk of
|
adamc@841
|
62 Option => "Option"
|
adamc@841
|
63 | Enum => "Enum"
|
adamc@841
|
64 | Default => "Default")
|
adamc@841
|
65 ^ "]")
|
adamc@178
|
66 else
|
adamc@178
|
67 string (#1 (E.lookupDatatype env n)))
|
adamc@178
|
68 handle E.UnboundNamed _ => string ("UNBOUND_DATATYPE_" ^ Int.toString n))
|
adamc@51
|
69 | TFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
|
adamc@292
|
70 | TOption t => box [string "option(",
|
adamc@292
|
71 p_typ env t,
|
adamc@292
|
72 string ")"]
|
adamc@757
|
73 | TList t => box [string "list(",
|
adamc@757
|
74 p_typ env t,
|
adamc@757
|
75 string ")"]
|
adamc@577
|
76 | TSource => string "source"
|
adamc@568
|
77 | TSignal t => box [string "signal(",
|
adamc@568
|
78 p_typ env t,
|
adamc@568
|
79 string ")"]
|
adamc@25
|
80
|
adamc@25
|
81 and p_typ env = p_typ' false env
|
adamc@25
|
82
|
adamc@109
|
83 fun p_enamed env n =
|
adamc@178
|
84 (if !debug then
|
adamc@178
|
85 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
|
adamc@178
|
86 else
|
adamc@178
|
87 string (#1 (E.lookupENamed env n)))
|
adamc@178
|
88 handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n)
|
adamc@178
|
89
|
adamc@178
|
90 fun p_con_named env n =
|
adamc@178
|
91 (if !debug then
|
adamc@178
|
92 string (#1 (E.lookupConstructor env n) ^ "__" ^ Int.toString n)
|
adamc@178
|
93 else
|
adamc@178
|
94 string (#1 (E.lookupConstructor env n)))
|
adamc@178
|
95 handle E.UnboundNamed _ => string ("CONSTRUCTOR_" ^ Int.toString n)
|
adamc@178
|
96
|
adamc@178
|
97 fun p_patCon env pc =
|
adamc@178
|
98 case pc of
|
adamc@178
|
99 PConVar n => p_con_named env n
|
adamc@186
|
100 | PConFfi {mod = m, con, ...} => box [string "FFIC(",
|
adamc@185
|
101 string m,
|
adamc@185
|
102 string ".",
|
adamc@185
|
103 string con,
|
adamc@185
|
104 string ")"]
|
adamc@178
|
105
|
adamc@178
|
106 fun p_pat' par env (p, _) =
|
adamc@178
|
107 case p of
|
adamc@178
|
108 PWild => string "_"
|
adamc@182
|
109 | PVar (s, _) => string s
|
adamc@178
|
110 | PPrim p => Prim.p_t p
|
adamc@188
|
111 | PCon (_, n, NONE) => p_patCon env n
|
adamc@188
|
112 | PCon (_, n, SOME p) => parenIf par (box [p_patCon env n,
|
adamc@288
|
113 space,
|
adamc@288
|
114 p_pat' true env p])
|
adamc@178
|
115 | PRecord xps =>
|
adamc@178
|
116 box [string "{",
|
adamc@182
|
117 p_list_sep (box [string ",", space]) (fn (x, p, _) =>
|
adamc@178
|
118 box [string x,
|
adamc@178
|
119 space,
|
adamc@178
|
120 string "=",
|
adamc@178
|
121 space,
|
adamc@178
|
122 p_pat env p]) xps,
|
adamc@178
|
123 string "}"]
|
adamc@288
|
124 | PNone _ => string "None"
|
adamc@757
|
125 | PSome (t, p) =>
|
adamc@757
|
126 if !debug then
|
adamc@757
|
127 box [string "Some[",
|
adamc@757
|
128 p_typ env t,
|
adamc@757
|
129 string "]",
|
adamc@757
|
130 space,
|
adamc@757
|
131 p_pat' true env p]
|
adamc@757
|
132 else
|
adamc@757
|
133 box [string "Some",
|
adamc@757
|
134 space,
|
adamc@757
|
135 p_pat' true env p]
|
adamc@178
|
136
|
adamc@178
|
137 and p_pat x = p_pat' false x
|
adamc@109
|
138
|
adamc@591
|
139 fun p_mode env m =
|
adamc@591
|
140 case m of
|
adamc@591
|
141 Attribute => string "Attribute"
|
adamc@591
|
142 | Script => string "Script"
|
adamc@591
|
143 | Source t => box [string "Source", space, p_typ env t]
|
adamc@591
|
144
|
adamc@25
|
145 fun p_exp' par env (e, _) =
|
adamc@25
|
146 case e of
|
adamc@25
|
147 EPrim p => Prim.p_t p
|
adamc@25
|
148 | ERel n =>
|
adamc@178
|
149 ((if !debug then
|
adamc@178
|
150 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
|
adamc@178
|
151 else
|
adamc@178
|
152 string (#1 (E.lookupERel env n)))
|
adamc@178
|
153 handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
|
adamc@109
|
154 | ENamed n => p_enamed env n
|
adamc@188
|
155 | ECon (_, pc, NONE) => p_patCon env pc
|
adamc@188
|
156 | ECon (_, pc, SOME e) => parenIf par (box [p_patCon env pc,
|
adamc@188
|
157 space,
|
adamc@188
|
158 p_exp' true env e])
|
adamc@297
|
159 | ENone _ => string "None"
|
adamc@290
|
160 | ESome (_, e) => parenIf par (box [string "Some",
|
adamc@290
|
161 space,
|
adamc@290
|
162 p_exp' true env e])
|
adamc@109
|
163
|
adamc@51
|
164 | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
|
adamc@51
|
165 | EFfiApp (m, x, es) => box [string "FFI(",
|
adamc@51
|
166 string m,
|
adamc@51
|
167 string ".",
|
adamc@51
|
168 string x,
|
adamc@51
|
169 string "(",
|
adamc@51
|
170 p_list (p_exp env) es,
|
adamc@51
|
171 string "))"]
|
adamc@25
|
172 | EApp (e1, e2) => parenIf par (box [p_exp env e1,
|
adamc@25
|
173 space,
|
adamc@25
|
174 p_exp' true env e2])
|
adamc@252
|
175 | EAbs (x, t, _, e) => parenIf true (box [string "fn",
|
adamc@252
|
176 space,
|
adamc@252
|
177 string x,
|
adamc@252
|
178 space,
|
adamc@252
|
179 string ":",
|
adamc@252
|
180 space,
|
adamc@252
|
181 p_typ env t,
|
adamc@252
|
182 space,
|
adamc@252
|
183 string "=>",
|
adamc@252
|
184 space,
|
adamc@252
|
185 p_exp (E.pushERel env x t NONE) e])
|
adamc@25
|
186
|
adamc@387
|
187 | EUnop (s, e) => parenIf true (box [string s,
|
adamc@387
|
188 space,
|
adamc@387
|
189 p_exp' true env e])
|
adamc@387
|
190 | EBinop (s, e1, e2) => parenIf true (box [p_exp' true env e1,
|
adamc@387
|
191 space,
|
adamc@387
|
192 string s,
|
adamc@387
|
193 space,
|
adamc@387
|
194 p_exp' true env e2])
|
adamc@387
|
195
|
adamc@25
|
196 | ERecord xes => box [string "{",
|
adamc@29
|
197 p_list (fn (x, e, _) =>
|
adamc@25
|
198 box [string x,
|
adamc@25
|
199 space,
|
adamc@25
|
200 string "=",
|
adamc@25
|
201 space,
|
adamc@25
|
202 p_exp env e]) xes,
|
adamc@25
|
203 string "}"]
|
adamc@25
|
204 | EField (e, x) =>
|
adamc@25
|
205 box [p_exp' true env e,
|
adamc@25
|
206 string ".",
|
adamc@25
|
207 string x]
|
adamc@25
|
208
|
adamc@1107
|
209 | ECase (e, pes, {result, ...}) => parenIf true (box [string "case",
|
adamc@1107
|
210 space,
|
adamc@1107
|
211 p_exp env e,
|
adamc@1107
|
212 space,
|
adamc@1107
|
213 if !debug then
|
adamc@1107
|
214 box [string "return",
|
adamc@1107
|
215 space,
|
adamc@1107
|
216 p_typ env result,
|
adamc@1107
|
217 space]
|
adamc@1107
|
218 else
|
adamc@1107
|
219 box [],
|
adamc@1107
|
220 string "of",
|
adamc@1107
|
221 space,
|
adamc@1107
|
222 p_list_sep (box [space, string "|", space])
|
adamc@1107
|
223 (fn (p, e) => box [p_pat env p,
|
adamc@1107
|
224 space,
|
adamc@1107
|
225 string "=>",
|
adamc@1107
|
226 space,
|
adamc@1107
|
227 p_exp (E.patBinds env p) e])
|
adamc@1107
|
228 pes])
|
adamc@94
|
229
|
adamc@283
|
230 | EError (e, t) => box [string "(error",
|
adamc@283
|
231 space,
|
adamc@283
|
232 p_exp env e,
|
adamc@283
|
233 space,
|
adamc@283
|
234 string ":",
|
adamc@283
|
235 space,
|
adamc@283
|
236 p_typ env t,
|
adamc@283
|
237 string ")"]
|
adamc@741
|
238 | EReturnBlob {blob, mimeType, t} => box [string "(blob",
|
adamc@741
|
239 space,
|
adamc@741
|
240 p_exp env blob,
|
adamc@741
|
241 space,
|
adamc@741
|
242 string "in",
|
adamc@741
|
243 space,
|
adamc@741
|
244 p_exp env mimeType,
|
adamc@741
|
245 space,
|
adamc@741
|
246 string ":",
|
adamc@741
|
247 space,
|
adamc@741
|
248 p_typ env t,
|
adamc@741
|
249 string ")"]
|
adamc@1065
|
250 | ERedirect (e, t) => box [string "(redirect",
|
adamc@1065
|
251 space,
|
adamc@1065
|
252 p_exp env e,
|
adamc@1065
|
253 space,
|
adamc@1065
|
254 string ":",
|
adamc@1065
|
255 space,
|
adamc@1065
|
256 p_typ env t,
|
adamc@1065
|
257 string ")"]
|
adamc@283
|
258
|
adamc@331
|
259 | EStrcat (e1, e2) => parenIf par (box [p_exp' true env e1,
|
adamc@331
|
260 space,
|
adamc@331
|
261 string "^",
|
adamc@331
|
262 space,
|
adamc@331
|
263 p_exp env e2])
|
adamc@94
|
264
|
adamc@102
|
265 | EWrite e => box [string "write(",
|
adamc@102
|
266 p_exp env e,
|
adamc@102
|
267 string ")"]
|
adamc@102
|
268
|
adamc@578
|
269 | ESeq (e1, e2) => box [string "(",
|
adamc@578
|
270 p_exp env e1,
|
adamc@106
|
271 string ";",
|
adamc@106
|
272 space,
|
adamc@578
|
273 p_exp env e2,
|
adamc@578
|
274 string ")"]
|
adamc@252
|
275 | ELet (x, t, e1, e2) => box [string "(let",
|
adamc@251
|
276 space,
|
adamc@251
|
277 string x,
|
adamc@251
|
278 space,
|
adamc@251
|
279 string ":",
|
adamc@251
|
280 space,
|
adamc@251
|
281 p_typ env t,
|
adamc@251
|
282 space,
|
adamc@251
|
283 string "=",
|
adamc@251
|
284 space,
|
adamc@252
|
285 string "(",
|
adamc@251
|
286 p_exp env e1,
|
adamc@252
|
287 string ")",
|
adamc@251
|
288 space,
|
adamc@251
|
289 string "in",
|
adamc@251
|
290 space,
|
adamc@252
|
291 string "(",
|
adamc@252
|
292 p_exp (E.pushERel env x t NONE) e2,
|
adamc@252
|
293 string "))"]
|
adamc@106
|
294
|
adamc@111
|
295 | EClosure (n, es) => box [string "CLOSURE(",
|
adamc@111
|
296 p_enamed env n,
|
adamc@111
|
297 p_list_sep (string "") (fn e => box [string ", ",
|
adamc@111
|
298 p_exp env e]) es,
|
adamc@111
|
299 string ")"]
|
adamc@111
|
300
|
adamc@252
|
301 | EQuery {exps, tables, state, query, body, initial} =>
|
adamc@252
|
302 box [string "query[",
|
adamc@252
|
303 p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps,
|
adamc@252
|
304 string "] [",
|
adamc@252
|
305 p_list (fn (x, xts) => box [string x,
|
adamc@252
|
306 space,
|
adamc@252
|
307 string ":",
|
adamc@252
|
308 space,
|
adamc@252
|
309 string "{",
|
adamc@252
|
310 p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) xts,
|
adamc@252
|
311 string "}"]) tables,
|
adamc@252
|
312 string "] [",
|
adamc@252
|
313 p_typ env state,
|
adamc@252
|
314 string "]",
|
adamc@252
|
315 space,
|
adamc@252
|
316 p_exp env query,
|
adamc@252
|
317 space,
|
adamc@252
|
318 string "initial",
|
adamc@252
|
319 space,
|
adamc@252
|
320 p_exp env initial,
|
adamc@252
|
321 space,
|
adamc@252
|
322 string "in",
|
adamc@252
|
323 space,
|
adamc@252
|
324 p_exp (E.pushERel (E.pushERel env "r" dummyt NONE) "acc" dummyt NONE) body]
|
adamc@307
|
325 | EDml e => box [string "dml(",
|
adamc@307
|
326 p_exp env e,
|
adamc@307
|
327 string ")"]
|
adamc@338
|
328 | ENextval e => box [string "nextval(",
|
adamc@338
|
329 p_exp env e,
|
adamc@338
|
330 string ")"]
|
adamc@1073
|
331 | ESetval (e1, e2) => box [string "setval(",
|
adamc@1073
|
332 p_exp env e1,
|
adamc@1073
|
333 string ",",
|
adamc@1073
|
334 space,
|
adamc@1073
|
335 p_exp env e2,
|
adamc@1073
|
336 string ")"]
|
adamc@1112
|
337 | EUnurlify (e, _, _) => box [string "unurlify(",
|
adamc@1112
|
338 p_exp env e,
|
adamc@1112
|
339 string ")"]
|
adamc@815
|
340 | EJavaScript (m, e) => box [string "JavaScript(",
|
adamc@815
|
341 p_mode env m,
|
adamc@815
|
342 string ",",
|
adamc@815
|
343 space,
|
adamc@815
|
344 p_exp env e,
|
adamc@815
|
345 string ")"]
|
adamc@568
|
346
|
adamc@568
|
347 | ESignalReturn e => box [string "Return(",
|
adamc@568
|
348 p_exp env e,
|
adamc@568
|
349 string ")"]
|
adamc@574
|
350 | ESignalBind (e1, e2) => box [string "Bind(",
|
adamc@572
|
351 p_exp env e1,
|
adamc@572
|
352 string ",",
|
adamc@572
|
353 space,
|
adamc@572
|
354 p_exp env e2,
|
adamc@572
|
355 string ")"]
|
adamc@574
|
356 | ESignalSource e => box [string "Source(",
|
adamc@574
|
357 p_exp env e,
|
adamc@574
|
358 string ")"]
|
adamc@252
|
359
|
adamc@1020
|
360 | EServerCall (n, _, _) => box [string "Server(",
|
adamc@1020
|
361 p_exp env n,
|
adamc@1020
|
362 string ")"]
|
adamc@1021
|
363 | ERecv (n, _) => box [string "Recv(",
|
adamc@1021
|
364 p_exp env n,
|
adamc@1021
|
365 string ")"]
|
adamc@1021
|
366 | ESleep n => box [string "Sleep(",
|
adamc@1021
|
367 p_exp env n,
|
adamc@1021
|
368 string ")"]
|
adamc@1021
|
369 | ESpawn n => box [string "Spawn(",
|
adamc@1021
|
370 p_exp env n,
|
adamc@1021
|
371 string ")"]
|
adamc@608
|
372
|
adamc@25
|
373 and p_exp env = p_exp' false env
|
adamc@25
|
374
|
adamc@126
|
375 fun p_vali env (x, n, t, e, s) =
|
adamc@126
|
376 let
|
adamc@126
|
377 val xp = if !debug then
|
adamc@126
|
378 box [string x,
|
adamc@126
|
379 string "__",
|
adamc@126
|
380 string (Int.toString n)]
|
adamc@126
|
381 else
|
adamc@126
|
382 string x
|
adamc@126
|
383 in
|
adamc@126
|
384 box [xp,
|
adamc@126
|
385 space,
|
adamc@126
|
386 string "as",
|
adamc@126
|
387 space,
|
adamc@126
|
388 string s,
|
adamc@126
|
389 space,
|
adamc@126
|
390 string ":",
|
adamc@126
|
391 space,
|
adamc@126
|
392 p_typ env t,
|
adamc@126
|
393 space,
|
adamc@126
|
394 string "=",
|
adamc@126
|
395 space,
|
adamc@126
|
396 p_exp env e]
|
adamc@126
|
397 end
|
adamc@126
|
398
|
adamc@164
|
399 fun p_datatype env (x, n, cons) =
|
adamc@164
|
400 let
|
adamc@168
|
401 val env = E.pushDatatype env x n cons
|
adamc@164
|
402 in
|
adamc@808
|
403 box [string x,
|
adamc@164
|
404 space,
|
adamc@164
|
405 string "=",
|
adamc@164
|
406 space,
|
adamc@164
|
407 p_list_sep (box [space, string "|", space])
|
adamc@164
|
408 (fn (x, n, NONE) => if !debug then (string (x ^ "__" ^ Int.toString n))
|
adamc@164
|
409 else string x
|
adamc@164
|
410 | (x, _, SOME t) => box [if !debug then (string (x ^ "__" ^ Int.toString n))
|
adamc@164
|
411 else string x, space, string "of", space, p_typ env t])
|
adamc@164
|
412 cons]
|
adamc@164
|
413 end
|
adamc@164
|
414
|
adamc@126
|
415 fun p_decl env (dAll as (d, _) : decl) =
|
adamc@25
|
416 case d of
|
adamc@808
|
417 DDatatype x => box [string "datatype",
|
adamc@808
|
418 space,
|
adamc@808
|
419 p_list_sep (box [space, string "and", space]) (p_datatype (E.declBinds env dAll)) x]
|
adamc@164
|
420 | DVal vi => box [string "val",
|
adamc@126
|
421 space,
|
adamc@126
|
422 p_vali env vi]
|
adamc@126
|
423 | DValRec vis =>
|
adamc@25
|
424 let
|
adamc@126
|
425 val env = E.declBinds env dAll
|
adamc@25
|
426 in
|
adamc@25
|
427 box [string "val",
|
adamc@25
|
428 space,
|
adamc@126
|
429 string "rec",
|
adamc@25
|
430 space,
|
adamc@126
|
431 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
|
adamc@25
|
432 end
|
adamc@109
|
433
|
adamc@1104
|
434 | DExport (ek, s, n, ts, t, _) => box [string "export",
|
adamc@1104
|
435 space,
|
adamc@1104
|
436 Export.p_export_kind ek,
|
adamc@1104
|
437 space,
|
adamc@1104
|
438 p_enamed env n,
|
adamc@1104
|
439 space,
|
adamc@1104
|
440 string "as",
|
adamc@1104
|
441 space,
|
adamc@1104
|
442 string s,
|
adamc@1104
|
443 p_list_sep (string "") (fn t => box [space,
|
adamc@1104
|
444 string "(",
|
adamc@1104
|
445 p_typ env t,
|
adamc@1104
|
446 string ")"]) ts,
|
adamc@1104
|
447 space,
|
adamc@1104
|
448 string "->",
|
adamc@1104
|
449 space,
|
adamc@1104
|
450 p_typ env t]
|
adamc@271
|
451
|
adamc@707
|
452 | DTable (s, xts, pe, ce) => box [string "(* SQL table ",
|
adamc@707
|
453 string s,
|
adamc@707
|
454 space,
|
adamc@707
|
455 string ":",
|
adamc@707
|
456 space,
|
adamc@707
|
457 p_list (fn (x, t) => box [string x,
|
adamc@707
|
458 space,
|
adamc@707
|
459 string ":",
|
adamc@707
|
460 space,
|
adamc@707
|
461 p_typ env t]) xts,
|
adamc@707
|
462 space,
|
adamc@707
|
463 string "keys",
|
adamc@707
|
464 space,
|
adamc@707
|
465 p_exp env pe,
|
adamc@707
|
466 space,
|
adamc@707
|
467 string "constraints",
|
adamc@707
|
468 space,
|
adamc@707
|
469 p_exp env ce,
|
adamc@707
|
470 space,
|
adamc@707
|
471 string "*)"]
|
adamc@338
|
472 | DSequence s => box [string "(* SQL sequence ",
|
adamc@338
|
473 string s,
|
adamc@338
|
474 string "*)"]
|
adamc@754
|
475 | DView (s, _, e) => box [string "(* SQL view ",
|
adamc@754
|
476 string s,
|
adamc@754
|
477 space,
|
adamc@754
|
478 string "as",
|
adamc@754
|
479 space,
|
adamc@754
|
480 p_exp env e,
|
adamc@754
|
481 string "*)"]
|
adamc@687
|
482 | DDatabase {name, expunge, initialize} => box [string "database",
|
adamc@687
|
483 space,
|
adamc@687
|
484 string name,
|
adamc@687
|
485 space,
|
adamc@687
|
486 string "(",
|
adamc@687
|
487 p_enamed env expunge,
|
adamc@687
|
488 string ",",
|
adamc@687
|
489 space,
|
adamc@687
|
490 p_enamed env initialize,
|
adamc@687
|
491 string ")"]
|
adamc@569
|
492 | DJavaScript s => box [string "JavaScript(",
|
adamc@569
|
493 string s,
|
adamc@569
|
494 string ")"]
|
adamc@569
|
495
|
adamc@725
|
496 | DCookie s => box [string "cookie",
|
adamc@725
|
497 space,
|
adamc@725
|
498 string s]
|
adamc@720
|
499 | DStyle s => box [string "style",
|
adamc@720
|
500 space,
|
adamc@720
|
501 string s]
|
adamc@1075
|
502 | DTask (e1, e2) => box [string "task",
|
adamc@1073
|
503 space,
|
adamc@1075
|
504 p_exp env e1,
|
adamc@1075
|
505 space,
|
adamc@1075
|
506 string "=",
|
adamc@1075
|
507 space,
|
adamc@1075
|
508 p_exp env e2]
|
adamc@718
|
509
|
adamc@100
|
510
|
adamc@25
|
511 fun p_file env file =
|
adamc@25
|
512 let
|
adamc@31
|
513 val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
|
adamc@31
|
514 (p_decl env d,
|
adamc@31
|
515 E.declBinds env d))
|
adamc@25
|
516 env file
|
adamc@25
|
517 in
|
adamc@25
|
518 p_list_sep newline (fn x => x) pds
|
adamc@25
|
519 end
|
adamc@25
|
520
|
adamc@25
|
521 end
|