# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1243532825 14400
# Node ID 497c7dbcc695a1bba59ce143053b51c398ed40f1
# Parent  78504d97410b8f75197d0e2748d71cbf60a49669
Fix variable adjustment bug in fn/case alternation

diff -r 78504d97410b -r 497c7dbcc695 src/jscomp.sml
--- a/src/jscomp.sml	Thu May 28 12:40:55 2009 -0400
+++ b/src/jscomp.sml	Thu May 28 13:47:05 2009 -0400
@@ -913,9 +913,10 @@
                                 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 -r 78504d97410b -r 497c7dbcc695 src/mono_reduce.sml
--- a/src/mono_reduce.sml	Thu May 28 12:40:55 2009 -0400
+++ b/src/mono_reduce.sml	Thu May 28 13:47:05 2009 -0400
@@ -131,7 +131,7 @@
                                      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 @@
                                 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