Mercurial > urweb

comparison src/monoize.sml @ 970:8371d12ae63f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Hopefully complete refactoring of Jscomp to output ASTs; partial implementation of interpreter in runtime system (demo/alert works)
author Adam Chlipala <adamc@hcoop.net>
date Tue, 22 Sep 2009 12:23:21 -0400
parents 8c37699de273
children 68eda5b0636d
comparison
equal deleted inserted replaced
969:001edfbe2561 970:8371d12ae63f
2520 fm) 2520 fm)
2521 end 2521 end
2522 | (L'.TFun (dom, _), _) => 2522 | (L'.TFun (dom, _), _) =>
2523 let 2523 let
2524 val s' = " " ^ lowercaseFirst x ^ "='" 2524 val s' = " " ^ lowercaseFirst x ^ "='"
2525 val e = case #1 dom of 2525 val (e, s') =
2526 L'.TRecord [] => (L'.EApp (e, (L'.ERecord [], loc)), loc) 2526 case #1 dom of
2527 | _ => (L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "kc", []), loc)), 2527 L'.TRecord [] => ((L'.EApp (e, (L'.ERecord [], loc)), loc), s')
2528 loc), (L'.ERecord [], loc)), loc) 2528 | _ => ((L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "kc", []), loc)),
2529 loc), (L'.ERecord [], loc)), loc),
2530 s' ^ "uwe=event;")
2531 val s' = s' ^ "exec("
2529 in 2532 in
2530 ((L'.EStrcat (s, 2533 ((L'.EStrcat (s,
2531 (L'.EStrcat ( 2534 (L'.EStrcat (
2532 (L'.EPrim (Prim.String s'), loc), 2535 (L'.EPrim (Prim.String s'), loc),
2533 (L'.EStrcat ( 2536 (L'.EStrcat (
2534 (L'.EJavaScript (L'.Attribute, e), loc), 2537 (L'.EJavaScript (L'.Attribute, e), loc),
2535 (L'.EPrim (Prim.String ";return false'"), loc)), loc)), 2538 (L'.EPrim (Prim.String ");return false'"), loc)), loc)),
2536 loc)), loc), 2539 loc)), loc),
2537 fm) 2540 fm)
2538 end 2541 end
2539 | _ => 2542 | _ =>
2540 let 2543 let
2619 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc) 2622 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
2620 2623
2621 val assgns = List.mapPartial 2624 val assgns = List.mapPartial
2622 (fn ("Source", _, _) => NONE 2625 (fn ("Source", _, _) => NONE
2623 | ("Onchange", e, _) => 2626 | ("Onchange", e, _) =>
2624 SOME (strcat [str "addOnChange(d,", 2627 SOME (strcat [str "addOnChange(d,exec(",
2625 (L'.EJavaScript (L'.Script, e), loc), 2628 (L'.EJavaScript (L'.Script, e), loc),
2626 str ")"]) 2629 str "))"])
2627 | (x, e, _) => 2630 | (x, e, _) =>
2628 SOME (strcat [str ("d." ^ lowercaseFirst x ^ "="), 2631 SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("),
2629 (L'.EJavaScript (L'.Script, e), loc), 2632 (L'.EJavaScript (L'.Script, e), loc),
2630 str ";"])) 2633 str ");"]))
2631 attrs 2634 attrs
2632 in 2635 in
2633 case assgns of 2636 case assgns of
2634 [] => jexp 2637 [] => jexp
2635 | _ => strcat (str "var d=" 2638 | _ => strcat (str "var d="
2644 NONE => (L'.EPrim (Prim.String ""), loc) 2647 NONE => (L'.EPrim (Prim.String ""), loc)
2645 | SOME e => 2648 | SOME e =>
2646 let 2649 let
2647 val e = (L'.EApp (e, (L'.ERecord [], loc)), loc) 2650 val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
2648 in 2651 in
2649 (L'.EJavaScript (L'.Attribute, e), loc) 2652 (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc),
2653 (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc),
2654 (L'.EPrim (Prim.String ")"), loc)), loc)), loc)
2650 end 2655 end
2651 in 2656 in
2652 normal ("body", 2657 normal ("body",
2653 SOME (L'.EFfiApp ("Basis", "maybe_onload", 2658 SOME (L'.EFfiApp ("Basis", "maybe_onload",
2654 [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", 2659 [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings",
2675 in 2680 in
2676 case attrs of 2681 case attrs of
2677 [("Signal", e, _)] => 2682 [("Signal", e, _)] =>
2678 ((L'.EStrcat 2683 ((L'.EStrcat
2679 ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\"" 2684 ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\""
2680 ^ tag ^ "\", ")), loc), 2685 ^ tag ^ "\", exec(")), loc),
2681 (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), 2686 (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
2682 (L'.EPrim (Prim.String (")</script>")), loc)), loc)), loc), 2687 (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
2683 fm) 2688 fm)
2684 | _ => raise Fail "Monoize: Bad dyn attributes" 2689 | _ => raise Fail "Monoize: Bad dyn attributes"
2685 end 2690 end
2686 2691
2687 | "submit" => normal ("input type=\"submit\"", NONE, NONE) 2692 | "submit" => normal ("input type=\"submit\"", NONE, NONE)
2699 ((L'.EStrcat (ts, 2704 ((L'.EStrcat (ts,
2700 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\" />")), 2705 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\" />")),
2701 loc)), loc), fm) 2706 loc)), loc), fm)
2702 end 2707 end
2703 | SOME (_, src, _) => 2708 | SOME (_, src, _) =>
2704 (strcat [str "<script type=\"text/javascript\">inp(", 2709 (strcat [str "<script type=\"text/javascript\">inp(exec(",
2705 (L'.EJavaScript (L'.Script, src), loc), 2710 (L'.EJavaScript (L'.Script, src), loc),
2706 str ")</script>"], 2711 str "))</script>"],
2707 fm)) 2712 fm))
2708 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 2713 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
2709 raise Fail "No name passed to textbox tag")) 2714 raise Fail "No name passed to textbox tag"))
2710 | "password" => input "password" 2715 | "password" => input "password"
2711 | "textarea" => 2716 | "textarea" =>
2771 (L'.EPrim (Prim.String " />"), loc)), 2776 (L'.EPrim (Prim.String " />"), loc)),
2772 loc), fm) 2777 loc), fm)
2773 end 2778 end
2774 | SOME (_, src, _) => 2779 | SOME (_, src, _) =>
2775 let 2780 let
2776 val sc = strcat [str "inp(", 2781 val sc = strcat [str "inp(exec(",
2777 (L'.EJavaScript (L'.Script, src), loc), 2782 (L'.EJavaScript (L'.Script, src), loc),
2778 str ")"] 2783 str "))"]
2779 val sc = setAttrs sc 2784 val sc = setAttrs sc
2780 in 2785 in
2781 (strcat [str "<script type=\"text/javascript\">", 2786 (strcat [str "<script type=\"text/javascript\">",
2782 sc, 2787 sc,
2783 str "</script>"], 2788 str "</script>"],
2794 (L'.EPrim (Prim.String " />"), loc)), 2799 (L'.EPrim (Prim.String " />"), loc)),
2795 loc), fm) 2800 loc), fm)
2796 end 2801 end
2797 | SOME (_, src, _) => 2802 | SOME (_, src, _) =>
2798 let 2803 let
2799 val sc = strcat [str "chk(", 2804 val sc = strcat [str "chk(exec(",
2800 (L'.EJavaScript (L'.Script, src), loc), 2805 (L'.EJavaScript (L'.Script, src), loc),
2801 str ")"] 2806 str "))"]
2802 val sc = setAttrs sc 2807 val sc = setAttrs sc
2803 in 2808 in
2804 (strcat [str "<script type=\"text/javascript\">", 2809 (strcat [str "<script type=\"text/javascript\">",
2805 sc, 2810 sc,
2806 str "</script>"], 2811 str "</script>"],
2822 end 2827 end
2823 | SOME (_, src, _) => 2828 | SOME (_, src, _) =>
2824 let 2829 let
2825 val (xml, fm) = monoExp (env, st, fm) xml 2830 val (xml, fm) = monoExp (env, st, fm) xml
2826 2831
2827 val sc = strcat [str "sel(", 2832 val sc = strcat [str "sel(exec(",
2828 (L'.EJavaScript (L'.Script, src), loc), 2833 (L'.EJavaScript (L'.Script, src), loc),
2829 str ",", 2834 str ",",
2830 (L'.EJavaScript (L'.Script, xml), loc), 2835 (L'.EJavaScript (L'.Script, xml), loc),
2831 str ")"] 2836 str "))"]
2832 val sc = setAttrs sc 2837 val sc = setAttrs sc
2833 in 2838 in
2834 (strcat [str "<script type=\"text/javascript\">", 2839 (strcat [str "<script type=\"text/javascript\">",
2835 sc, 2840 sc,
2836 str "</script>"], 2841 str "</script>"],