Export RPC functions and push RPC calls through to Mono

11 files changed, 73 insertions, 13 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index f8b1f23b..8f5c8551 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1849,6 +1849,7 @@ fun p_file env (ds, ps) =
         val fields = foldl (fn ((ek, _, _, ts), fields) =>
                                case ek of
                                    Core.Link => fields
+                                 | Core.Rpc => fields
                                  | Core.Action =>
                                    case List.nth (ts, length ts - 2) of
                                        (TRecord i, _) =>
@@ -1971,6 +1972,7 @@ fun p_file env (ds, ps) =
                 val (ts, defInputs, inputsVar) =
                     case ek of
                         Core.Link => (List.take (ts, length ts - 1), string "", string "")
+                      | Core.Rpc => (List.take (ts, length ts - 1), string "", string "")
                       | Core.Action =>
                         case List.nth (ts, length ts - 2) of
                             (TRecord i, _) =>
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 1a5d10c0..77674158 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -429,6 +429,8 @@ fun cifyExp (eAll as (e, loc), sm) =
       | L.ESignalBind _ => raise Fail "Cjrize: ESignalBind remains"
       | L.ESignalSource _ => raise Fail "Cjrize: ESignalSource remains"
 
+      | L.EServerCall _ => raise Fail "Cjrize EServerCall"
+
 fun cifyDecl ((d, loc), sm) =
     case d of
         L.DDatatype (x, n, xncs) =>
diff --git a/src/core.sml b/src/core.sml
index fbe150c1..62f046fe 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -113,6 +113,7 @@ withtype exp = exp' located
 datatype export_kind =
          Link
        | Action
+       | Rpc
 
 datatype decl' =
          DCon of string * int * kind * con
diff --git a/src/core_print.sml b/src/core_print.sml
index 64cead70..e9a36fbb 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -436,6 +436,7 @@ fun p_export_kind ck =
     case ck of
         Link => string "link"
       | Action => string "action"
+      | Rpc => string "rpc"
 
 fun p_datatype env (x, n, xs, cons) =
     let
diff --git a/src/jscomp.sml b/src/jscomp.sml
index f61ec3f0..627ba8f6 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -98,6 +98,7 @@ fun varDepth (e, _) =
       | ESignalReturn e => varDepth e
       | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2)
       | ESignalSource e => varDepth e
+      | EServerCall (_, es, ek) => foldl Int.max (varDepth ek) (map varDepth es)
 
 fun closedUpto d =
     let
@@ -138,6 +139,7 @@ fun closedUpto d =
               | ESignalReturn e => cu inner e
               | ESignalBind (e1, e2) => cu inner e1 andalso cu inner e2
               | ESignalSource e => cu inner e
+              | EServerCall (_, es, ek) => List.all (cu inner) es andalso cu inner ek
     in
         cu 0
     end
@@ -809,6 +811,8 @@ fun process file =
                                          str ")"],
                                  st)
                             end
+
+                          | EServerCall _ => raise Fail "Jscomp EServerCall"
                     end
             in
                 jsE
diff --git a/src/mono.sml b/src/mono.sml
index 8999704c..547f8a55 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -109,6 +109,8 @@ datatype exp' =
        | ESignalBind of exp * exp
        | ESignalSource of exp
 
+       | EServerCall of int * exp list * exp
+
 withtype exp = exp' located
 
 datatype decl' =
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 1e9de3d8..a859a1bd 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -308,6 +308,15 @@ fun p_exp' par env (e, _) =
                                 p_exp env e,
                                 string ")"]
 
+      | EServerCall (n, es, e) => box [string "Server(",
+                                       p_enamed env n,
+                                       string ",",
+                                       space,
+                                       p_list (p_exp env) es,
+                                       string ")[",
+                                       p_exp env e,
+                                       string "]"]
+
 and p_exp env = p_exp' false env
 
 fun p_vali env (x, n, t, e, s) =
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 878fec92..7d39648a 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -81,6 +81,7 @@ fun impure (e, _) =
       | ESignalReturn e => impure e
       | ESignalBind (e1, e2) => impure e1 orelse impure e2
       | ESignalSource e => impure e
+      | EServerCall _ => true
 
 
 val liftExpInExp = Monoize.liftExpInExp
@@ -344,6 +345,8 @@ fun reduce file =
                       | ESignalReturn e => summarize d e
                       | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
                       | ESignalSource e => summarize d e
+
+                      | EServerCall (_, es, ek) => List.concat (map (summarize d) es) @ summarize d ek @ [Unsure]
             in
                 (*Print.prefaces "Summarize"
                                [("e", MonoPrint.p_exp MonoEnv.empty (e, ErrorMsg.dummySpan)),
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 9ce3293b..13e0d32c 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -349,6 +349,13 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                 S.map2 (mfe ctx e,
                      fn e' =>
                         (ESignalSource e', loc))
+
+              | EServerCall (n, es, ek) =>
+                S.bind2 (ListUtil.mapfold (fn e => mfe ctx e) es,
+                      fn es' =>
+                         S.map2 (mfe ctx ek,
+                                 fn ek' =>
+                                    (EServerCall (n, es', ek'), loc)))
     in
         mfe
     end
diff --git a/src/monoize.sml b/src/monoize.sml
index a1f61143..fb1ac2f1 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2225,7 +2225,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((L'.ELet (x, t', e1, e2), loc), fm)
             end
 
-          | L.EServerCall _ => raise Fail "Monoize EServerCall"
+          | L.EServerCall (n, es, ek) =>
+            let
+                val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
+                val (ek, fm) = monoExp (env, st, fm) ek
+            in
+                ((L'.EServerCall (n, es, ek), loc), fm)
+            end
     end
 
 fun monoDecl (env, fm) (all as (d, loc)) =
diff --git a/src/rpcify.sml b/src/rpcify.sml
index dec8dc18..09c44a7a 100644
--- a/src/rpcify.sml
+++ b/src/rpcify.sml
@@ -53,8 +53,11 @@ val csBasis = SS.addList (SS.empty,
                            "alert"])
 
 type state = {
-     exps : int IM.map,
-     decls : (string * int * con * exp * string) list
+     cpsed : int IM.map,
+     cps_decls : (string * int * con * exp * string) list,
+
+     exported : IS.set,
+     export_decls : decl list
 }
 
 fun frob file =
@@ -114,6 +117,19 @@ fun frob file =
                                        (0, []))
 
                          val (n, args) = getApp (trans1, [])
+
+                         val (exported, export_decls) =
+                             if IS.member (#exported st, n) then
+                                 (#exported st, #export_decls st)
+                             else
+                                 (IS.add (#exported st, n),
+                                  (DExport (Rpc, n), loc) :: #export_decls st)
+
+                         val st = {cpsed = #cpsed st,
+                                   cps_decls = #cps_decls st,
+
+                                   exported = exported,
+                                   export_decls = export_decls}
                      in
                          (EServerCall (n, args, trans2), st)
                      end
@@ -128,19 +144,26 @@ fun frob file =
                                               decl = fn x => x}
                               st d
             in
-                (case #decls st of
-                     [] => [d]
-                   | ds =>
-                     case d of
-                         (DValRec vis, loc) => [(DValRec (ds @ vis), loc)]
-                       | (_, loc) => [(DValRec ds, loc), d],
-                 {decls = [],
-                  exps = #exps st})
+                (List.revAppend (case #cps_decls st of
+                                     [] => [d]
+                                   | ds =>
+                                     case d of
+                                         (DValRec vis, loc) => [(DValRec (ds @ vis), loc)]
+                                       | (_, loc) => [d, (DValRec ds, loc)],
+                                 #export_decls st),
+                 {cpsed = #cpsed st,
+                  cps_decls = [],
+                  
+                  exported = #exported st,
+                  export_decls = []})
             end
 
         val (file, _) = ListUtil.foldlMapConcat decl
-                        {decls = [],
-                         exps = IM.empty}
+                        {cpsed = IM.empty,
+                         cps_decls = [],
+
+                         exported = IS.empty,
+                         export_decls = []}
                         file
     in
         file