From 9951d7544ba5deaea67864259001a21c12ff11ea Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 13 Jun 2009 15:42:24 -0400 Subject: Fix MonoReduce unsoundness with lets and fns --- src/elaborate.sml | 9 ++++----- src/mono_reduce.sml | 9 ++++----- 2 files changed, 8 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/elaborate.sml b/src/elaborate.sml index 3b147e00..e78132c4 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -697,10 +697,9 @@ and unifySummaries env (loc, k, s1 : record_summary, s2 : record_summary) = let val loc = #2 k - val pdescs = [("#1", p_summary env s1), - ("#2", p_summary env s2)] - (*val () = eprefaces "Summaries" [("#1", p_summary env s1), - ("#2", p_summary env s2)]*) + (*val () = eprefaces "Summaries" [("loc", PD.string (ErrorMsg.spanToString loc)), + ("#1", p_summary env s1), + ("#2", p_summary env s2)]*) fun eatMatching p (ls1, ls2) = let @@ -1595,7 +1594,7 @@ fun normClassConstraint env (c, loc) = fun elabExp (env, denv) (eAll as (e, loc)) = let - (*val () = eprefaces "elabExp" [("eAll", SourcePrint.p_exp eAll)];*) + (*val () = eprefaces "elabExp" [("eAll", SourcePrint.p_exp eAll)]*) (*val befor = Time.now ()*) val r = case e of diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 1ea3df36..4bbb430d 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -461,11 +461,10 @@ fun reduce file = (EApp (b, liftExpInExp 0 e'), loc)), loc)) | ELet (x, t, e', (EAbs (x', t' as (TRecord [], _), ran, e''), loc)) => - (*if impure e' then - e - else*) - (* Seems unsound in general without the check... should revisit later *) - EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc)) + if impure e' then + e + else + EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc)) | ELet (x, t, e', b) => let -- cgit v1.2.3