Mercurial > urweb
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