diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-05-17 14:36:55 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-05-17 14:36:55 -0400 |
commit | 0d47ed0262cb6bf4dd95d482fbe6ce9c63e66285 (patch) | |
tree | 37190bd18788573834dedcc81888776b49cd758e /src/mono_reduce.sml | |
parent | cb6e88183a8c126118de373bfd98f3bef5e714a2 (diff) |
Fix argument ordering bug in fuse; fix case subsitution bug in MonoReduce
Diffstat (limited to 'src/mono_reduce.sml')
-rw-r--r-- | src/mono_reduce.sml | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 94c57bac..77672acc 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -140,12 +140,12 @@ val swapExpVarsPat = bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len) | (st, _) => st} -datatype result = Yes of E.env | No | Maybe +datatype result = Yes of exp list | No | Maybe fun match (env, p : pat, e : exp) = case (#1 p, #1 e) of (PWild, _) => Yes env - | (PVar (x, t), _) => Yes (E.pushERel env x t (SOME e)) + | (PVar (x, t), _) => Yes (e :: env) | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) => if String.isPrefix s' s then @@ -406,12 +406,13 @@ fun reduce file = case pes of [] => push () | (p, body) :: pes => - case match (env, p, e') of + case match ([], p, e') of No => search pes | Maybe => push () - | Yes env' => + | Yes subs => let - val r = reduceExp env' body + val body = foldr (fn (e, body) => subExpInExp (0, e) body) body subs + val r = reduceExp env body in (*Print.prefaces "ECase" [("body", MonoPrint.p_exp env' body), |