From adefca12f83d73986b0f860621232b17c130c742 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 30 May 2009 13:29:00 -0400 Subject: Substring functions; fix a nasty MonoReduce pattern match substitution bug --- src/mono_reduce.sml | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) (limited to 'src/mono_reduce.sml') diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 985f76a2..1ea3df36 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -85,6 +85,11 @@ fun impure (e, _) = val liftExpInExp = Monoize.liftExpInExp +fun multiLift n e = + case n of + 0 => e + | _ => multiLift (n - 1) (liftExpInExp 0 e) + val subExpInExp' = U.Exp.mapB {typ = fn t => t, exp = fn (xn, rep) => fn e => @@ -419,11 +424,16 @@ fun reduce file = | Maybe => push () | Yes subs => let - val body = foldr (fn (e, body) => subExpInExp (0, e) body) body subs + val (body, remaining) = + foldl (fn (e, (body, remaining)) => + (subExpInExp (0, multiLift remaining e) body, remaining - 1)) + (body, length subs - 1) subs val r = reduceExp env body in + (*Print.preface ("subs", Print.p_list (MonoPrint.p_exp env) subs);*) (*Print.prefaces "ECase" - [("body", MonoPrint.p_exp env' body), + [("old", MonoPrint.p_exp env body), + ("body", MonoPrint.p_exp env body), ("r", MonoPrint.p_exp env r)];*) #1 r end @@ -533,7 +543,8 @@ fun reduce file = | _ => e in - (*Print.prefaces "exp'" [("r", MonoPrint.p_exp env (r, ErrorMsg.dummySpan))];*) + (*Print.prefaces "exp'" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)), + ("r", MonoPrint.p_exp env (r, ErrorMsg.dummySpan))];*) r end -- cgit v1.2.3