Mercurial > urweb

annotate src/core_print.sml @ 1244:1eedc9086e6c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use key information in more places, and catch cases where one key completion depends on another having happened already
author Adam Chlipala <adamc@hcoop.net>
date Sun, 18 Apr 2010 13:00:36 -0400
parents c316ca3c9ec6
children 56bd4a4f6e66
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@182 236 p_list_sep (box [string ",", space]) (fn (x, p, _) =>
adamc@177 237 box [string x,
adamc@177 238 space,
adamc@177 239 string "=",
adamc@177 240 space,
adamc@177 241 p_pat env p]) xps,
adamc@177 242 string "}"]
adamc@177 243
adamc@177 244 and p_pat x = p_pat' false x
adamc@177 245
adamc@16 246 fun p_exp' par env (e, _) =
adamc@16 247 case e of
adamc@16 248 EPrim p => Prim.p_t p
adamc@16 249 | ERel n =>
adamc@39 250 ((if !debug then
adamc@39 251 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
adamc@39 252 else
adamc@39 253 string (#1 (E.lookupERel env n)))
adamc@39 254 handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
adamc@109 255 | ENamed n => p_enamed env n
adamc@194 256 | ECon (_, pc, ts, NONE) => box [string "[",
adamc@194 257 p_patCon env pc,
adamc@194 258 p_list_sep (box []) (fn t => box [space, string "[", p_con env t, string "]"]) ts,
adamc@194 259 string "]"]
adamc@194 260 | ECon (_, pc, ts, SOME e) => box [string "[",
adamc@193 261 p_patCon env pc,
adamc@193 262 space,
adamc@193 263 p_exp' true env e,
adamc@194 264 p_list_sep (box []) (fn t => box [space, string "[", p_con env t, string "]"]) ts,
adamc@193 265 string "]"]
adamc@48 266 | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
adamc@48 267 | EFfiApp (m, x, es) => box [string "FFI(",
adamc@48 268 string m,
adamc@48 269 string ".",
adamc@48 270 string x,
adamc@48 271 string "(",
adamc@48 272 p_list (p_exp env) es,
adamc@48 273 string "))"]
adamc@487 274 | EApp (e1, e2) => parenIf par (box [p_exp' true env e1,
adamc@16 275 space,
adamc@16 276 p_exp' true env e2])
adamc@26 277 | EAbs (x, t, _, e) => parenIf par (box [string "fn",
adamc@26 278 space,
adamc@26 279 string x,
adamc@26 280 space,
adamc@26 281 string ":",
adamc@26 282 space,
adamc@26 283 p_con env t,
adamc@26 284 space,
adamc@26 285 string "=>",
adamc@26 286 space,
adamc@26 287 p_exp (E.pushERel env x t) e])
adamc@16 288 | ECApp (e, c) => parenIf par (box [p_exp env e,
adamc@16 289 space,
adamc@16 290 string "[",
adamc@16 291 p_con env c,
adamc@16 292 string "]"])
adamc@16 293 | ECAbs (x, k, e) => parenIf par (box [string "fn",
adamc@16 294 space,
adamc@16 295 string x,
adamc@16 296 space,
adamc@16 297 string "::",
adamc@16 298 space,
adamc@626 299 p_kind env k,
adamc@16 300 space,
adamc@16 301 string "=>",
adamc@16 302 space,
adamc@16 303 p_exp (E.pushCRel env x k) e])
adamc@16 304
adamc@16 305 | ERecord xes => box [string "{",
adamc@29 306 p_list (fn (x, e, _) =>
adamc@21 307 box [p_name env x,
adamc@16 308 space,
adamc@16 309 string "=",
adamc@16 310 space,
adamc@16 311 p_exp env e]) xes,
adamc@16 312 string "}"]
adamc@16 313 | EField (e, c, {field, rest}) =>
adamc@16 314 if !debug then
adamc@16 315 box [p_exp' true env e,
adamc@16 316 string ".",
adamc@16 317 p_con' true env c,
adamc@16 318 space,
adamc@16 319 string "[",
adamc@16 320 p_con env field,
adamc@16 321 space,
adamc@16 322 string " in ",
adamc@16 323 space,
adamc@16 324 p_con env rest,
adamc@16 325 string "]"]
adamc@16 326 else
adamc@16 327 box [p_exp' true env e,
adamc@16 328 string ".",
adamc@16 329 p_con' true env c]
adamc@445 330 | EConcat (e1, c1, e2, c2) =>
adamc@339 331 parenIf par (if !debug then
adamc@445 332 box [p_exp' true env e1,
adamc@445 333 space,
adamc@445 334 string ":",
adamc@445 335 space,
adamc@445 336 p_con env c1,
adamc@445 337 space,
adamc@445 338 string "++",
adamc@445 339 space,
adamc@445 340 p_exp' true env e2,
adamc@445 341 space,
adamc@445 342 string ":",
adamc@445 343 space,
adamc@445 344 p_con env c2]
adamc@445 345 else
adamc@445 346 box [p_exp' true env e1,
adamc@339 347 space,
adamc@339 348 string "with",
adamc@339 349 space,
adamc@339 350 p_exp' true env e2])
adamc@149 351 | ECut (e, c, {field, rest}) =>
adamc@149 352 parenIf par (if !debug then
adamc@149 353 box [p_exp' true env e,
adamc@149 354 space,
adamc@149 355 string "--",
adamc@149 356 space,
adamc@149 357 p_con' true env c,
adamc@149 358 space,
adamc@149 359 string "[",
adamc@149 360 p_con env field,
adamc@149 361 space,
adamc@149 362 string " in ",
adamc@149 363 space,
adamc@149 364 p_con env rest,
adamc@149 365 string "]"]
adamc@149 366 else
adamc@149 367 box [p_exp' true env e,
adamc@149 368 space,
adamc@149 369 string "--",
adamc@149 370 space,
adamc@149 371 p_con' true env c])
adamc@493 372 | ECutMulti (e, c, {rest}) =>
adamc@493 373 parenIf par (if !debug then
adamc@493 374 box [p_exp' true env e,
adamc@493 375 space,
adamc@493 376 string "---",
adamc@493 377 space,
adamc@493 378 p_con' true env c,
adamc@493 379 space,
adamc@493 380 string "[",
adamc@493 381 p_con env rest,
adamc@493 382 string "]"]
adamc@493 383 else
adamc@493 384 box [p_exp' true env e,
adamc@493 385 space,
adamc@493 386 string "---",
adamc@493 387 space,
adamc@493 388 p_con' true env c])
adamc@16 389
adamc@288 390 | ECase (e, pes, {disc, result}) =>
adamc@288 391 parenIf par (box [string "case",
adamc@288 392 space,
adamc@288 393 p_exp env e,
adamc@288 394 space,
adamc@288 395 if !debug then
adamc@288 396 box [string "in",
adamc@288 397 space,
adamc@288 398 p_con env disc,
adamc@288 399 space,
adamc@288 400 string "return",
adamc@288 401 space,
adamc@288 402 p_con env result,
adamc@288 403 space]
adamc@288 404 else
adamc@288 405 box [],
adamc@288 406 string "of",
adamc@288 407 space,
adamc@288 408 p_list_sep (box [space, string "|", space])
adamc@288 409 (fn (p, e) => box [p_pat env p,
adamc@288 410 space,
adamc@288 411 string "=>",
adamc@288 412 space,
adamc@288 413 p_exp (E.patBinds env p) e]) pes])
adamc@177 414
adamc@102 415 | EWrite e => box [string "write(",
adamc@102 416 p_exp env e,
adamc@102 417 string ")"]
adamc@102 418
adamc@110 419 | EClosure (n, es) => box [string "CLOSURE(",
adamc@110 420 p_enamed env n,
adamc@110 421 p_list_sep (string "") (fn e => box [string ", ",
adamc@110 422 p_exp env e]) es,
adamc@110 423 string ")"]
adamc@110 424
adamc@450 425 | ELet (x, t, e1, e2) => box [string "let",
adamc@450 426 space,
adamc@450 427 string x,
adamc@450 428 space,
adamc@450 429 string ":",
adamc@910 430 space,
adamc@450 431 p_con env t,
adamc@450 432 space,
adamc@450 433 string "=",
adamc@450 434 space,
adamc@450 435 p_exp env e1,
adamc@450 436 space,
adamc@450 437 string "in",
adamc@450 438 newline,
adamc@450 439 p_exp (E.pushERel env x t) e2]
adamc@450 440
adamc@1020 441 | EServerCall (n, es, _) => box [string "Server(",
adamc@1020 442 p_enamed env n,
adamc@1020 443 string ",",
adamc@1020 444 space,
adamc@1020 445 p_list (p_exp env) es,
adamc@1020 446 string ")"]
adamc@607 447
adamc@626 448 | EKAbs (x, e) => box [string x,
adamc@626 449 space,
adamc@626 450 string "==>",
adamc@626 451 space,
adamc@626 452 p_exp (E.pushKRel env x) e]
adamc@626 453 | EKApp (e, k) => box [p_exp env e,
adamc@626 454 string "[[",
adamc@626 455 p_kind env k,
adamc@626 456 string "]]"]
adamc@626 457
adamc@16 458 and p_exp env = p_exp' false env
adamc@16 459
adamc@247 460 fun p_named x n =
adamc@247 461 if !debug then
adamc@247 462 box [string x,
adamc@247 463 string "__",
adamc@247 464 string (Int.toString n)]
adamc@247 465 else
adamc@247 466 string x
adamc@247 467
adamc@125 468 fun p_vali env (x, n, t, e, s) =
adamc@125 469 let
adamc@247 470 val xp = p_named x n
adamc@125 471 in
adamc@125 472 box [xp,
adamc@125 473 space,
adamc@125 474 string "as",
adamc@125 475 space,
adamc@125 476 string s,
adamc@125 477 space,
adamc@125 478 string ":",
adamc@125 479 space,
adamc@125 480 p_con env t,
adamc@125 481 space,
adamc@125 482 string "=",
adamc@125 483 space,
adamc@125 484 p_exp env e]
adamc@125 485 end
adamc@125 486
adamc@192 487 fun p_datatype env (x, n, xs, cons) =
adamc@163 488 let
adamc@192 489 val k = (KType, ErrorMsg.dummySpan)
adamc@163 490 val env = E.pushCNamed env x n (KType, ErrorMsg.dummySpan) NONE
adamc@192 491 val env = foldl (fn (x, env) => E.pushCRel env x k) env xs
adamc@193 492
adamc@193 493 val xp = if !debug then
adamc@193 494 string (x ^ "__" ^ Int.toString n)
adamc@193 495 else
adamc@193 496 string x
adamc@163 497 in
adamc@807 498 box [xp,
adamc@192 499 p_list_sep (box []) (fn x => box [space, string x]) xs,
adamc@163 500 space,
adamc@163 501 string "=",
adamc@163 502 space,
adamc@163 503 p_list_sep (box [space, string "|", space])
adamc@163 504 (fn (x, n, NONE) => if !debug then (string (x ^ "__" ^ Int.toString n))
adamc@163 505 else string x
adamc@193 506 | (x, n, SOME t) => box [if !debug then (string (x ^ "__" ^ Int.toString n))
adamc@163 507 else string x, space, string "of", space, p_con env t])
adamc@163 508 cons]
adamc@163 509 end
adamc@163 510
adamc@125 511 fun p_decl env (dAll as (d, _) : decl) =
adamc@16 512 case d of
adamc@16 513 DCon (x, n, k, c) =>
adamc@16 514 let
adamc@16 515 val xp = if !debug then
adamc@16 516 box [string x,
adamc@16 517 string "__",
adamc@16 518 string (Int.toString n)]
adamc@16 519 else
adamc@16 520 string x
adamc@16 521 in
adamc@16 522 box [string "con",
adamc@16 523 space,
adamc@16 524 xp,
adamc@16 525 space,
adamc@16 526 string "::",
adamc@16 527 space,
adamc@626 528 p_kind env k,
adamc@16 529 space,
adamc@16 530 string "=",
adamc@16 531 space,
adamc@16 532 p_con env c]
adamc@16 533 end
adamc@807 534 | DDatatype x => box [string "datatype",
adamc@807 535 space,
adamc@807 536 p_list_sep (box [space, string "and", space]) (p_datatype (E.declBinds env dAll)) x]
adamc@125 537 | DVal vi => box [string "val",
adamc@125 538 space,
adamc@125 539 p_vali env vi]
adamc@125 540 | DValRec vis =>
adamc@16 541 let
adamc@125 542 val env = E.declBinds env dAll
adamc@16 543 in
adamc@16 544 box [string "val",
adamc@16 545 space,
adamc@125 546 string "rec",
adamc@16 547 space,
adamc@125 548 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
adamc@16 549 end
adamc@1104 550 | DExport (ek, n, _) => box [string "export",
adamc@1104 551 space,
adamc@1104 552 Export.p_export_kind ek,
adamc@1104 553 space,
adamc@1104 554 p_enamed env n,
adamc@1104 555 space,
adamc@1104 556 string "as",
adamc@1104 557 space,
adamc@1104 558 (p_con env (#2 (E.lookupENamed env n))
adamc@1104 559 handle E.UnboundNamed _ => string "UNBOUND")]
adamc@707 560 | DTable (x, n, c, s, pe, _, ce, _) => box [string "table",
adamc@707 561 space,
adamc@707 562 p_named x n,
adamc@707 563 space,
adamc@707 564 string "as",
adamc@707 565 space,
adamc@707 566 string s,
adamc@707 567 space,
adamc@707 568 string ":",
adamc@707 569 space,
adamc@707 570 p_con env c,
adamc@707 571 space,
adamc@707 572 string "keys",
adamc@707 573 space,
adamc@707 574 p_exp env pe,
adamc@707 575 space,
adamc@707 576 string "constraints",
adamc@707 577 space,
adamc@802 578 p_exp (E.declBinds env dAll) ce]
adamc@338 579 | DSequence (x, n, s) => box [string "sequence",
adamc@338 580 space,
adamc@338 581 p_named x n,
adamc@338 582 space,
adamc@338 583 string "as",
adamc@338 584 space,
adamc@338 585 string s]
adamc@754 586 | DView (x, n, s, e, _) => box [string "view",
adamc@754 587 space,
adamc@754 588 p_named x n,
adamc@754 589 space,
adamc@754 590 string "as",
adamc@754 591 space,
adamc@754 592 p_exp env e]
adamc@271 593 | DDatabase s => box [string "database",
adamc@271 594 space,
adamc@271 595 string s]
adamc@461 596 | DCookie (x, n, c, s) => box [string "cookie",
adamc@461 597 space,
adamc@461 598 p_named x n,
adamc@461 599 space,
adamc@461 600 string "as",
adamc@461 601 space,
adamc@461 602 string s,
adamc@461 603 space,
adamc@461 604 string ":",
adamc@461 605 space,
adamc@461 606 p_con env c]
adamc@720 607 | DStyle (x, n, s) => box [string "style",
adamc@720 608 space,
adamc@720 609 p_named x n,
adamc@720 610 space,
adamc@720 611 string "as",
adamc@720 612 space,
adamc@720 613 string s]
adamc@1075 614 | DTask (e1, e2) => box [string "task",
adamc@1073 615 space,
adamc@1075 616 p_exp env e1,
adamc@1075 617 space,
adamc@1075 618 string "=",
adamc@1075 619 space,
adamc@1075 620 p_exp env e2]
adamc@1199 621 | DPolicy e1 => box [string "policy",
adamc@1199 622 space,
adamc@1199 623 p_exp env e1]
adamc@16 624
adamc@16 625 fun p_file env file =
adamc@16 626 let
adamc@31 627 val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
adamc@31 628 (p_decl env d,
adamc@31 629 E.declBinds env d))
adamc@16 630 env file
adamc@16 631 in
adamc@16 632 p_list_sep newline (fn x => x) pds
adamc@16 633 end
adamc@16 634
adamc@16 635 end