Mercurial > urweb

annotate src/core_print.sml @ 709:0406e9cccb72

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