Mercurial > urweb
changeset 827:497c7dbcc695
Fix variable adjustment bug in fn/case alternation
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 28 May 2009 13:47:05 -0400 |
| parents | 78504d97410b |
| children | 14a6c0971d89 |
| files | src/jscomp.sml src/mono_reduce.sml |
| diffstat | 2 files changed, 17 insertions(+), 8 deletions(-) [+] |
line wrap: on
line diff
--- 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,
--- 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