Mercurial > urweb

comparison src/monoize.sml @ 815:493f44759879

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Redo Jscomp
author Adam Chlipala <adamc@hcoop.net>
date Sun, 17 May 2009 18:41:43 -0400
parents 7b380e2b9e68
children 26e911ee924c
comparison
equal deleted inserted replaced
814:3f3b211f9bca 815:493f44759879
1171 val t = monoType env t 1171 val t = monoType env t
1172 in 1172 in
1173 ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TSource, loc)), loc), 1173 ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TSource, loc)), loc),
1174 (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TSource, loc), 1174 (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TSource, loc),
1175 (L'.EFfiApp ("Basis", "new_client_source", 1175 (L'.EFfiApp ("Basis", "new_client_source",
1176 [(L'.EJavaScript (L'.Source t, (L'.ERel 1, loc), NONE), loc)]), 1176 [(L'.EJavaScript (L'.Source t, (L'.ERel 1, loc)), loc)]),
1177 loc)), loc)), 1177 loc)), loc)),
1178 loc), 1178 loc),
1179 fm) 1179 fm)
1180 end 1180 end
1181 | L.ECApp ((L.EFfi ("Basis", "set"), _), t) => 1181 | L.ECApp ((L.EFfi ("Basis", "set"), _), t) =>
1187 (L'.EAbs ("v", t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc), 1187 (L'.EAbs ("v", t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc),
1188 (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), 1188 (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
1189 (L'.EFfiApp ("Basis", "set_client_source", 1189 (L'.EFfiApp ("Basis", "set_client_source",
1190 [(L'.ERel 2, loc), 1190 [(L'.ERel 2, loc),
1191 (L'.EJavaScript (L'.Source t, 1191 (L'.EJavaScript (L'.Source t,
1192 (L'.ERel 1, loc), NONE), loc)]), 1192 (L'.ERel 1, loc)), loc)]),
1193 loc)), loc)), loc)), loc), 1193 loc)), loc)), loc)), loc),
1194 fm) 1194 fm)
1195 end 1195 end
1196 | L.ECApp ((L.EFfi ("Basis", "get"), _), t) => 1196 | L.ECApp ((L.EFfi ("Basis", "get"), _), t) =>
1197 let 1197 let
2408 in 2408 in
2409 ((L'.EStrcat (s, 2409 ((L'.EStrcat (s,
2410 (L'.EStrcat ( 2410 (L'.EStrcat (
2411 (L'.EPrim (Prim.String s'), loc), 2411 (L'.EPrim (Prim.String s'), loc),
2412 (L'.EStrcat ( 2412 (L'.EStrcat (
2413 (L'.EJavaScript (L'.Attribute, e, NONE), loc), 2413 (L'.EJavaScript (L'.Attribute, e), loc),
2414 (L'.EPrim (Prim.String "'"), loc)), loc)), 2414 (L'.EPrim (Prim.String "'"), loc)), loc)),
2415 loc)), loc), 2415 loc)), loc),
2416 fm) 2416 fm)
2417 end 2417 end
2418 | _ => 2418 | _ =>
2498 2498
2499 val assgns = List.mapPartial 2499 val assgns = List.mapPartial
2500 (fn ("Source", _, _) => NONE 2500 (fn ("Source", _, _) => NONE
2501 | ("Onchange", e, _) => 2501 | ("Onchange", e, _) =>
2502 SOME (strcat [str "addOnChange(d,", 2502 SOME (strcat [str "addOnChange(d,",
2503 (L'.EJavaScript (L'.Script, e, NONE), loc), 2503 (L'.EJavaScript (L'.Script, e), loc),
2504 str ")"]) 2504 str ")"])
2505 | (x, e, _) => 2505 | (x, e, _) =>
2506 SOME (strcat [str ("d." ^ lowercaseFirst x ^ "="), 2506 SOME (strcat [str ("d." ^ lowercaseFirst x ^ "="),
2507 (L'.EJavaScript (L'.Script, e, NONE), loc), 2507 (L'.EJavaScript (L'.Script, e), loc),
2508 str ";"])) 2508 str ";"]))
2509 attrs 2509 attrs
2510 in 2510 in
2511 case assgns of 2511 case assgns of
2512 [] => jexp 2512 [] => jexp
2522 NONE => (L'.EPrim (Prim.String ""), loc) 2522 NONE => (L'.EPrim (Prim.String ""), loc)
2523 | SOME e => 2523 | SOME e =>
2524 let 2524 let
2525 val e = (L'.EApp (e, (L'.ERecord [], loc)), loc) 2525 val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
2526 in 2526 in
2527 (L'.EJavaScript (L'.Attribute, e, NONE), loc) 2527 (L'.EJavaScript (L'.Attribute, e), loc)
2528 end 2528 end
2529 in 2529 in
2530 normal ("body", 2530 normal ("body",
2531 SOME (L'.EFfiApp ("Basis", "maybe_onload", 2531 SOME (L'.EFfiApp ("Basis", "maybe_onload",
2532 [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", 2532 [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings",
2541 (*[("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _), 2541 (*[("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _),
2542 e), _), _)] => (e, fm) 2542 e), _), _)] => (e, fm)
2543 |*) [("Signal", e, _)] => 2543 |*) [("Signal", e, _)] =>
2544 ((L'.EStrcat 2544 ((L'.EStrcat
2545 ((L'.EPrim (Prim.String "<span><script type=\"text/javascript\">dyn("), loc), 2545 ((L'.EPrim (Prim.String "<span><script type=\"text/javascript\">dyn("), loc),
2546 (L'.EStrcat ((L'.EJavaScript (L'.Script, e, NONE), loc), 2546 (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
2547 (L'.EPrim (Prim.String ")</script></span>"), loc)), loc)), loc), 2547 (L'.EPrim (Prim.String ")</script></span>"), loc)), loc)), loc),
2548 fm) 2548 fm)
2549 | _ => raise Fail "Monoize: Bad dyn attributes") 2549 | _ => raise Fail "Monoize: Bad dyn attributes")
2550 2550
2551 | "submit" => normal ("input type=\"submit\"", NONE, NONE) 2551 | "submit" => normal ("input type=\"submit\"", NONE, NONE)
2564 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\" />")), 2564 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\" />")),
2565 loc)), loc), fm) 2565 loc)), loc), fm)
2566 end 2566 end
2567 | SOME (_, src, _) => 2567 | SOME (_, src, _) =>
2568 (strcat [str "<span><script type=\"text/javascript\">inp(\"input\",", 2568 (strcat [str "<span><script type=\"text/javascript\">inp(\"input\",",
2569 (L'.EJavaScript (L'.Script, src, NONE), loc), 2569 (L'.EJavaScript (L'.Script, src), loc),
2570 str ",\"\")</script></span>"], 2570 str ",\"\")</script></span>"],
2571 fm)) 2571 fm))
2572 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 2572 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
2573 raise Fail "No name passed to textbox tag")) 2573 raise Fail "No name passed to textbox tag"))
2574 | "password" => input "password" 2574 | "password" => input "password"
2636 loc), fm) 2636 loc), fm)
2637 end 2637 end
2638 | SOME (_, src, _) => 2638 | SOME (_, src, _) =>
2639 let 2639 let
2640 val sc = strcat [str "inp(\"input\",", 2640 val sc = strcat [str "inp(\"input\",",
2641 (L'.EJavaScript (L'.Script, src, NONE), loc), 2641 (L'.EJavaScript (L'.Script, src), loc),
2642 str ",\"\")"] 2642 str ",\"\")"]
2643 val sc = setAttrs sc 2643 val sc = setAttrs sc
2644 in 2644 in
2645 (strcat [str "<span><script type=\"text/javascript\">", 2645 (strcat [str "<span><script type=\"text/javascript\">",
2646 sc, 2646 sc,
2661 | SOME (_, src, _) => 2661 | SOME (_, src, _) =>
2662 let 2662 let
2663 val (xml, fm) = monoExp (env, st, fm) xml 2663 val (xml, fm) = monoExp (env, st, fm) xml
2664 2664
2665 val sc = strcat [str "inp(\"select\",", 2665 val sc = strcat [str "inp(\"select\",",
2666 (L'.EJavaScript (L'.Script, src, NONE), loc), 2666 (L'.EJavaScript (L'.Script, src), loc),
2667 str ",", 2667 str ",",
2668 (L'.EJavaScript (L'.Script, xml, NONE), loc), 2668 (L'.EJavaScript (L'.Script, xml), loc),
2669 str ")"] 2669 str ")"]
2670 val sc = setAttrs sc 2670 val sc = setAttrs sc
2671 in 2671 in
2672 (strcat [str "<span><script type=\"text/javascript\">", 2672 (strcat [str "<span><script type=\"text/javascript\">",
2673 sc, 2673 sc,