Mercurial > urweb

annotate src/elab_print.sml @ 169:2232ab355f66

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Took more advantage of new ability to exit with an error message
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 16:02:02 -0400
parents 06a98129b23f
children c7a6e6dbc318
rev   line source
adamc@3 1 (* Copyright (c) 2008, Adam Chlipala
adamc@3 2 * All rights reserved.
adamc@3 3 *
adamc@3 4 * Redistribution and use in source and binary forms, with or without
adamc@3 5 * modification, are permitted provided that the following conditions are met:
adamc@3 6 *
adamc@3 7 * - Redistributions of source code must retain the above copyright notice,
adamc@3 8 * this list of conditions and the following disclaimer.
adamc@3 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@3 10 * this list of conditions and the following disclaimer in the documentation
adamc@3 11 * and/or other materials provided with the distribution.
adamc@3 12 * - The names of contributors may not be used to endorse or promote products
adamc@3 13 * derived from this software without specific prior written permission.
adamc@3 14 *
adamc@3 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@3 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@3 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@3 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@3 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@3 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@3 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@3 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@3 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@3 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@3 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@3 26 *)
adamc@3 27
adamc@3 28 (* Pretty-printing elaborated Laconic/Web *)
adamc@3 29
adamc@3 30 structure ElabPrint :> ELAB_PRINT = struct
adamc@3 31
adamc@3 32 open Print.PD
adamc@3 33 open Print
adamc@3 34
adamc@3 35 open Elab
adamc@3 36
adamc@3 37 structure E = ElabEnv
adamc@3 38
adamc@11 39 val debug = ref false
adamc@11 40
adamc@3 41 fun p_kind' par (k, _) =
adamc@3 42 case k of
adamc@3 43 KType => string "Type"
adamc@3 44 | KArrow (k1, k2) => parenIf par (box [p_kind' true k1,
adamc@3 45 space,
adamc@3 46 string "->",
adamc@3 47 space,
adamc@3 48 p_kind k2])
adamc@3 49 | KName => string "Name"
adamc@3 50 | KRecord k => box [string "{", p_kind k, string "}"]
adamc@82 51 | KUnit => string "Unit"
adamc@3 52
adamc@3 53 | KError => string "<ERROR>"
adamc@76 54 | KUnif (_, _, ref (SOME k)) => p_kind' par k
adamc@76 55 | KUnif (_, s, _) => string ("<UNIF:" ^ s ^ ">")
adamc@3 56
adamc@3 57 and p_kind k = p_kind' false k
adamc@3 58
adamc@3 59 fun p_explicitness e =
adamc@3 60 case e of
adamc@3 61 Explicit => string "::"
adamc@3 62 | Implicit => string ":::"
adamc@3 63
adamc@3 64 fun p_con' par env (c, _) =
adamc@3 65 case c of
adamc@3 66 TFun (t1, t2) => parenIf par (box [p_con' true env t1,
adamc@3 67 space,
adamc@3 68 string "->",
adamc@3 69 space,
adamc@3 70 p_con env t2])
adamc@3 71 | TCFun (e, x, k, c) => parenIf par (box [string x,
adamc@3 72 space,
adamc@3 73 p_explicitness e,
adamc@3 74 space,
adamc@3 75 p_kind k,
adamc@3 76 space,
adamc@3 77 string "->",
adamc@3 78 space,
adamc@3 79 p_con (E.pushCRel env x k) c])
adamc@85 80 | TDisjoint (c1, c2, c3) => parenIf par (box [p_con env c1,
adamc@85 81 space,
adamc@85 82 string "~",
adamc@85 83 space,
adamc@85 84 p_con env c2,
adamc@85 85 space,
adamc@85 86 string "->",
adamc@85 87 space,
adamc@85 88 p_con env c3])
adamc@3 89 | TRecord (CRecord (_, xcs), _) => box [string "{",
adamc@3 90 p_list (fn (x, c) =>
adamc@20 91 box [p_name env x,
adamc@3 92 space,
adamc@3 93 string ":",
adamc@3 94 space,
adamc@3 95 p_con env c]) xcs,
adamc@3 96 string "}"]
adamc@3 97 | TRecord c => box [string "$",
adamc@3 98 p_con' true env c]
adamc@3 99
adamc@11 100 | CRel n =>
adamc@71 101 ((if !debug then
adamc@71 102 string (#1 (E.lookupCRel env n) ^ "_" ^ Int.toString n)
adamc@71 103 else
adamc@71 104 string (#1 (E.lookupCRel env n)))
adamc@71 105 handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
adamc@11 106 | CNamed n =>
adamc@34 107 ((if !debug then
adamc@34 108 string (#1 (E.lookupCNamed env n) ^ "__" ^ Int.toString n)
adamc@34 109 else
adamc@34 110 string (#1 (E.lookupCNamed env n)))
adamc@34 111 handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
adamc@34 112 | CModProj (m1, ms, x) =>
adamc@34 113 let
adamc@88 114 val m1x = #1 (E.lookupStrNamed env m1)
adamc@88 115 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
adamc@88 116
adamc@34 117 val m1s = if !debug then
adamc@34 118 m1x ^ "__" ^ Int.toString m1
adamc@34 119 else
adamc@34 120 m1x
adamc@34 121 in
adamc@34 122 p_list_sep (string ".") string (m1x :: ms @ [x])
adamc@88 123 end
adamc@3 124
adamc@3 125 | CApp (c1, c2) => parenIf par (box [p_con env c1,
adamc@3 126 space,
adamc@3 127 p_con' true env c2])
adamc@147 128 | CAbs (x, k, c) => parenIf true (box [string "fn",
adamc@147 129 space,
adamc@147 130 string x,
adamc@147 131 space,
adamc@147 132 string "::",
adamc@147 133 space,
adamc@147 134 p_kind k,
adamc@147 135 space,
adamc@147 136 string "=>",
adamc@147 137 space,
adamc@147 138 p_con (E.pushCRel env x k) c])
adamc@84 139 | CDisjoint (c1, c2, c3) => parenIf par (box [p_con env c1,
adamc@84 140 space,
adamc@84 141 string "~",
adamc@84 142 space,
adamc@84 143 p_con env c2,
adamc@84 144 space,
adamc@84 145 string "=>",
adamc@84 146 space,
adamc@84 147 p_con env c3])
adamc@3 148
adamc@3 149 | CName s => box [string "#", string s]
adamc@3 150
adamc@12 151 | CRecord (k, xcs) =>
adamc@12 152 if !debug then
adamc@12 153 parenIf par (box [string "[",
adamc@12 154 p_list (fn (x, c) =>
adamc@12 155 box [p_con env x,
adamc@12 156 space,
adamc@12 157 string "=",
adamc@12 158 space,
adamc@12 159 p_con env c]) xcs,
adamc@12 160 string "]::",
adamc@12 161 p_kind k])
adamc@12 162 else
adamc@12 163 parenIf par (box [string "[",
adamc@12 164 p_list (fn (x, c) =>
adamc@12 165 box [p_con env x,
adamc@12 166 space,
adamc@12 167 string "=",
adamc@12 168 space,
adamc@12 169 p_con env c]) xcs,
adamc@12 170 string "]"])
adamc@3 171 | CConcat (c1, c2) => parenIf par (box [p_con' true env c1,
adamc@3 172 space,
adamc@3 173 string "++",
adamc@3 174 space,
adamc@3 175 p_con env c2])
adamc@67 176 | CFold _ => string "fold"
adamc@3 177
adamc@82 178 | CUnit => string "()"
adamc@82 179
adamc@3 180 | CError => string "<ERROR>"
adamc@76 181 | CUnif (_, _, _, ref (SOME c)) => p_con' par env c
adamc@76 182 | CUnif (_, k, s, _) => box [string ("<UNIF:" ^ s ^ "::"),
adamc@76 183 p_kind k,
adamc@76 184 string ">"]
adamc@3 185
adamc@3 186 and p_con env = p_con' false env
adamc@3 187
adamc@20 188 and p_name env (all as (c, _)) =
adamc@20 189 case c of
adamc@20 190 CName s => string s
adamc@20 191 | _ => p_con env all
adamc@20 192
adamc@9 193 fun p_exp' par env (e, _) =
adamc@9 194 case e of
adamc@14 195 EPrim p => Prim.p_t p
adamc@14 196 | ERel n =>
adamc@88 197 ((if !debug then
adamc@88 198 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
adamc@88 199 else
adamc@88 200 string (#1 (E.lookupERel env n)))
adamc@88 201 handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
adamc@11 202 | ENamed n =>
adamc@88 203 ((if !debug then
adamc@88 204 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
adamc@88 205 else
adamc@88 206 string (#1 (E.lookupENamed env n)))
adamc@88 207 handle E.UnboundRel _ => string ("UNBOUND_NAMED" ^ Int.toString n))
adamc@34 208 | EModProj (m1, ms, x) =>
adamc@34 209 let
adamc@88 210 val m1x = #1 (E.lookupStrNamed env m1)
adamc@88 211 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
adamc@88 212
adamc@34 213 val m1s = if !debug then
adamc@34 214 m1x ^ "__" ^ Int.toString m1
adamc@34 215 else
adamc@34 216 m1x
adamc@34 217 in
adamc@34 218 p_list_sep (string ".") string (m1x :: ms @ [x])
adamc@34 219 end
adamc@34 220
adamc@9 221 | EApp (e1, e2) => parenIf par (box [p_exp env e1,
adamc@9 222 space,
adamc@9 223 p_exp' true env e2])
adamc@26 224 | EAbs (x, t, _, e) => parenIf par (box [string "fn",
adamc@26 225 space,
adamc@26 226 string x,
adamc@26 227 space,
adamc@26 228 string ":",
adamc@26 229 space,
adamc@26 230 p_con env t,
adamc@26 231 space,
adamc@26 232 string "=>",
adamc@26 233 space,
adamc@26 234 p_exp (E.pushERel env x t) e])
adamc@9 235 | ECApp (e, c) => parenIf par (box [p_exp env e,
adamc@9 236 space,
adamc@9 237 string "[",
adamc@9 238 p_con env c,
adamc@9 239 string "]"])
adamc@9 240 | ECAbs (exp, x, k, e) => parenIf par (box [string "fn",
adamc@9 241 space,
adamc@9 242 string x,
adamc@9 243 space,
adamc@9 244 p_explicitness exp,
adamc@9 245 space,
adamc@9 246 p_kind k,
adamc@9 247 space,
adamc@9 248 string "=>",
adamc@9 249 space,
adamc@9 250 p_exp (E.pushCRel env x k) e])
adamc@9 251
adamc@12 252 | ERecord xes => box [string "{",
adamc@29 253 p_list (fn (x, e, _) =>
adamc@21 254 box [p_name env x,
adamc@12 255 space,
adamc@12 256 string "=",
adamc@12 257 space,
adamc@12 258 p_exp env e]) xes,
adamc@12 259 string "}"]
adamc@12 260 | EField (e, c, {field, rest}) =>
adamc@12 261 if !debug then
adamc@12 262 box [p_exp' true env e,
adamc@12 263 string ".",
adamc@12 264 p_con' true env c,
adamc@12 265 space,
adamc@12 266 string "[",
adamc@12 267 p_con env field,
adamc@12 268 space,
adamc@12 269 string " in ",
adamc@12 270 space,
adamc@12 271 p_con env rest,
adamc@12 272 string "]"]
adamc@12 273 else
adamc@12 274 box [p_exp' true env e,
adamc@12 275 string ".",
adamc@12 276 p_con' true env c]
adamc@149 277 | ECut (e, c, {field, rest}) =>
adamc@149 278 parenIf par (if !debug then
adamc@149 279 box [p_exp' true env e,
adamc@149 280 space,
adamc@149 281 string "--",
adamc@149 282 space,
adamc@149 283 p_con' true env c,
adamc@149 284 space,
adamc@149 285 string "[",
adamc@149 286 p_con env field,
adamc@149 287 space,
adamc@149 288 string " in ",
adamc@149 289 space,
adamc@149 290 p_con env rest,
adamc@149 291 string "]"]
adamc@149 292 else
adamc@149 293 box [p_exp' true env e,
adamc@149 294 space,
adamc@149 295 string "--",
adamc@149 296 space,
adamc@149 297 p_con' true env c])
adamc@72 298 | EFold _ => string "fold"
adamc@71 299
adamc@9 300 | EError => string "<ERROR>"
adamc@9 301
adamc@9 302 and p_exp env = p_exp' false env
adamc@9 303
adamc@31 304 fun p_named x n =
adamc@31 305 if !debug then
adamc@31 306 box [string x,
adamc@31 307 string "__",
adamc@31 308 string (Int.toString n)]
adamc@31 309 else
adamc@31 310 string x
adamc@31 311
adamc@156 312 fun p_datatype env (x, n, cons) =
adamc@156 313 let
adamc@156 314 val env = E.pushCNamedAs env x n (KType, ErrorMsg.dummySpan) NONE
adamc@156 315 in
adamc@156 316 box [string "datatype",
adamc@156 317 space,
adamc@156 318 string x,
adamc@156 319 space,
adamc@156 320 string "=",
adamc@156 321 space,
adamc@156 322 p_list_sep (box [space, string "|", space])
adamc@156 323 (fn (x, _, NONE) => string x
adamc@156 324 | (x, _, SOME t) => box [string x, space, string "of", space, p_con env t])
adamc@156 325 cons]
adamc@156 326 end
adamc@156 327
adamc@31 328 fun p_sgn_item env (sgi, _) =
adamc@31 329 case sgi of
adamc@31 330 SgiConAbs (x, n, k) => box [string "con",
adamc@31 331 space,
adamc@31 332 p_named x n,
adamc@31 333 space,
adamc@31 334 string "::",
adamc@31 335 space,
adamc@31 336 p_kind k]
adamc@31 337 | SgiCon (x, n, k, c) => box [string "con",
adamc@31 338 space,
adamc@31 339 p_named x n,
adamc@31 340 space,
adamc@31 341 string "::",
adamc@31 342 space,
adamc@31 343 p_kind k,
adamc@31 344 space,
adamc@31 345 string "=",
adamc@31 346 space,
adamc@31 347 p_con env c]
adamc@156 348 | SgiDatatype x => p_datatype env x
adamc@162 349 | SgiDatatypeImp (x, _, m1, ms, x', _) =>
adamc@156 350 let
adamc@156 351 val m1x = #1 (E.lookupStrNamed env m1)
adamc@156 352 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
adamc@156 353 in
adamc@156 354 box [string "datatype",
adamc@156 355 space,
adamc@156 356 string x,
adamc@156 357 space,
adamc@156 358 string "=",
adamc@156 359 space,
adamc@156 360 string "datatype",
adamc@156 361 space,
adamc@156 362 p_list_sep (string ".") string (m1x :: ms @ [x'])]
adamc@156 363 end
adamc@31 364 | SgiVal (x, n, c) => box [string "val",
adamc@31 365 space,
adamc@31 366 p_named x n,
adamc@31 367 space,
adamc@31 368 string ":",
adamc@31 369 space,
adamc@31 370 p_con env c]
adamc@31 371 | SgiStr (x, n, sgn) => box [string "structure",
adamc@31 372 space,
adamc@31 373 p_named x n,
adamc@31 374 space,
adamc@31 375 string ":",
adamc@31 376 space,
adamc@31 377 p_sgn env sgn]
adamc@59 378 | SgiSgn (x, n, sgn) => box [string "signature",
adamc@59 379 space,
adamc@59 380 p_named x n,
adamc@59 381 space,
adamc@59 382 string "=",
adamc@59 383 space,
adamc@59 384 p_sgn env sgn]
adamc@88 385 | SgiConstraint (c1, c2) => box [string "constraint",
adamc@88 386 space,
adamc@88 387 p_con env c1,
adamc@88 388 space,
adamc@88 389 string "~",
adamc@88 390 space,
adamc@88 391 p_con env c2]
adamc@31 392
adamc@31 393 and p_sgn env (sgn, _) =
adamc@31 394 case sgn of
adamc@31 395 SgnConst sgis => box [string "sig",
adamc@31 396 newline,
adamc@32 397 let
adamc@32 398 val (psgis, _) = ListUtil.foldlMap (fn (sgi, env) =>
adamc@32 399 (p_sgn_item env sgi,
adamc@32 400 E.sgiBinds env sgi))
adamc@32 401 env sgis
adamc@32 402 in
adamc@32 403 p_list_sep newline (fn x => x) psgis
adamc@32 404 end,
adamc@31 405 newline,
adamc@31 406 string "end"]
adamc@88 407 | SgnVar n => ((string (#1 (E.lookupSgnNamed env n)))
adamc@88 408 handle E.UnboundNamed _ => string ("UNBOUND_SGN_" ^ Int.toString n))
adamc@41 409 | SgnFun (x, n, sgn, sgn') => box [string "functor",
adamc@41 410 space,
adamc@41 411 string "(",
adamc@41 412 string x,
adamc@41 413 space,
adamc@41 414 string ":",
adamc@41 415 space,
adamc@41 416 p_sgn env sgn,
adamc@41 417 string ")",
adamc@41 418 space,
adamc@41 419 string ":",
adamc@41 420 space,
adamc@41 421 p_sgn (E.pushStrNamedAs env x n sgn) sgn']
adamc@42 422 | SgnWhere (sgn, x, c) => box [p_sgn env sgn,
adamc@42 423 space,
adamc@42 424 string "where",
adamc@42 425 space,
adamc@42 426 string "con",
adamc@42 427 space,
adamc@42 428 string x,
adamc@42 429 space,
adamc@42 430 string "=",
adamc@42 431 space,
adamc@42 432 p_con env c]
adamc@59 433 | SgnProj (m1, ms, x) =>
adamc@59 434 let
adamc@88 435 val m1x = #1 (E.lookupStrNamed env m1)
adamc@88 436 handle E.UnboundNamed _ => "UNBOUND_SGN_" ^ Int.toString m1
adamc@88 437
adamc@59 438 val m1s = if !debug then
adamc@59 439 m1x ^ "__" ^ Int.toString m1
adamc@59 440 else
adamc@59 441 m1x
adamc@88 442 in
adamc@59 443 p_list_sep (string ".") string (m1x :: ms @ [x])
adamc@59 444 end
adamc@31 445 | SgnError => string "<ERROR>"
adamc@31 446
adamc@123 447 fun p_vali env (x, n, t, e) = box [p_named x n,
adamc@123 448 space,
adamc@123 449 string ":",
adamc@123 450 space,
adamc@123 451 p_con env t,
adamc@123 452 space,
adamc@123 453 string "=",
adamc@123 454 space,
adamc@123 455 p_exp env e]
adamc@123 456
adamc@123 457 fun p_decl env (dAll as (d, _) : decl) =
adamc@3 458 case d of
adamc@31 459 DCon (x, n, k, c) => box [string "con",
adamc@31 460 space,
adamc@31 461 p_named x n,
adamc@31 462 space,
adamc@31 463 string "::",
adamc@31 464 space,
adamc@31 465 p_kind k,
adamc@31 466 space,
adamc@31 467 string "=",
adamc@31 468 space,
adamc@31 469 p_con env c]
adamc@156 470 | DDatatype x => p_datatype env x
adamc@162 471 | DDatatypeImp (x, _, m1, ms, x', _) =>
adamc@156 472 let
adamc@156 473 val m1x = #1 (E.lookupStrNamed env m1)
adamc@156 474 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
adamc@156 475 in
adamc@156 476 box [string "datatype",
adamc@156 477 space,
adamc@156 478 string x,
adamc@156 479 space,
adamc@156 480 string "=",
adamc@156 481 space,
adamc@156 482 string "datatype",
adamc@156 483 space,
adamc@156 484 p_list_sep (string ".") string (m1x :: ms @ [x'])]
adamc@156 485 end
adamc@123 486 | DVal vi => box [string "val",
adamc@123 487 space,
adamc@123 488 p_vali env vi]
adamc@123 489 | DValRec vis =>
adamc@123 490 let
adamc@123 491 val env = E.declBinds env dAll
adamc@123 492 in
adamc@123 493 box [string "val",
adamc@123 494 space,
adamc@123 495 string "rec",
adamc@123 496 space,
adamc@123 497 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
adamc@123 498 end
adamc@31 499
adamc@31 500 | DSgn (x, n, sgn) => box [string "signature",
adamc@31 501 space,
adamc@31 502 p_named x n,
adamc@31 503 space,
adamc@31 504 string "=",
adamc@31 505 space,
adamc@31 506 p_sgn env sgn]
adamc@31 507 | DStr (x, n, sgn, str) => box [string "structure",
adamc@31 508 space,
adamc@31 509 p_named x n,
adamc@31 510 space,
adamc@31 511 string ":",
adamc@31 512 space,
adamc@31 513 p_sgn env sgn,
adamc@31 514 space,
adamc@31 515 string "=",
adamc@31 516 space,
adamc@31 517 p_str env str]
adamc@48 518 | DFfiStr (x, n, sgn) => box [string "extern",
adamc@48 519 space,
adamc@48 520 string "structure",
adamc@48 521 space,
adamc@48 522 p_named x n,
adamc@48 523 space,
adamc@48 524 string ":",
adamc@48 525 space,
adamc@48 526 p_sgn env sgn]
adamc@88 527 | DConstraint (c1, c2) => box [string "constraint",
adamc@88 528 space,
adamc@88 529 p_con env c1,
adamc@88 530 space,
adamc@88 531 string "~",
adamc@88 532 space,
adamc@88 533 p_con env c2]
adamc@109 534 | DExport (_, sgn, str) => box [string "export",
adamc@110 535 space,
adamc@109 536 p_str env str,
adamc@109 537 space,
adamc@109 538 string ":",
adamc@109 539 space,
adamc@109 540 p_sgn env sgn]
adamc@31 541
adamc@31 542 and p_str env (str, _) =
adamc@31 543 case str of
adamc@31 544 StrConst ds => box [string "struct",
adamc@31 545 newline,
adamc@32 546 p_file env ds,
adamc@31 547 newline,
adamc@31 548 string "end"]
adamc@88 549 | StrVar n => ((string (#1 (E.lookupStrNamed env n)))
adamc@88 550 handle E.UnboundNamed _ => string ("UNBOUND_STR_" ^ Int.toString n))
adamc@34 551 | StrProj (str, s) => box [p_str env str,
adamc@34 552 string ".",
adamc@34 553 string s]
adamc@41 554 | StrFun (x, n, sgn, sgn', str) =>
adamc@41 555 let
adamc@41 556 val env' = E.pushStrNamedAs env x n sgn
adamc@41 557 in
adamc@41 558 box [string "functor",
adamc@41 559 space,
adamc@41 560 string "(",
adamc@41 561 string x,
adamc@41 562 space,
adamc@41 563 string ":",
adamc@41 564 space,
adamc@41 565 p_sgn env sgn,
adamc@41 566 string ")",
adamc@41 567 space,
adamc@41 568 string ":",
adamc@41 569 space,
adamc@41 570 p_sgn env' sgn',
adamc@41 571 space,
adamc@41 572 string "=>",
adamc@41 573 space,
adamc@41 574 p_str env' str]
adamc@41 575 end
adamc@44 576 | StrApp (str1, str2) => box [p_str env str1,
adamc@44 577 string "(",
adamc@44 578 p_str env str2,
adamc@44 579 string ")"]
adamc@31 580 | StrError => string "<ERROR>"
adamc@3 581
adamc@32 582 and p_file env file =
adamc@3 583 let
adamc@31 584 val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
adamc@31 585 (p_decl env d,
adamc@31 586 E.declBinds env d))
adamc@31 587 env file
adamc@3 588 in
adamc@3 589 p_list_sep newline (fn x => x) pds
adamc@3 590 end
adamc@3 591
adamc@3 592 end