Mercurial > urweb

annotate src/core_print.sml @ 1466:e2d7bd41f527

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remember to remove explicit table projections in SQLite UPDATE SET values
author Adam Chlipala <adam@chlipala.net>
date Mon, 30 May 2011 07:48:08 -0400
parents b4480a56cab7
children a99b743a3087
rev   line source
adamc@16 1 (* Copyright (c) 2008, Adam Chlipala
adamc@16 2 * All rights reserved.
adamc@16 3 *
adamc@16 4 * Redistribution and use in source and binary forms, with or without
adamc@16 5 * modification, are permitted provided that the following conditions are met:
adamc@16 6 *
adamc@16 7 * - Redistributions of source code must retain the above copyright notice,
adamc@16 8 * this list of conditions and the following disclaimer.
adamc@16 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@16 10 * this list of conditions and the following disclaimer in the documentation
adamc@16 11 * and/or other materials provided with the distribution.
adamc@16 12 * - The names of contributors may not be used to endorse or promote products
adamc@16 13 * derived from this software without specific prior written permission.
adamc@16 14 *
adamc@16 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@16 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@16 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@16 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@16 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@16 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@16 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@16 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@16 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@16 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@16 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@16 26 *)
adamc@16 27
adamc@244 28 (* Pretty-printing core Ur/Web *)
adamc@16 29
adamc@16 30 structure CorePrint :> CORE_PRINT = struct
adamc@16 31
adamc@16 32 open Print.PD
adamc@16 33 open Print
adamc@16 34
adamc@16 35 open Core
adamc@16 36
adamc@16 37 structure E = CoreEnv
adamc@16 38
adamc@16 39 val debug = ref false
adamc@16 40
adamc@626 41 fun p_kind' par env (k, _) =
adamc@16 42 case k of
adamc@16 43 KType => string "Type"
adamc@626 44 | KArrow (k1, k2) => parenIf par (box [p_kind' true env k1,
adamc@16 45 space,
adamc@16 46 string "->",
adamc@16 47 space,
adamc@626 48 p_kind env k2])
adamc@16 49 | KName => string "Name"
adamc@626 50 | KRecord k => box [string "{", p_kind env k, string "}"]
adamc@87 51 | KUnit => string "Unit"
adamc@214 52 | KTuple ks => box [string "(",
adamc@626 53 p_list_sep (box [space, string "*", space]) (p_kind env) ks,
adamc@214 54 string ")"]
adamc@16 55
adamc@626 56 | KRel n => ((if !debug then
adamc@626 57 string (E.lookupKRel env n ^ "_" ^ Int.toString n)
adamc@626 58 else
adamc@626 59 string (E.lookupKRel env n))
adamc@626 60 handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
adamc@626 61 | KFun (x, k) => box [string x,
adamc@626 62 space,
adamc@626 63 string "-->",
adamc@626 64 space,
adamc@626 65 p_kind (E.pushKRel env x) k]
adamc@626 66
adamc@626 67 and p_kind env = p_kind' false env
adamc@16 68
adamc@16 69 fun p_con' par env (c, _) =
adamc@16 70 case c of
adamc@16 71 TFun (t1, t2) => parenIf par (box [p_con' true env t1,
adamc@16 72 space,
adamc@16 73 string "->",
adamc@16 74 space,
adamc@16 75 p_con env t2])
adamc@16 76 | TCFun (x, k, c) => parenIf par (box [string x,
adamc@16 77 space,
adamc@16 78 string "::",
adamc@16 79 space,
adamc@626 80 p_kind env k,
adamc@16 81 space,
adamc@16 82 string "->",
adamc@16 83 space,
adamc@16 84 p_con (E.pushCRel env x k) c])
adamc@16 85 | TRecord (CRecord (_, xcs), _) => box [string "{",
adamc@16 86 p_list (fn (x, c) =>
adamc@20 87 box [p_name env x,
adamc@16 88 space,
adamc@16 89 string ":",
adamc@16 90 space,
adamc@16 91 p_con env c]) xcs,
adamc@16 92 string "}"]
adamc@16 93 | TRecord c => box [string "$",
adamc@16 94 p_con' true env c]
adamc@16 95
adamc@16 96 | CRel n =>
adamc@39 97 ((if !debug then
adamc@39 98 string (#1 (E.lookupCRel env n) ^ "_" ^ Int.toString n)
adamc@39 99 else
adamc@39 100 string (#1 (E.lookupCRel env n)))
adamc@39 101 handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
adamc@16 102 | CNamed n =>
adamc@39 103 ((if !debug then
adamc@39 104 string (#1 (E.lookupCNamed env n) ^ "__" ^ Int.toString n)
adamc@39 105 else
adamc@39 106 string (#1 (E.lookupCNamed env n)))
adamc@480 107 handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n))
adamc@48 108 | CFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
adamc@16 109
adamc@16 110 | CApp (c1, c2) => parenIf par (box [p_con env c1,
adamc@16 111 space,
adamc@16 112 p_con' true env c2])
adamc@16 113 | CAbs (x, k, c) => parenIf par (box [string "fn",
adamc@16 114 space,
adamc@16 115 string x,
adamc@16 116 space,
adamc@16 117 string "::",
adamc@16 118 space,
adamc@626 119 p_kind env k,
adamc@16 120 space,
adamc@16 121 string "=>",
adamc@16 122 space,
adamc@16 123 p_con (E.pushCRel env x k) c])
adamc@16 124
adamc@16 125 | CName s => box [string "#", string s]
adamc@16 126
adamc@16 127 | CRecord (k, xcs) =>
adamc@16 128 if !debug then
adamc@16 129 parenIf par (box [string "[",
adamc@16 130 p_list (fn (x, c) =>
adamc@16 131 box [p_con env x,
adamc@16 132 space,
adamc@16 133 string "=",
adamc@16 134 space,
adamc@16 135 p_con env c]) xcs,
adamc@16 136 string "]::",
adamc@626 137 p_kind env k])
adamc@16 138 else
adamc@16 139 parenIf par (box [string "[",
adamc@16 140 p_list (fn (x, c) =>
adamc@16 141 box [p_con env x,
adamc@16 142 space,
adamc@16 143 string "=",
adamc@16 144 space,
adamc@16 145 p_con env c]) xcs,
adamc@16 146 string "]"])
adamc@16 147 | CConcat (c1, c2) => parenIf par (box [p_con' true env c1,
adamc@16 148 space,
adamc@16 149 string "++",
adamc@16 150 space,
adamc@16 151 p_con env c2])
adamc@621 152 | CMap _ => string "map"
adamc@87 153 | CUnit => string "()"
adamc@214 154
adamc@214 155 | CTuple cs => box [string "(",
adamc@214 156 p_list (p_con env) cs,
adamc@214 157 string ")"]
adamc@214 158 | CProj (c, n) => box [p_con env c,
adamc@214 159 string ".",
adamc@214 160 string (Int.toString n)]
adamc@626 161
adamc@626 162 | CKAbs (x, c) => box [string x,
adamc@626 163 space,
adamc@626 164 string "==>",
adamc@626 165 space,
adamc@626 166 p_con (E.pushKRel env x) c]
adamc@626 167 | CKApp (c, k) => box [p_con env c,
adamc@626 168 string "[[",
adamc@626 169 p_kind env k,
adamc@626 170 string "]]"]
adamc@626 171 | TKFun (x, c) => box [string x,
adamc@626 172 space,
adamc@626 173 string "-->",
adamc@626 174 space,
adamc@626 175 p_con (E.pushKRel env x) c]
adamc@16 176
adamc@16 177 and p_con env = p_con' false env
adamc@16 178
adamc@20 179 and p_name env (all as (c, _)) =
adamc@20 180 case c of
adamc@20 181 CName s => string s
adamc@20 182 | _ => p_con env all
adamc@20 183
adamc@109 184 fun p_enamed env n =
adamc@109 185 (if !debug then
adamc@109 186 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
adamc@109 187 else
adamc@109 188 string (#1 (E.lookupENamed env n)))
adamc@109 189 handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n)
adamc@109 190
adamc@177 191 fun p_con_named env n =
adamc@177 192 (if !debug then
adamc@177 193 string (#1 (E.lookupConstructor env n) ^ "__" ^ Int.toString n)
adamc@177 194 else
adamc@177 195 string (#1 (E.lookupConstructor env n)))
adamc@177 196 handle E.UnboundNamed _ => string ("CONSTRUCTOR_" ^ Int.toString n)
adamc@177 197
adamc@177 198 fun p_patCon env pc =
adamc@177 199 case pc of
adamc@177 200 PConVar n => p_con_named env n
adamc@796 201 | PConFfi {mod = m, con, arg, params, ...} =>
adamc@757 202 if !debug then
adamc@757 203 box [string "FFIC[",
adamc@757 204 case arg of
adamc@757 205 NONE => box []
adamc@796 206 | SOME t =>
adamc@796 207 let
adamc@796 208 val k = (KType, ErrorMsg.dummySpan)
adamc@796 209 val env' = foldl (fn (x, env) => E.pushCRel env x k) env params
adamc@796 210 in
adamc@796 211 p_con env' t
adamc@796 212 end,
adamc@757 213 string "](",
adamc@757 214 string m,
adamc@757 215 string ".",
adamc@757 216 string con,
adamc@757 217 string ")"]
adamc@757 218 else
adamc@757 219 box [string "FFIC(",
adamc@757 220 string m,
adamc@757 221 string ".",
adamc@757 222 string con,
adamc@757 223 string ")"]
adamc@177 224
adamc@177 225 fun p_pat' par env (p, _) =
adamc@177 226 case p of
adamc@177 227 PWild => string "_"
adamc@182 228 | PVar (s, _) => string s
adamc@177 229 | PPrim p => Prim.p_t p
adamc@192 230 | PCon (_, n, _, NONE) => p_patCon env n
adamc@192 231 | PCon (_, n, _, SOME p) => parenIf par (box [p_patCon env n,
adamc@192 232 space,
adamc@192 233 p_pat' true env p])
adamc@177 234 | PRecord xps =>
adamc@177 235 box [string "{",
adamc@1272 236 p_list_sep (box [string ",", space]) (fn (x, p, t) =>
adamc@177 237 box [string x,
adamc@177 238 space,
adamc@177 239 string "=",
adamc@177 240 space,
adamc@1272 241 p_pat env p,
adamc@1272 242 if !debug then
adamc@1272 243 box [space,
adamc@1272 244 string ":",
adamc@1272 245 space,
adamc@1272 246 p_con env t]
adamc@1272 247 else
adamc@1272 248 box []]) xps,
adamc@177 249 string "}"]
adamc@177 250
adamc@177 251 and p_pat x = p_pat' false x
adamc@177 252
adamc@16 253 fun p_exp' par env (e, _) =
adamc@16 254 case e of
adamc@16 255 EPrim p => Prim.p_t p
adamc@16 256 | ERel n =>
adamc@39 257 ((if !debug then
adamc@39 258 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
adamc@39 259 else
adamc@39 260 string (#1 (E.lookupERel env n)))
adamc@39 261 handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
adamc@109 262 | ENamed n => p_enamed env n
adamc@194 263 | ECon (_, pc, ts, NONE) => box [string "[",
adamc@194 264 p_patCon env pc,
adamc@194 265 p_list_sep (box []) (fn t => box [space, string "[", p_con env t, string "]"]) ts,
adamc@194 266 string "]"]
adamc@194 267 | ECon (_, pc, ts, SOME e) => box [string "[",
adamc@193 268 p_patCon env pc,
adamc@193 269 space,
adamc@193 270 p_exp' true env e,
adamc@194 271 p_list_sep (box []) (fn t => box [space, string "[", p_con env t, string "]"]) ts,
adamc@193 272 string "]"]
adamc@48 273 | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
adamc@48 274 | EFfiApp (m, x, es) => box [string "FFI(",
adamc@48 275 string m,
adamc@48 276 string ".",
adamc@48 277 string x,
adamc@48 278 string "(",
adamc@48 279 p_list (p_exp env) es,
adamc@48 280 string "))"]
adamc@487 281 | EApp (e1, e2) => parenIf par (box [p_exp' true env e1,
adamc@16 282 space,
adamc@16 283 p_exp' true env e2])
adamc@26 284 | EAbs (x, t, _, e) => parenIf par (box [string "fn",
adamc@26 285 space,
adamc@26 286 string x,
adamc@26 287 space,
adamc@26 288 string ":",
adamc@26 289 space,
adamc@26 290 p_con env t,
adamc@26 291 space,
adamc@26 292 string "=>",
adamc@26 293 space,
adamc@26 294 p_exp (E.pushERel env x t) e])
adamc@16 295 | ECApp (e, c) => parenIf par (box [p_exp env e,
adamc@16 296 space,
adamc@16 297 string "[",
adamc@16 298 p_con env c,
adamc@16 299 string "]"])
adamc@16 300 | ECAbs (x, k, e) => parenIf par (box [string "fn",
adamc@16 301 space,
adamc@16 302 string x,
adamc@16 303 space,
adamc@16 304 string "::",
adamc@16 305 space,
adamc@626 306 p_kind env k,
adamc@16 307 space,
adamc@16 308 string "=>",
adamc@16 309 space,
adamc@16 310 p_exp (E.pushCRel env x k) e])
adamc@16 311
adamc@16 312 | ERecord xes => box [string "{",
adamc@29 313 p_list (fn (x, e, _) =>
adamc@21 314 box [p_name env x,
adamc@16 315 space,
adamc@16 316 string "=",
adamc@16 317 space,
adamc@16 318 p_exp env e]) xes,
adamc@16 319 string "}"]
adamc@16 320 | EField (e, c, {field, rest}) =>
adamc@16 321 if !debug then
adamc@16 322 box [p_exp' true env e,
adamc@16 323 string ".",
adamc@16 324 p_con' true env c,
adamc@16 325 space,
adamc@16 326 string "[",
adamc@16 327 p_con env field,
adamc@16 328 space,
adamc@16 329 string " in ",
adamc@16 330 space,
adamc@16 331 p_con env rest,
adamc@16 332 string "]"]
adamc@16 333 else
adamc@16 334 box [p_exp' true env e,
adamc@16 335 string ".",
adamc@16 336 p_con' true env c]
adamc@445 337 | EConcat (e1, c1, e2, c2) =>
adamc@339 338 parenIf par (if !debug then
adamc@445 339 box [p_exp' true env e1,
adamc@445 340 space,
adamc@445 341 string ":",
adamc@445 342 space,
adamc@445 343 p_con env c1,
adamc@445 344 space,
adamc@445 345 string "++",
adamc@445 346 space,
adamc@445 347 p_exp' true env e2,
adamc@445 348 space,
adamc@445 349 string ":",
adamc@445 350 space,
adamc@445 351 p_con env c2]
adamc@445 352 else
adamc@445 353 box [p_exp' true env e1,
adamc@339 354 space,
adamc@339 355 string "with",
adamc@339 356 space,
adamc@339 357 p_exp' true env e2])
adamc@149 358 | ECut (e, c, {field, rest}) =>
adamc@149 359 parenIf par (if !debug then
adamc@149 360 box [p_exp' true env e,
adamc@149 361 space,
adamc@149 362 string "--",
adamc@149 363 space,
adamc@149 364 p_con' true env c,
adamc@149 365 space,
adamc@149 366 string "[",
adamc@149 367 p_con env field,
adamc@149 368 space,
adamc@149 369 string " in ",
adamc@149 370 space,
adamc@149 371 p_con env rest,
adamc@149 372 string "]"]
adamc@149 373 else
adamc@149 374 box [p_exp' true env e,
adamc@149 375 space,
adamc@149 376 string "--",
adamc@149 377 space,
adamc@149 378 p_con' true env c])
adamc@493 379 | ECutMulti (e, c, {rest}) =>
adamc@493 380 parenIf par (if !debug then
adamc@493 381 box [p_exp' true env e,
adamc@493 382 space,
adamc@493 383 string "---",
adamc@493 384 space,
adamc@493 385 p_con' true env c,
adamc@493 386 space,
adamc@493 387 string "[",
adamc@493 388 p_con env rest,
adamc@493 389 string "]"]
adamc@493 390 else
adamc@493 391 box [p_exp' true env e,
adamc@493 392 space,
adamc@493 393 string "---",
adamc@493 394 space,
adamc@493 395 p_con' true env c])
adamc@16 396
adamc@288 397 | ECase (e, pes, {disc, result}) =>
adamc@288 398 parenIf par (box [string "case",
adamc@288 399 space,
adamc@288 400 p_exp env e,
adamc@288 401 space,
adamc@288 402 if !debug then
adamc@288 403 box [string "in",
adamc@288 404 space,
adamc@288 405 p_con env disc,
adamc@288 406 space,
adamc@288 407 string "return",
adamc@288 408 space,
adamc@288 409 p_con env result,
adamc@288 410 space]
adamc@288 411 else
adamc@288 412 box [],
adamc@288 413 string "of",
adamc@288 414 space,
adamc@288 415 p_list_sep (box [space, string "|", space])
adamc@288 416 (fn (p, e) => box [p_pat env p,
adamc@288 417 space,
adamc@288 418 string "=>",
adamc@288 419 space,
adamc@288 420 p_exp (E.patBinds env p) e]) pes])
adamc@177 421
adamc@102 422 | EWrite e => box [string "write(",
adamc@102 423 p_exp env e,
adamc@102 424 string ")"]
adamc@102 425
adamc@110 426 | EClosure (n, es) => box [string "CLOSURE(",
adamc@110 427 p_enamed env n,
adamc@110 428 p_list_sep (string "") (fn e => box [string ", ",
adamc@110 429 p_exp env e]) es,
adamc@110 430 string ")"]
adamc@110 431
adamc@450 432 | ELet (x, t, e1, e2) => box [string "let",
adamc@450 433 space,
adamc@450 434 string x,
adamc@450 435 space,
adamc@450 436 string ":",
adamc@910 437 space,
adamc@450 438 p_con env t,
adamc@450 439 space,
adamc@450 440 string "=",
adamc@450 441 space,
adamc@450 442 p_exp env e1,
adamc@450 443 space,
adamc@450 444 string "in",
adamc@450 445 newline,
adamc@450 446 p_exp (E.pushERel env x t) e2]
adamc@450 447
adamc@1020 448 | EServerCall (n, es, _) => box [string "Server(",
adamc@1020 449 p_enamed env n,
adamc@1020 450 string ",",
adamc@1020 451 space,
adamc@1020 452 p_list (p_exp env) es,
adamc@1020 453 string ")"]
adamc@607 454
adamc@626 455 | EKAbs (x, e) => box [string x,
adamc@626 456 space,
adamc@626 457 string "==>",
adamc@626 458 space,
adamc@626 459 p_exp (E.pushKRel env x) e]
adamc@626 460 | EKApp (e, k) => box [p_exp env e,
adamc@626 461 string "[[",
adamc@626 462 p_kind env k,
adamc@626 463 string "]]"]
adamc@626 464
adamc@16 465 and p_exp env = p_exp' false env
adamc@16 466
adamc@247 467 fun p_named x n =
adamc@247 468 if !debug then
adamc@247 469 box [string x,
adamc@247 470 string "__",
adamc@247 471 string (Int.toString n)]
adamc@247 472 else
adamc@247 473 string x
adamc@247 474
adamc@125 475 fun p_vali env (x, n, t, e, s) =
adamc@125 476 let
adamc@247 477 val xp = p_named x n
adamc@125 478 in
adamc@125 479 box [xp,
adamc@125 480 space,
adamc@125 481 string "as",
adamc@125 482 space,
adamc@125 483 string s,
adamc@125 484 space,
adamc@125 485 string ":",
adamc@125 486 space,
adamc@125 487 p_con env t,
adamc@125 488 space,
adamc@125 489 string "=",
adamc@125 490 space,
adamc@125 491 p_exp env e]
adamc@125 492 end
adamc@125 493
adamc@192 494 fun p_datatype env (x, n, xs, cons) =
adamc@163 495 let
adamc@192 496 val k = (KType, ErrorMsg.dummySpan)
adamc@163 497 val env = E.pushCNamed env x n (KType, ErrorMsg.dummySpan) NONE
adamc@192 498 val env = foldl (fn (x, env) => E.pushCRel env x k) env xs
adamc@193 499
adamc@193 500 val xp = if !debug then
adamc@193 501 string (x ^ "__" ^ Int.toString n)
adamc@193 502 else
adamc@193 503 string x
adamc@163 504 in
adamc@807 505 box [xp,
adamc@192 506 p_list_sep (box []) (fn x => box [space, string x]) xs,
adamc@163 507 space,
adamc@163 508 string "=",
adamc@163 509 space,
adamc@163 510 p_list_sep (box [space, string "|", space])
adamc@163 511 (fn (x, n, NONE) => if !debug then (string (x ^ "__" ^ Int.toString n))
adamc@163 512 else string x
adamc@193 513 | (x, n, SOME t) => box [if !debug then (string (x ^ "__" ^ Int.toString n))
adamc@163 514 else string x, space, string "of", space, p_con env t])
adamc@163 515 cons]
adamc@163 516 end
adamc@163 517
adamc@125 518 fun p_decl env (dAll as (d, _) : decl) =
adamc@16 519 case d of
adamc@16 520 DCon (x, n, k, c) =>
adamc@16 521 let
adamc@16 522 val xp = if !debug then
adamc@16 523 box [string x,
adamc@16 524 string "__",
adamc@16 525 string (Int.toString n)]
adamc@16 526 else
adamc@16 527 string x
adamc@16 528 in
adamc@16 529 box [string "con",
adamc@16 530 space,
adamc@16 531 xp,
adamc@16 532 space,
adamc@16 533 string "::",
adamc@16 534 space,
adamc@626 535 p_kind env k,
adamc@16 536 space,
adamc@16 537 string "=",
adamc@16 538 space,
adamc@16 539 p_con env c]
adamc@16 540 end
adamc@807 541 | DDatatype x => box [string "datatype",
adamc@807 542 space,
adamc@807 543 p_list_sep (box [space, string "and", space]) (p_datatype (E.declBinds env dAll)) x]
adamc@125 544 | DVal vi => box [string "val",
adamc@125 545 space,
adamc@125 546 p_vali env vi]
adamc@125 547 | DValRec vis =>
adamc@16 548 let
adamc@125 549 val env = E.declBinds env dAll
adamc@16 550 in
adamc@16 551 box [string "val",
adamc@16 552 space,
adamc@125 553 string "rec",
adamc@16 554 space,
adamc@125 555 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
adamc@16 556 end
adamc@1104 557 | DExport (ek, n, _) => box [string "export",
adamc@1104 558 space,
adamc@1104 559 Export.p_export_kind ek,
adamc@1104 560 space,
adamc@1104 561 p_enamed env n,
adamc@1104 562 space,
adamc@1104 563 string "as",
adamc@1104 564 space,
adamc@1104 565 (p_con env (#2 (E.lookupENamed env n))
adamc@1104 566 handle E.UnboundNamed _ => string "UNBOUND")]
adamc@707 567 | DTable (x, n, c, s, pe, _, ce, _) => box [string "table",
adamc@707 568 space,
adamc@707 569 p_named x n,
adamc@707 570 space,
adamc@707 571 string "as",
adamc@707 572 space,
adamc@707 573 string s,
adamc@707 574 space,
adamc@707 575 string ":",
adamc@707 576 space,
adamc@707 577 p_con env c,
adamc@707 578 space,
adamc@707 579 string "keys",
adamc@707 580 space,
adamc@707 581 p_exp env pe,
adamc@707 582 space,
adamc@707 583 string "constraints",
adamc@707 584 space,
adamc@802 585 p_exp (E.declBinds env dAll) ce]
adamc@338 586 | DSequence (x, n, s) => box [string "sequence",
adamc@338 587 space,
adamc@338 588 p_named x n,
adamc@338 589 space,
adamc@338 590 string "as",
adamc@338 591 space,
adamc@338 592 string s]
adamc@754 593 | DView (x, n, s, e, _) => box [string "view",
adamc@754 594 space,
adamc@754 595 p_named x n,
adamc@754 596 space,
adamc@754 597 string "as",
adamc@754 598 space,
adamc@754 599 p_exp env e]
adamc@271 600 | DDatabase s => box [string "database",
adamc@271 601 space,
adamc@271 602 string s]
adamc@461 603 | DCookie (x, n, c, s) => box [string "cookie",
adamc@461 604 space,
adamc@461 605 p_named x n,
adamc@461 606 space,
adamc@461 607 string "as",
adamc@461 608 space,
adamc@461 609 string s,
adamc@461 610 space,
adamc@461 611 string ":",
adamc@461 612 space,
adamc@461 613 p_con env c]
adamc@720 614 | DStyle (x, n, s) => box [string "style",
adamc@720 615 space,
adamc@720 616 p_named x n,
adamc@720 617 space,
adamc@720 618 string "as",
adamc@720 619 space,
adamc@720 620 string s]
adamc@1075 621 | DTask (e1, e2) => box [string "task",
adamc@1073 622 space,
adamc@1075 623 p_exp env e1,
adamc@1075 624 space,
adamc@1075 625 string "=",
adamc@1075 626 space,
adamc@1075 627 p_exp env e2]
adamc@1199 628 | DPolicy e1 => box [string "policy",
adamc@1199 629 space,
adamc@1199 630 p_exp env e1]
adam@1294 631 | DOnError _ => string "ONERROR"
adamc@16 632
adamc@16 633 fun p_file env file =
adamc@16 634 let
adamc@31 635 val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
adamc@31 636 (p_decl env d,
adamc@31 637 E.declBinds env d))
adamc@16 638 env file
adamc@16 639 in
adamc@16 640 p_list_sep newline (fn x => x) pds
adamc@16 641 end
adamc@16 642
adamc@16 643 end