summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-05-28 13:47:05 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-05-28 13:47:05 -0400
commit62c7b094ecf7e618a2e31658994bf648e1b36819 (patch)
treef9566ec4d3b69294e445ae920bad36a6a3db2b0c
parent8327f190c80287003048eaa10857d0f081b551bb (diff)
Fix variable adjustment bug in fn/case alternation
-rw-r--r--src/jscomp.sml3
-rw-r--r--src/mono_reduce.sml22
2 files changed, 17 insertions, 8 deletions
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 0e5c70de..3edb670f 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -913,9 +913,10 @@ fun process file =
val len = inner + len
val normalVars = List.tabulate (normalDepth, fn n => "_" ^ Int.toString (n + len))
val patVars = List.tabulate (depth, fn n => "d" ^ Int.toString n)
+ val caseVars = ListUtil.mapi (fn (i, _) => "c" ^ Int.toString i) pes
in
(strcat (str "(function (){ var "
- :: str (String.concatWith "," (normalVars @ patVars) ^ ";d0=")
+ :: str (String.concatWith "," (normalVars @ patVars @ caseVars) ^ ";d0=")
:: e
:: str ";\nreturn ("
:: List.revAppend (cases,
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