Mercurial > urweb

annotate src/source_print.sml @ 2067:88841212f0ba

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