diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2012-08-05 17:11:39 -0400 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2012-08-05 17:11:39 -0400 |
| commit | 5b530665813a1041554357f6eca2c6ac36e2e26b (patch) | |
| tree | 4eb88399853e78a069ac98f8a70f8658184b801f /src/mono_reduce.sml | |
| parent | d914989e7ecf17997a2e57d6490b18f6c2b52e5e (diff) | |
Revert last changeset for now; needs more thought
Diffstat (limited to 'src/mono_reduce.sml')
| -rw-r--r-- | src/mono_reduce.sml | 24 |
1 files changed, 4 insertions, 20 deletions
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index af61489c..88628ac2 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -179,12 +179,12 @@ val swapExpVarsPat = 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 reduce file = 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 @@ fun reduce file = else e end - else if countFree 0 0 b > 1 andalso notValue e' then - e else trySub () end @@ -672,11 +659,8 @@ fun reduce file = | 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 |