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