comparison src/expl_print.sml @ 480:40c737913075

Especialize handles records better
author Adam Chlipala <adamc@hcoop.net>
date Sat, 08 Nov 2008 16:02:59 -0500
parents d34834af4512
children ae03d09043c1
comparison
equal deleted inserted replaced
479:ffa18975e661 480:40c737913075
95 string (#1 (E.lookupCNamed env n))) 95 string (#1 (E.lookupCNamed env n)))
96 handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n)) 96 handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
97 | CModProj (m1, ms, x) => 97 | CModProj (m1, ms, x) =>
98 let 98 let
99 val m1x = #1 (E.lookupStrNamed env m1) 99 val m1x = #1 (E.lookupStrNamed env m1)
100 handle E.UnboundNamed _ => "UNBOUND" 100 handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString m1
101 101
102 val m1s = if !debug then 102 val m1s = if !debug then
103 m1x ^ "__" ^ Int.toString m1 103 m1x ^ "__" ^ Int.toString m1
104 else 104 else
105 m1x 105 m1x
224 string (#1 (E.lookupENamed env n))) 224 string (#1 (E.lookupENamed env n)))
225 handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n)) 225 handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
226 | EModProj (m1, ms, x) => 226 | EModProj (m1, ms, x) =>
227 let 227 let
228 val (m1x, sgn) = E.lookupStrNamed env m1 228 val (m1x, sgn) = E.lookupStrNamed env m1
229 handle E.UnboundNamed _ => ("UNBOUND", (SgnConst [], loc)) 229 handle E.UnboundNamed _ => ("UNBOUND" ^ Int.toString m1, (SgnConst [], loc))
230 230
231 val m1s = if !debug then 231 val m1s = if !debug then
232 m1x ^ "__" ^ Int.toString m1 232 m1x ^ "__" ^ Int.toString m1
233 else 233 else
234 m1x 234 m1x
485 p_list_sep newline (fn x => x) psgis 485 p_list_sep newline (fn x => x) psgis
486 end, 486 end,
487 newline, 487 newline,
488 string "end"] 488 string "end"]
489 | SgnVar n => string ((#1 (E.lookupSgnNamed env n)) 489 | SgnVar n => string ((#1 (E.lookupSgnNamed env n))
490 handle E.UnboundNamed _ => "UNBOUND") 490 handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString n)
491 | SgnFun (x, n, sgn, sgn') => box [string "functor", 491 | SgnFun (x, n, sgn, sgn') => box [string "functor",
492 space, 492 space,
493 string "(", 493 string "(",
494 string x, 494 p_named x n,
495 space, 495 space,
496 string ":", 496 string ":",
497 space, 497 space,
498 p_sgn env sgn, 498 p_sgn env sgn,
499 string ")", 499 string ")",
513 space, 513 space,
514 p_con env c] 514 p_con env c]
515 | SgnProj (m1, ms, x) => 515 | SgnProj (m1, ms, x) =>
516 let 516 let
517 val (m1x, sgn) = E.lookupStrNamed env m1 517 val (m1x, sgn) = E.lookupStrNamed env m1
518 handle E.UnboundNamed _ => ("UNBOUND", (SgnConst [], loc)) 518 handle E.UnboundNamed _ => ("UNBOUND" ^ Int.toString m1, (SgnConst [], loc))
519 519
520 val m1s = if !debug then 520 val m1s = if !debug then
521 m1x ^ "__" ^ Int.toString m1 521 m1x ^ "__" ^ Int.toString m1
522 else 522 else
523 m1x 523 m1x
641 newline, 641 newline,
642 string "end"] 642 string "end"]
643 | StrVar n => 643 | StrVar n =>
644 let 644 let
645 val x = #1 (E.lookupStrNamed env n) 645 val x = #1 (E.lookupStrNamed env n)
646 handle E.UnboundNamed _ => "UNBOUND" 646 handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString n
647 647
648 val s = if !debug then 648 val s = if !debug then
649 x ^ "__" ^ Int.toString n 649 x ^ "__" ^ Int.toString n
650 else 650 else
651 x 651 x
660 val env' = E.pushStrNamed env x n sgn 660 val env' = E.pushStrNamed env x n sgn
661 in 661 in
662 box [string "functor", 662 box [string "functor",
663 space, 663 space,
664 string "(", 664 string "(",
665 string x, 665 p_named x n,
666 space, 666 space,
667 string ":", 667 string ":",
668 space, 668 space,
669 p_sgn env sgn, 669 p_sgn env sgn,
670 string ")", 670 string ")",