Mercurial > urweb

comparison src/elaborate.sml @ 64:d609820c5834

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Proper hiding of shadowed bindings in principal signatures
author Adam Chlipala <adamc@hcoop.net>
date Thu, 26 Jun 2008 08:54:49 -0400
parents c5a503ad0d8c
children 2adb20eebee3
comparison
equal deleted inserted replaced
63:c5a503ad0d8c 64:d609820c5834
1578 let 1578 let
1579 val (ds', env') = ListUtil.foldlMapConcat elabDecl env ds 1579 val (ds', env') = ListUtil.foldlMapConcat elabDecl env ds
1580 val sgis = map sgiOfDecl ds' 1580 val sgis = map sgiOfDecl ds'
1581 1581
1582 val (sgis, _, _, _, _) = 1582 val (sgis, _, _, _, _) =
1583 foldr (fn (sgall as (sgi, loc), (sgis, cons, vals, sgns, strs)) => 1583 foldr (fn ((sgi, loc), (sgis, cons, vals, sgns, strs)) =>
1584 case sgi of 1584 case sgi of
1585 L'.SgiConAbs (x, _, _) => 1585 L'.SgiConAbs (x, n, k) =>
1586 (if SS.member (cons, x) then 1586 let
1587 sgnError env (DuplicateCon (loc, x)) 1587 val (cons, x) =
1588 else 1588 if SS.member (cons, x) then
1589 (); 1589 (cons, "?" ^ x)
1590 (sgall :: sgis, SS.add (cons, x), vals, sgns, strs)) 1590 else
1591 | L'.SgiCon (x, _, _, _) => 1591 (SS.add (cons, x), x)
1592 (if SS.member (cons, x) then 1592 in
1593 sgnError env (DuplicateCon (loc, x)) 1593 ((L'.SgiConAbs (x, n, k), loc) :: sgis, cons, vals, sgns, strs)
1594 else 1594 end
1595 (); 1595 | L'.SgiCon (x, n, k, c) =>
1596 (sgall :: sgis, SS.add (cons, x), vals, sgns, strs)) 1596 let
1597 | L'.SgiVal (x, _, _) => 1597 val (cons, x) =
1598 if SS.member (vals, x) then 1598 if SS.member (cons, x) then
1599 (sgis, cons, vals, sgns, strs) 1599 (cons, "?" ^ x)
1600 else 1600 else
1601 (sgall :: sgis, cons, SS.add (vals, x), sgns, strs) 1601 (SS.add (cons, x), x)
1602 | L'.SgiSgn (x, _, _) => 1602 in
1603 (if SS.member (sgns, x) then 1603 ((L'.SgiCon (x, n, k, c), loc) :: sgis, cons, vals, sgns, strs)
1604 sgnError env (DuplicateSgn (loc, x)) 1604 end
1605 else 1605 | L'.SgiVal (x, n, c) =>
1606 (); 1606 let
1607 (sgall :: sgis, cons, vals, SS.add (sgns, x), strs)) 1607 val (vals, x) =
1608 | L'.SgiStr (x, _, _) => 1608 if SS.member (vals, x) then
1609 (if SS.member (strs, x) then 1609 (vals, "?" ^ x)
1610 sgnError env (DuplicateStr (loc, x)) 1610 else
1611 else 1611 (SS.add (vals, x), x)
1612 (); 1612 in
1613 (sgall :: sgis, cons, vals, sgns, SS.add (strs, x)))) 1613 ((L'.SgiVal (x, n, c), loc) :: sgis, cons, vals, sgns, strs)
1614 end
1615 | L'.SgiSgn (x, n, sgn) =>
1616 let
1617 val (sgns, x) =
1618 if SS.member (sgns, x) then
1619 (sgns, "?" ^ x)
1620 else
1621 (SS.add (sgns, x), x)
1622 in
1623 ((L'.SgiSgn (x, n, sgn), loc) :: sgis, cons, vals, sgns, strs)
1624 end
1625
1626 | L'.SgiStr (x, n, sgn) =>
1627 let
1628 val (strs, x) =
1629 if SS.member (strs, x) then
1630 (strs, "?" ^ x)
1631 else
1632 (SS.add (strs, x), x)
1633 in
1634 ((L'.SgiStr (x, n, sgn), loc) :: sgis, cons, vals, sgns, strs)
1635 end)
1636
1614 ([], SS.empty, SS.empty, SS.empty, SS.empty) sgis 1637 ([], SS.empty, SS.empty, SS.empty, SS.empty) sgis
1615 in 1638 in
1616 ((L'.StrConst ds', loc), (L'.SgnConst sgis, loc)) 1639 ((L'.StrConst ds', loc), (L'.SgnConst sgis, loc))
1617 end 1640 end
1618 | L.StrVar x => 1641 | L.StrVar x =>