Mercurial > urweb
diff src/mono_reduce.sml @ 1805:d12192c7aa3e
Revert last changeset for now; needs more thought
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sun, 05 Aug 2012 17:11:39 -0400 |
| parents | 62c18ecbfec4 |
| children | 148203744882 |
line wrap: on
line diff
--- a/src/mono_reduce.sml Sun Aug 05 14:55:28 2012 -0400 +++ b/src/mono_reduce.sml Sun Aug 05 17:11:39 2012 -0400 @@ -179,12 +179,12 @@ bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len) | (st, _) => st} -datatype result = Yes of (string * typ * exp) list | 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 ((x, t, e) :: env) + | (PVar (x, t), _) => Yes (e :: env) | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) => if String.isPrefix s' s then @@ -519,17 +519,6 @@ fun doLet (x, t, e', b) = let - val notValue = U.Exp.exists {typ = fn _ => false, - exp = fn e => - case e of - EPrim _ => false - | ECon _ => false - | ENone _ => false - | ESome _ => false - | ERecord _ => false - | _ => true} - - fun doSub () = let val r = subExpInExp (0, e') b @@ -608,8 +597,6 @@ else e end - else if countFree 0 0 b > 1 andalso notValue e' then - e else trySub () end @@ -672,11 +659,8 @@ | Yes subs => let val (body, remaining) = - foldl (fn ((x, t, e), (body, remaining)) => - (if countFree 0 0 body > 1 then - (ELet (x, t, multiLift remaining e, body), #2 e') - else - subExpInExp (0, multiLift remaining e) body, remaining - 1)) + foldl (fn (e, (body, remaining)) => + (subExpInExp (0, multiLift remaining e) body, remaining - 1)) (body, length subs - 1) subs val r = reduceExp (E.patBinds env p) body in