comparison src/jscomp.sml @ 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 d8f58d488cfb
children 7b380e2b9e68
comparison
equal deleted inserted replaced
809:81fce435e255 810:c1f8963ebb18
455 e' 455 e'
456 | _ => "{n:" ^ Int.toString cn ^ ",v:" ^ e' ^ "}") 456 | _ => "{n:" ^ Int.toString cn ^ ",v:" ^ e' ^ "}")
457 ^ ":" ^ e, 457 ^ ":" ^ e,
458 st) 458 st)
459 end) 459 end)
460 ("pf()", st) cs 460 ("pf(\"" ^ ErrorMsg.spanToString loc ^ "\")", st) cs
461 461
462 val body = "function _n" ^ Int.toString n' ^ "(t,i){var x=t[i++];var r=" 462 val body = "function _n" ^ Int.toString n' ^ "(t,i){var x=t[i++];var r="
463 ^ e ^ ";return {_1:i,_2:r}}\n\n" 463 ^ e ^ ";return {_1:i,_2:r}}\n\n"
464 464
465 val st = {decls = #decls st, 465 val st = {decls = #decls st,
571 str ")"] 571 str ")"]
572 | PCon (Option, PConVar n, SOME p) => 572 | PCon (Option, PConVar n, SOME p) =>
573 (case IM.find (someTs, n) of 573 (case IM.find (someTs, n) of
574 NONE => raise Fail "Jscomp: Not in someTs" 574 NONE => raise Fail "Jscomp: Not in someTs"
575 | SOME t => 575 | SOME t =>
576 strcat [str ("(d" ^ Int.toString depth ^ "?(" 576 strcat [str ("(d" ^ Int.toString depth ^ "?(d"
577 ^ Int.toString (depth+1) ^ "=d" ^ Int.toString depth
577 ^ (if isNullable t then 578 ^ (if isNullable t then
578 "d" ^ Int.toString depth ^ "=d" 579 ".v,"
579 ^ Int.toString depth ^ ".v,"
580 else 580 else
581 "")), 581 "")),
582 jsPat depth inner p succ fail, 582 jsPat (depth+1) inner p succ fail,
583 str "):", 583 str "):",
584 fail, 584 fail,
585 str ")"]) 585 str ")"])
586 | PCon (_, pc, NONE) => 586 | PCon (_, pc, NONE) =>
587 strcat [str ("(d" ^ Int.toString depth ^ "=="), 587 strcat [str ("(d" ^ Int.toString depth ^ "=="),
592 fail, 592 fail,
593 str ")"] 593 str ")"]
594 | PCon (_, pc, SOME p) => 594 | PCon (_, pc, SOME p) =>
595 strcat [str ("(d" ^ Int.toString depth ^ ".n=="), 595 strcat [str ("(d" ^ Int.toString depth ^ ".n=="),
596 patCon pc, 596 patCon pc,
597 str ("?(d" ^ Int.toString depth ^ "=d" ^ Int.toString depth ^ ".v,"), 597 str ("?(d" ^ Int.toString (depth+1) ^ "=d" ^ Int.toString depth ^ ".v,"),
598 jsPat depth inner p succ fail, 598 jsPat (depth+1) inner p succ fail,
599 str "):", 599 str "):",
600 fail, 600 fail,
601 str ")"] 601 str ")"]
602 | PRecord xps => 602 | PRecord xps =>
603 let 603 let
896 (fn (i, (p, e), st) => 896 (fn (i, (p, e), st) =>
897 let 897 let
898 val (e, st) = jsE (inner + E.patBindsN p) (e, st) 898 val (e, st) = jsE (inner + E.patBindsN p) (e, st)
899 val fail = 899 val fail =
900 if i = plen - 1 then 900 if i = plen - 1 then
901 str "pf()" 901 str ("pf(\"" ^ ErrorMsg.spanToString loc ^ "\")")
902 else 902 else
903 str ("c" ^ Int.toString (i+1) ^ "()") 903 str ("c" ^ Int.toString (i+1) ^ "()")
904 val c = jsPat 0 inner p e fail 904 val c = jsPat 0 inner p e fail
905 in 905 in
906 (strcat [str ("c" ^ Int.toString i ^ "=function(){return "), 906 (strcat [str ("c" ^ Int.toString i ^ "=function(){return "),