Mercurial > urweb
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 ")", |