Mercurial > urweb
changeset 578:1e589a60b86f
Harmonized source-setting between server and client
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 30 Dec 2008 11:33:31 -0500 |
| parents | 3d56940120b1 |
| children | 0094e0242100 |
| files | src/cjrize.sml src/jscomp.sml src/mono.sml src/mono_opt.sml src/mono_print.sml src/mono_reduce.sml src/mono_util.sml src/monoize.sml |
| diffstat | 8 files changed, 41 insertions(+), 23 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjrize.sml Tue Dec 30 10:49:42 2008 -0500 +++ b/src/cjrize.sml Tue Dec 30 11:33:31 2008 -0500 @@ -422,7 +422,9 @@ ((L'.EUnurlify (e, t), loc), sm) end + | L.EJavaScript (_, _, SOME e) => cifyExp (e, sm) | L.EJavaScript _ => raise Fail "Cjrize: EJavaScript remains" + | L.ESignalReturn _ => raise Fail "Cjrize: ESignalReturn remains" | L.ESignalBind _ => raise Fail "Cjrize: ESignalBind remains" | L.ESignalSource _ => raise Fail "Cjrize: ESignalSource remains"
--- a/src/jscomp.sml Tue Dec 30 10:49:42 2008 -0500 +++ b/src/jscomp.sml Tue Dec 30 11:33:31 2008 -0500 @@ -190,6 +190,12 @@ end | EFfiApp (m, x, args) => let + val args = + case (m, x, args) of + ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) => [e] + | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) => [e1, e2] + | _ => args + val name = case ffi (m, x) of NONE => (EM.errorAt loc ("Unsupported FFI function " ^ x ^ " in JavaScript"); "ERROR") @@ -200,7 +206,6 @@ | [e] => let val (e, st) = jsE inner (e, st) - in (strcat [str (name ^ "("), e, @@ -398,7 +403,7 @@ U.Decl.foldMapB {typ = fn x => x, exp = fn (env, e, st) => let - fun doCode m env e = + fun doCode m env orig e = let val len = length env fun str s = (EPrim (Prim.String s), #2 e) @@ -408,12 +413,12 @@ fn i => str ("var uwr" ^ Int.toString (len + i) ^ ";")) val (e, st) = jsExp m env 0 (e, st) in - (#1 (strcat (#2 e) (locals @ [e])), st) + (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st) end in case e of - EJavaScript (m, (EAbs (_, t, _, e), _)) => doCode m (t :: env) e - | EJavaScript (m, e) => doCode m env e + EJavaScript (m, orig as (EAbs (_, t, _, e), _), _) => doCode m (t :: env) orig e + | EJavaScript (m, e, _) => doCode m env e e | _ => (e, st) end, decl = fn (_, e, st) => (e, st),
--- a/src/mono.sml Tue Dec 30 10:49:42 2008 -0500 +++ b/src/mono.sml Tue Dec 30 11:33:31 2008 -0500 @@ -103,7 +103,7 @@ | EUnurlify of exp * typ - | EJavaScript of javascript_mode * exp + | EJavaScript of javascript_mode * exp * exp option | ESignalReturn of exp | ESignalBind of exp * exp
--- a/src/mono_opt.sml Tue Dec 30 10:49:42 2008 -0500 +++ b/src/mono_opt.sml Tue Dec 30 11:33:31 2008 -0500 @@ -363,6 +363,8 @@ | ESignalBind ((ESignalReturn e1, loc), e2) => optExp (EApp (e2, e1), loc) + | EJavaScript (_, _, SOME (e, _)) => e + | _ => e and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
--- a/src/mono_print.sml Tue Dec 30 10:49:42 2008 -0500 +++ b/src/mono_print.sml Tue Dec 30 11:33:31 2008 -0500 @@ -216,10 +216,12 @@ p_exp env e, string ")"] - | ESeq (e1, e2) => box [p_exp env e1, + | ESeq (e1, e2) => box [string "(", + p_exp env e1, string ";", space, - p_exp env e2] + p_exp env e2, + string ")"] | ELet (x, t, e1, e2) => box [string "(let", space, string x, @@ -279,9 +281,10 @@ | EUnurlify (e, _) => box [string "unurlify(", p_exp env e, string ")"] - | EJavaScript (_, e) => box [string "JavaScript(", - p_exp env e, - string ")"] + | EJavaScript (_, e, NONE) => box [string "JavaScript(", + p_exp env e, + string ")"] + | EJavaScript (_, _, SOME e) => p_exp env e | ESignalReturn e => box [string "Return(", p_exp env e,
--- a/src/mono_reduce.sml Tue Dec 30 10:49:42 2008 -0500 +++ b/src/mono_reduce.sml Tue Dec 30 11:33:31 2008 -0500 @@ -76,7 +76,7 @@ | ELet (_, _, e1, e2) => impure e1 orelse impure e2 | EClosure (_, es) => List.exists impure es - | EJavaScript (_, e) => impure e + | EJavaScript (_, e, _) => impure e | ESignalReturn e => impure e | ESignalBind (e1, e2) => impure e1 orelse impure e2 | ESignalSource e => impure e @@ -335,7 +335,7 @@ | EDml e => summarize d e @ [WriteDb] | ENextval e => summarize d e @ [WriteDb] | EUnurlify (e, _) => summarize d e - | EJavaScript (_, e) => summarize d e + | EJavaScript (_, e, _) => summarize d e | ESignalReturn e => summarize d e | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2 | ESignalSource e => summarize d e
--- a/src/mono_util.sml Tue Dec 30 10:49:42 2008 -0500 +++ b/src/mono_util.sml Tue Dec 30 11:33:31 2008 -0500 @@ -324,10 +324,16 @@ S.map2 (mft t, fn t' => (EUnurlify (e', t'), loc))) - | EJavaScript (m, e) => + | EJavaScript (m, e, NONE) => S.map2 (mfe ctx e, fn e' => - (EJavaScript (m, e'), loc)) + (EJavaScript (m, e', NONE), loc)) + | EJavaScript (m, e, SOME e2) => + S.bind2 (mfe ctx e, + fn e' => + S.map2 (mfe ctx e2, + fn e2' => + (EJavaScript (m, e', SOME e2'), loc))) | ESignalReturn e => S.map2 (mfe ctx e,
--- a/src/monoize.sml Tue Dec 30 10:49:42 2008 -0500 +++ b/src/monoize.sml Tue Dec 30 11:33:31 2008 -0500 @@ -976,7 +976,8 @@ ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TSource, loc)), loc), (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TSource, loc), (L'.EFfiApp ("Basis", "new_client_source", - [(L'.EJavaScript (L'.File, (L'.ERel 1, loc)), loc)]), loc)), loc)), + [(L'.EJavaScript (L'.File, (L'.ERel 1, loc), NONE), loc)]), + loc)), loc)), loc), fm) end @@ -990,7 +991,7 @@ (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), (L'.EFfiApp ("Basis", "set_client_source", [(L'.ERel 2, loc), - (L'.EJavaScript (L'.File, (L'.ERel 1, loc)), loc)]), + (L'.EJavaScript (L'.File, (L'.ERel 1, loc), NONE), loc)]), loc)), loc)), loc)), loc), fm) end @@ -1801,7 +1802,7 @@ (L'.EStrcat ( (L'.EPrim (Prim.String s'), loc), (L'.EStrcat ( - (L'.EJavaScript (L'.Attribute, e), loc), + (L'.EJavaScript (L'.Attribute, e, NONE), loc), (L'.EPrim (Prim.String "'"), loc)), loc)), loc)), loc), fm) @@ -1887,13 +1888,12 @@ | "dyn" => (case #1 attrs of - (*L'.ERecord [("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _), - e), _), _)] => (e, fm) *) - - L'.ERecord [("Signal", e, _)] => + L'.ERecord [("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _), + e), _), _)] => (e, fm) + | L'.ERecord [("Signal", e, _)] => ((L'.EStrcat ((L'.EPrim (Prim.String "<script type=\"text/javascript\">dyn("), loc), - (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), + (L'.EStrcat ((L'.EJavaScript (L'.Script, e, NONE), loc), (L'.EPrim (Prim.String ")</script>"), loc)), loc)), loc), fm) | _ => raise Fail "Monoize: Bad dyn attributes")