Mercurial > urweb

annotate src/source_print.sml @ 1611:217384f4b8ea

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tweak error message about Basis.get to use that name instead of internal name
author Adam Chlipala <adam@chlipala.net>
date Thu, 24 Nov 2011 11:56:05 -0500
parents b4480a56cab7
children 4a03aa3251cb
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@822 210 | PAnnot (p, t) => box [p_pat p,
adamc@822 211 space,
adamc@822 212 string ":",
adamc@822 213 space,
adamc@822 214 p_con t]
adamc@822 215
adamc@174 216 and p_pat x = p_pat' false x
adamc@170 217
adamc@8 218 fun p_exp' par (e, _) =
adamc@8 219 case e of
adamc@8 220 EAnnot (e, t) => box [string "(",
adamc@8 221 p_exp e,
adamc@8 222 space,
adamc@8 223 string ":",
adamc@8 224 space,
adamc@8 225 p_con t,
adamc@8 226 string ")"]
adamc@8 227
adamc@14 228 | EPrim p => Prim.p_t p
adamc@403 229 | EVar (ss, s, _) => p_list_sep (string ".") string (ss @ [s])
adamc@8 230 | EApp (e1, e2) => parenIf par (box [p_exp e1,
adamc@8 231 space,
adamc@8 232 p_exp' true e2])
adamc@8 233 | EAbs (x, NONE, e) => parenIf par (box [string "fn",
adamc@8 234 space,
adamc@8 235 string x,
adamc@8 236 space,
adamc@8 237 string "=>",
adamc@8 238 space,
adamc@8 239 p_exp e])
adamc@8 240 | EAbs (x, SOME t, e) => parenIf par (box [string "fn",
adamc@8 241 space,
adamc@8 242 string x,
adamc@8 243 space,
adamc@8 244 string ":",
adamc@8 245 space,
adamc@8 246 p_con t,
adamc@8 247 space,
adamc@8 248 string "=>",
adamc@8 249 space,
adamc@8 250 p_exp e])
adamc@8 251 | ECApp (e, c) => parenIf par (box [p_exp e,
adamc@8 252 space,
adamc@8 253 string "[",
adamc@8 254 p_con c,
adamc@8 255 string "]"])
adamc@8 256 | ECAbs (exp, x, k, e) => parenIf par (box [string "fn",
adamc@8 257 space,
adamc@8 258 string x,
adamc@8 259 space,
adamc@8 260 p_explicitness exp,
adamc@8 261 space,
adamc@8 262 p_kind k,
adamc@8 263 space,
adamc@8 264 string "=>",
adamc@8 265 space,
adamc@8 266 p_exp e])
adamc@85 267 | EDisjoint (c1, c2, e) => parenIf par (box [p_con c1,
adamc@85 268 space,
adamc@85 269 string "~",
adamc@85 270 space,
adamc@85 271 p_con c2,
adamc@85 272 space,
adamc@85 273 string "=>",
adamc@85 274 space,
adamc@85 275 p_exp e])
adamc@629 276 | EDisjointApp e => parenIf par (box [p_exp e,
adamc@629 277 space,
adamc@629 278 string "!"])
adamc@8 279
adamc@12 280 | ERecord xes => box [string "{",
adamc@12 281 p_list (fn (x, e) =>
adamc@21 282 box [p_name x,
adamc@12 283 space,
adamc@12 284 string "=",
adamc@12 285 space,
adamc@12 286 p_exp e]) xes,
adamc@12 287 string "}"]
adamc@12 288 | EField (e, c) => box [p_exp' true e,
adamc@12 289 string ".",
adamc@12 290 p_con' true c]
adamc@445 291 | EConcat (e1, e2) => parenIf par (box [p_exp' true e1,
adamc@445 292 space,
adamc@445 293 string "++",
adamc@445 294 space,
adamc@445 295 p_exp' true e2])
adamc@149 296 | ECut (e, c) => parenIf par (box [p_exp' true e,
adamc@149 297 space,
adamc@149 298 string "--",
adamc@149 299 space,
adamc@149 300 p_con' true c])
adamc@493 301 | ECutMulti (e, c) => parenIf par (box [p_exp' true e,
adamc@493 302 space,
adamc@493 303 string "---",
adamc@493 304 space,
adamc@493 305 p_con' true c])
adamc@170 306 | ECase (e, pes) => parenIf par (box [string "case",
adamc@170 307 space,
adamc@171 308 p_exp e,
adamc@170 309 space,
adamc@170 310 string "of",
adamc@170 311 space,
adamc@170 312 p_list_sep (box [space, string "|", space])
adamc@170 313 (fn (p, e) => box [p_pat p,
adamc@170 314 space,
adamc@170 315 string "=>",
adamc@170 316 space,
adamc@170 317 p_exp e]) pes])
adamc@170 318
adamc@219 319 | EWild => string "_"
adamc@210 320
adamc@446 321 | ELet (ds, e) => box [string "let",
adamc@446 322 newline,
adamc@446 323 box [p_list_sep newline p_edecl ds],
adamc@446 324 newline,
adamc@446 325 string "in",
adamc@446 326 newline,
adamc@446 327 box [p_exp e],
adamc@446 328 newline,
adamc@446 329 string "end"]
adamc@446 330
adamc@623 331 | EKAbs (x, e) => box [string x,
adamc@623 332 space,
adamc@623 333 string "-->",
adamc@623 334 space,
adamc@623 335 p_exp e]
adamc@623 336
adamc@8 337 and p_exp e = p_exp' false e
adamc@8 338
adamc@446 339 and p_edecl (d, _) =
adamc@446 340 case d of
adamc@825 341 EDVal (p, e) => box [string "val",
adamc@825 342 space,
adamc@825 343 p_pat p,
adamc@825 344 space,
adamc@825 345 string "=",
adamc@825 346 space,
adamc@825 347 p_exp e]
adamc@446 348 | EDValRec vis => box [string "val",
adamc@446 349 space,
adamc@446 350 string "rec",
adamc@446 351 space,
adamc@446 352 p_list_sep (box [newline, string "and", space]) p_vali vis]
adamc@446 353
adamc@446 354 and p_vali (x, co, e) =
adamc@446 355 case co of
adamc@446 356 NONE => box [string x,
adamc@446 357 space,
adamc@446 358 string "=",
adamc@446 359 space,
adamc@446 360 p_exp e]
adamc@446 361 | SOME t => box [string x,
adamc@446 362 space,
adamc@446 363 string ":",
adamc@446 364 space,
adamc@446 365 p_con t,
adamc@446 366 space,
adamc@446 367 string "=",
adamc@446 368 space,
adamc@446 369 p_exp e]
adamc@446 370
adamc@446 371
adamc@191 372 fun p_datatype (x, xs, cons) =
adamc@805 373 box [string x,
adamc@191 374 p_list_sep (box []) (fn x => box [space, string x]) xs,
adamc@156 375 space,
adamc@156 376 string "=",
adamc@156 377 space,
adamc@156 378 p_list_sep (box [space, string "|", space])
adamc@156 379 (fn (x, NONE) => string x
adamc@156 380 | (x, SOME t) => box [string x, space, string "of", space, p_con t])
adamc@156 381 cons]
adamc@156 382
adamc@30 383 fun p_sgn_item (sgi, _) =
adamc@30 384 case sgi of
adamc@30 385 SgiConAbs (x, k) => box [string "con",
adamc@30 386 space,
adamc@30 387 string x,
adamc@30 388 space,
adamc@30 389 string "::",
adamc@30 390 space,
adamc@30 391 p_kind k]
adamc@30 392 | SgiCon (x, NONE, c) => box [string "con",
adamc@30 393 space,
adamc@30 394 string x,
adamc@30 395 space,
adamc@30 396 string "=",
adamc@30 397 space,
adamc@30 398 p_con c]
adamc@30 399 | SgiCon (x, SOME k, c) => box [string "con",
adamc@30 400 space,
adamc@30 401 string x,
adamc@30 402 space,
adamc@30 403 string "::",
adamc@30 404 space,
adamc@30 405 p_kind k,
adamc@30 406 space,
adamc@30 407 string "=",
adamc@30 408 space,
adamc@30 409 p_con c]
adamc@805 410 | SgiDatatype x => box [string "datatype",
adamc@805 411 space,
adamc@805 412 p_list_sep (box [space, string "and", space]) p_datatype x]
adamc@156 413 | SgiDatatypeImp (x, ms, x') =>
adamc@156 414 box [string "datatype",
adamc@156 415 space,
adamc@156 416 string x,
adamc@156 417 space,
adamc@156 418 string "=",
adamc@156 419 space,
adamc@156 420 string "datatype",
adamc@156 421 space,
adamc@156 422 p_list_sep (string ".") string (ms @ [x'])]
adamc@30 423 | SgiVal (x, c) => box [string "val",
adamc@30 424 space,
adamc@30 425 string x,
adamc@30 426 space,
adamc@30 427 string ":",
adamc@30 428 space,
adamc@30 429 p_con c]
adamc@707 430 | SgiTable (x, c, pe, ce) => box [string "table",
adamc@707 431 space,
adamc@707 432 string x,
adamc@707 433 space,
adamc@707 434 string ":",
adamc@707 435 space,
adamc@707 436 p_con c,
adamc@707 437 space,
adamc@707 438 string "keys",
adamc@707 439 space,
adamc@707 440 p_exp pe,
adamc@707 441 space,
adamc@707 442 string "constraints",
adamc@707 443 space,
adamc@707 444 p_exp ce]
adamc@30 445 | SgiStr (x, sgn) => box [string "structure",
adamc@30 446 space,
adamc@30 447 string x,
adamc@30 448 space,
adamc@30 449 string ":",
adamc@30 450 space,
adamc@30 451 p_sgn sgn]
adamc@59 452 | SgiSgn (x, sgn) => box [string "signature",
adamc@59 453 space,
adamc@59 454 string x,
adamc@59 455 space,
adamc@59 456 string "=",
adamc@59 457 space,
adamc@59 458 p_sgn sgn]
adamc@58 459 | SgiInclude sgn => box [string "include",
adamc@58 460 space,
adamc@58 461 p_sgn sgn]
adamc@88 462 | SgiConstraint (c1, c2) => box [string "constraint",
adamc@88 463 space,
adamc@88 464 p_con c1,
adamc@88 465 space,
adamc@88 466 string "~",
adamc@88 467 space,
adamc@88 468 p_con c2]
adamc@563 469 | SgiClassAbs (x, k) => box [string "class",
adamc@563 470 space,
adamc@563 471 string x,
adamc@563 472 space,
adamc@563 473 string "::",
adamc@563 474 space,
adamc@563 475 p_kind k]
adamc@563 476 | SgiClass (x, k, c) => box [string "class",
adamc@563 477 space,
adamc@563 478 string x,
adamc@563 479 space,
adamc@563 480 string "::",
adamc@563 481 space,
adamc@563 482 p_kind k,
adamc@563 483 space,
adamc@563 484 string "=",
adamc@563 485 space,
adamc@563 486 p_con c]
adamc@563 487
adamc@30 488 and p_sgn (sgn, _) =
adamc@30 489 case sgn of
adamc@30 490 SgnConst sgis => box [string "sig",
adamc@30 491 newline,
adamc@30 492 p_list_sep newline p_sgn_item sgis,
adamc@30 493 newline,
adamc@30 494 string "end"]
adamc@30 495 | SgnVar x => string x
adamc@40 496 | SgnFun (x, sgn, sgn') => box [string "functor",
adamc@40 497 space,
adamc@40 498 string "(",
adamc@40 499 string x,
adamc@40 500 space,
adamc@40 501 string ":",
adamc@40 502 p_sgn sgn,
adamc@40 503 string ")",
adamc@40 504 space,
adamc@40 505 string ":",
adamc@40 506 space,
adamc@40 507 p_sgn sgn']
adamc@42 508 | SgnWhere (sgn, x, c) => box [p_sgn sgn,
adamc@42 509 space,
adamc@42 510 string "where",
adamc@42 511 space,
adamc@42 512 string "con",
adamc@42 513 space,
adamc@42 514 string x,
adamc@42 515 space,
adamc@42 516 string "=",
adamc@42 517 space,
adamc@42 518 p_con c]
adamc@59 519 | SgnProj (m, ms, x) => p_list_sep (string ".") string (m :: ms @ [x])
adamc@59 520
adamc@42 521
adamc@123 522
adamc@1 523 fun p_decl ((d, _) : decl) =
adamc@1 524 case d of
adamc@1 525 DCon (x, NONE, c) => box [string "con",
adamc@1 526 space,
adamc@1 527 string x,
adamc@1 528 space,
adamc@1 529 string "=",
adamc@1 530 space,
adamc@1 531 p_con c]
adamc@1 532 | DCon (x, SOME k, c) => box [string "con",
adamc@1 533 space,
adamc@1 534 string x,
adamc@1 535 space,
adamc@1 536 string "::",
adamc@1 537 space,
adamc@1 538 p_kind k,
adamc@1 539 space,
adamc@1 540 string "=",
adamc@1 541 space,
adamc@1 542 p_con c]
adamc@805 543 | DDatatype x => box [string "datatype",
adamc@805 544 space,
adamc@805 545 p_list_sep (box [space, string "and", space]) p_datatype x]
adamc@156 546 | DDatatypeImp (x, ms, x') =>
adamc@156 547 box [string "datatype",
adamc@156 548 space,
adamc@156 549 string x,
adamc@156 550 space,
adamc@156 551 string "=",
adamc@156 552 space,
adamc@156 553 string "datatype",
adamc@156 554 space,
adamc@156 555 p_list_sep (string ".") string (ms @ [x'])]
adamc@123 556 | DVal vi => box [string "val",
adamc@123 557 space,
adamc@123 558 p_vali vi]
adamc@123 559 | DValRec vis => box [string "val",
adamc@123 560 space,
adamc@123 561 string "rec",
adamc@123 562 space,
adamc@123 563 p_list_sep (box [newline, string "and", space]) p_vali vis]
adamc@1 564
adamc@30 565 | DSgn (x, sgn) => box [string "signature",
adamc@30 566 space,
adamc@30 567 string x,
adamc@30 568 space,
adamc@30 569 string "=",
adamc@30 570 space,
adamc@30 571 p_sgn sgn]
adamc@30 572 | DStr (x, NONE, str) => box [string "structure",
adamc@30 573 space,
adamc@30 574 string x,
adamc@30 575 space,
adamc@30 576 string "=",
adamc@30 577 space,
adamc@30 578 p_str str]
adamc@30 579 | DStr (x, SOME sgn, str) => box [string "structure",
adamc@30 580 space,
adamc@30 581 string x,
adamc@30 582 space,
adamc@30 583 string ":",
adamc@30 584 space,
adamc@30 585 p_sgn sgn,
adamc@30 586 space,
adamc@30 587 string "=",
adamc@30 588 space,
adamc@30 589 p_str str]
adamc@48 590 | DFfiStr (x, sgn) => box [string "extern",
adamc@48 591 space,
adamc@48 592 string "structure",
adamc@48 593 space,
adamc@48 594 string x,
adamc@48 595 space,
adamc@48 596 string ":",
adamc@48 597 space,
adamc@48 598 p_sgn sgn]
adamc@61 599 | DOpen (m, ms) => box [string "open",
adamc@61 600 space,
adamc@61 601 p_list_sep (string ".") string (m :: ms)]
adamc@88 602 | DConstraint (c1, c2) => box [string "constraint",
adamc@88 603 space,
adamc@88 604 p_con c1,
adamc@88 605 space,
adamc@88 606 string "~",
adamc@88 607 space,
adamc@88 608 p_con c2]
adamc@88 609 | DOpenConstraints (m, ms) => box [string "open",
adamc@88 610 space,
adamc@88 611 string "constraints",
adamc@88 612 space,
adamc@88 613 p_list_sep (string ".") string (m :: ms)]
adamc@30 614
adamc@109 615 | DExport str => box [string "export",
adamc@109 616 space,
adamc@109 617 p_str str]
adamc@707 618 | DTable (x, c, pe, ce) => box [string "table",
adamc@707 619 space,
adamc@707 620 string x,
adamc@707 621 space,
adamc@707 622 string ":",
adamc@707 623 space,
adamc@707 624 p_con c,
adamc@707 625 space,
adamc@707 626 string "keys",
adamc@707 627 space,
adamc@707 628 p_exp pe,
adamc@707 629 space,
adamc@707 630 string "constraints",
adamc@707 631 space,
adamc@707 632 p_exp ce]
adamc@338 633 | DSequence x => box [string "sequence",
adamc@338 634 space,
adamc@338 635 string x]
adamc@754 636 | DView (x, e) => box [string "view",
adamc@754 637 space,
adamc@754 638 string x,
adamc@754 639 space,
adamc@754 640 string "=",
adamc@754 641 space,
adamc@754 642 p_exp e]
adamc@563 643 | DClass (x, k, c) => box [string "class",
adamc@563 644 space,
adamc@563 645 string x,
adamc@563 646 space,
adamc@563 647 string "=",
adamc@563 648 space,
adamc@563 649 p_con c]
adamc@100 650
adamc@271 651 | DDatabase s => box [string "database",
adamc@271 652 space,
adamc@271 653 string s]
adamc@271 654
adamc@459 655 | DCookie (x, c) => box [string "cookie",
adamc@459 656 space,
adamc@459 657 string x,
adamc@459 658 space,
adamc@459 659 string ":",
adamc@459 660 space,
adamc@459 661 p_con c]
adamc@720 662 | DStyle x => box [string "style",
adamc@720 663 space,
adamc@720 664 string x]
adamc@1075 665 | DTask (e1, e2) => box [string "task",
adamc@1073 666 space,
adamc@1075 667 p_exp e1,
adamc@1075 668 space,
adamc@1075 669 string "=",
adamc@1075 670 space,
adamc@1075 671 p_exp e2]
adamc@1199 672 | DPolicy e1 => box [string "policy",
adamc@1199 673 space,
adamc@1199 674 p_exp e1]
adam@1294 675 | DOnError _ => string "ONERROR"
adamc@459 676
adamc@30 677 and p_str (str, _) =
adamc@30 678 case str of
adamc@30 679 StrConst ds => box [string "struct",
adamc@30 680 newline,
adamc@30 681 p_list_sep newline p_decl ds,
adamc@30 682 newline,
adamc@30 683 string "end"]
adamc@30 684 | StrVar x => string x
adamc@34 685 | StrProj (str, x) => box [p_str str,
adamc@34 686 string ".",
adamc@34 687 string x]
adamc@40 688 | StrFun (x, sgn, NONE, str) => box [string "functor",
adamc@40 689 space,
adamc@40 690 string "(",
adamc@40 691 string x,
adamc@40 692 space,
adamc@40 693 string ":",
adamc@40 694 p_sgn sgn,
adamc@40 695 string ")",
adamc@40 696 space,
adamc@40 697 string "=>",
adamc@40 698 space,
adamc@40 699 p_str str]
adamc@40 700 | StrFun (x, sgn, SOME sgn', str) => box [string "functor",
adamc@40 701 space,
adamc@40 702 string "(",
adamc@40 703 string x,
adamc@40 704 space,
adamc@40 705 string ":",
adamc@40 706 p_sgn sgn,
adamc@40 707 string ")",
adamc@40 708 space,
adamc@40 709 string ":",
adamc@40 710 space,
adamc@40 711 p_sgn sgn',
adamc@40 712 space,
adamc@40 713 string "=>",
adamc@40 714 space,
adamc@40 715 p_str str]
adamc@44 716 | StrApp (str1, str2) => box [p_str str1,
adamc@44 717 string "(",
adamc@44 718 p_str str2,
adamc@44 719 string ")"]
adamc@30 720
adamc@1 721 val p_file = p_list_sep newline p_decl
adamc@1 722
adamc@1 723 end