Harmonized source-setting between server and client

8 files changed, 41 insertions, 23 deletions

diff --git a/src/cjrize.sml b/src/cjrize.sml
index 6d0ece61..1a5d10c0 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -422,7 +422,9 @@ fun cifyExp (eAll as (e, loc), sm) =
             ((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"
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 8b874289..a4e3dd35 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -190,6 +190,12 @@ fun jsExp mode outer =
                     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 @@ fun jsExp mode outer =
                           | [e] =>
                             let
                                 val (e, st) = jsE inner (e, st)
-                                              
                             in
                                 (strcat [str (name ^ "("),
                                          e,
@@ -398,7 +403,7 @@ val decl : state -> decl -> decl * state =
     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 @@ val decl : state -> decl -> decl * state =
                                                          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),
diff --git a/src/mono.sml b/src/mono.sml
index 41457071..b58396fa 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -103,7 +103,7 @@ datatype exp' =
 
        | EUnurlify of exp * typ
 
-       | EJavaScript of javascript_mode * exp
+       | EJavaScript of javascript_mode * exp * exp option
 
        | ESignalReturn of exp
        | ESignalBind of exp * exp
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 550a055c..7f23d8b1 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -363,6 +363,8 @@ fun exp e =
       | 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)
diff --git a/src/mono_print.sml b/src/mono_print.sml
index a876cfac..f8a23d1d 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -216,10 +216,12 @@ fun p_exp' par env (e, _) =
                          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 @@ fun p_exp' par env (e, _) =
       | 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,
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 072c548e..c96f97cf 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -76,7 +76,7 @@ fun impure (e, _) =
       | 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 @@ fun reduce file =
               | 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
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 3f9183d0..9ce3293b 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -324,10 +324,16 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                         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,
diff --git a/src/monoize.sml b/src/monoize.sml
index f40d49d0..f62848c5 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -976,7 +976,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                      (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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                             (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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                   | "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")