changeset 810:c1f8963ebb18

Fix another problem with overwrites during JavaScript pattern matching
author Adam Chlipala <adamc@hcoop.net>
date Sat, 16 May 2009 16:37:48 -0400
parents 81fce435e255
children 50b4825115f0
files lib/js/urweb.js src/jscomp.sml
diffstat 2 files changed, 10 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/lib/js/urweb.js	Sat May 16 16:02:17 2009 -0400
+++ b/lib/js/urweb.js	Sat May 16 16:37:48 2009 -0400
@@ -30,8 +30,8 @@
   throw msg;
 }
 
-function pf() {
-  whine("Pattern match failure");
+function pf(loc) {
+  whine("Pattern match failure (" + loc + ")");
 }
 
 function runHandlers(kind, ls, arg) {
--- a/src/jscomp.sml	Sat May 16 16:02:17 2009 -0400
+++ b/src/jscomp.sml	Sat May 16 16:37:48 2009 -0400
@@ -457,7 +457,7 @@
                                                       ^ ":" ^ e,
                                                       st)
                                                  end)
-                                             ("pf()", st) cs
+                                             ("pf(\"" ^ ErrorMsg.spanToString loc ^ "\")", st) cs
 
                          val body = "function _n" ^ Int.toString n' ^ "(t,i){var x=t[i++];var r="
                                     ^ e ^ ";return {_1:i,_2:r}}\n\n"
@@ -573,13 +573,13 @@
                                 (case IM.find (someTs, n) of
                                      NONE => raise Fail "Jscomp: Not in someTs"
                                    | SOME t =>
-                                     strcat [str ("(d" ^ Int.toString depth ^ "?("
+                                     strcat [str ("(d" ^ Int.toString depth ^ "?(d"
+                                                  ^ Int.toString (depth+1) ^ "=d" ^ Int.toString depth
                                                   ^ (if isNullable t then
-                                                         "d" ^ Int.toString depth ^ "=d"
-                                                         ^ Int.toString depth ^ ".v,"
+                                                         ".v,"
                                                      else
                                                          "")),
-                                             jsPat depth inner p succ fail,
+                                             jsPat (depth+1) inner p succ fail,
                                              str "):",
                                              fail,
                                              str ")"])
@@ -594,8 +594,8 @@
                               | PCon (_, pc, SOME p) =>
                                 strcat [str ("(d" ^ Int.toString depth ^ ".n=="),
                                         patCon pc,
-                                        str ("?(d" ^ Int.toString depth ^ "=d" ^ Int.toString depth ^ ".v,"),
-                                        jsPat depth inner p succ fail,
+                                        str ("?(d" ^ Int.toString (depth+1) ^ "=d" ^ Int.toString depth ^ ".v,"),
+                                        jsPat (depth+1) inner p succ fail,
                                         str "):",
                                         fail,
                                         str ")"]
@@ -898,7 +898,7 @@
                                                               val (e, st) = jsE (inner + E.patBindsN p) (e, st)
                                                               val fail =
                                                                   if i = plen - 1 then
-                                                                      str "pf()"
+                                                                      str ("pf(\"" ^ ErrorMsg.spanToString loc ^ "\")")
                                                                   else
                                                                       str ("c" ^ Int.toString (i+1) ^ "()")
                                                               val c = jsPat 0 inner p e fail