Mercurial > urweb
changeset 814:3f3b211f9bca
Fix argument ordering bug in fuse; fix case subsitution bug in MonoReduce
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 17 May 2009 14:36:55 -0400 |
| parents | 7b380e2b9e68 |
| children | 493f44759879 |
| files | src/fuse.sml src/mono_reduce.sml |
| diffstat | 2 files changed, 7 insertions(+), 6 deletions(-) [+] |
line wrap: on
line diff
--- a/src/fuse.sml Sun May 17 13:25:57 2009 -0400 +++ b/src/fuse.sml Sun May 17 14:36:55 2009 -0400 @@ -78,7 +78,7 @@ val (body, args) = getBody (e, args) val body = MonoOpt.optExp (EWrite body, loc) - val (body, _) = foldl (fn ((x, dom), (body, ran)) => + val (body, _) = foldr (fn ((x, dom), (body, ran)) => ((EAbs (x, dom, ran, body), loc), (TFun (dom, ran), loc))) (body, (TRecord [], loc)) args
--- a/src/mono_reduce.sml Sun May 17 13:25:57 2009 -0400 +++ b/src/mono_reduce.sml Sun May 17 14:36:55 2009 -0400 @@ -140,12 +140,12 @@ 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 @@ 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),