Mercurial > urweb

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