diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-05-28 13:47:05 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-05-28 13:47:05 -0400 |
| commit | f69f45d06219f45b7b0d72930f71f215f488641b (patch) | |
| tree | f9566ec4d3b69294e445ae920bad36a6a3db2b0c /src/mono_reduce.sml | |
| parent | bdd17680e61ac36aeefdbde7444381192127fe49 (diff) | |
Fix variable adjustment bug in fn/case alternation
Diffstat (limited to 'src/mono_reduce.sml')
| -rw-r--r-- | src/mono_reduce.sml | 22 |
1 files changed, 15 insertions, 7 deletions
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 770aaa2e..985f76a2 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -131,7 +131,7 @@ val swapExpVarsPat = case e of ERel xn => if xn = lower then - ERel (lower + 1) + ERel (lower + len) else if xn >= lower + 1 andalso xn < lower + 1 + len then ERel (xn - 1) else @@ -392,12 +392,20 @@ fun reduce file = case result of (TFun (dom, result), loc) => if List.all (fn (_, (EAbs _, _)) => true | _ => false) pes then - EAbs ("_", dom, result, - (ECase (liftExpInExp 0 e', - map (fn (p, (EAbs (_, _, _, e), _)) => - (p, swapExpVarsPat (0, patBinds p) e) - | _ => raise Fail "MonoReduce ECase") pes, - {disc = disc, result = result}), loc)) + let + val r = + EAbs ("y", dom, result, + (ECase (liftExpInExp 0 e', + map (fn (p, (EAbs (_, _, _, e), _)) => + (p, swapExpVarsPat (0, patBinds p) e) + | _ => raise Fail "MonoReduce ECase") pes, + {disc = disc, result = result}), loc)) + in + (*Print.prefaces "Swapped" + [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)), + ("r", MonoPrint.p_exp env (r, ErrorMsg.dummySpan))];*) + r + end else e | _ => e |