Mercurial > urweb
comparison src/elaborate.sml @ 848:e8594cfa3236
Fix MonoReduce unsoundness with lets and fns
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 13 Jun 2009 15:42:24 -0400 |
parents | 74a1e3bdf430 |
children | e571fb150a9f |
comparison
equal
deleted
inserted
replaced
847:0f7e2cca6d9b | 848:e8594cfa3236 |
---|---|
695 | _ => false | 695 | _ => false |
696 | 696 |
697 and unifySummaries env (loc, k, s1 : record_summary, s2 : record_summary) = | 697 and unifySummaries env (loc, k, s1 : record_summary, s2 : record_summary) = |
698 let | 698 let |
699 val loc = #2 k | 699 val loc = #2 k |
700 val pdescs = [("#1", p_summary env s1), | 700 (*val () = eprefaces "Summaries" [("loc", PD.string (ErrorMsg.spanToString loc)), |
701 ("#2", p_summary env s2)] | 701 ("#1", p_summary env s1), |
702 (*val () = eprefaces "Summaries" [("#1", p_summary env s1), | 702 ("#2", p_summary env s2)]*) |
703 ("#2", p_summary env s2)]*) | |
704 | 703 |
705 fun eatMatching p (ls1, ls2) = | 704 fun eatMatching p (ls1, ls2) = |
706 let | 705 let |
707 fun em (ls1, ls2, passed1) = | 706 fun em (ls1, ls2, passed1) = |
708 case ls1 of | 707 case ls1 of |
1593 | L'.CUnif (_, _, _, ref (SOME c)) => normClassConstraint env c | 1592 | L'.CUnif (_, _, _, ref (SOME c)) => normClassConstraint env c |
1594 | _ => unmodCon env (c, loc) | 1593 | _ => unmodCon env (c, loc) |
1595 | 1594 |
1596 fun elabExp (env, denv) (eAll as (e, loc)) = | 1595 fun elabExp (env, denv) (eAll as (e, loc)) = |
1597 let | 1596 let |
1598 (*val () = eprefaces "elabExp" [("eAll", SourcePrint.p_exp eAll)];*) | 1597 (*val () = eprefaces "elabExp" [("eAll", SourcePrint.p_exp eAll)]*) |
1599 (*val befor = Time.now ()*) | 1598 (*val befor = Time.now ()*) |
1600 | 1599 |
1601 val r = case e of | 1600 val r = case e of |
1602 L.EAnnot (e, t) => | 1601 L.EAnnot (e, t) => |
1603 let | 1602 let |