grid1 compiles but gets stuck in JS

17 files changed, 315 insertions, 118 deletions

diff --git a/lib/ur/monad.ur b/lib/ur/monad.ur
index 356173fd..d6690839 100644
--- a/lib/ur/monad.ur
+++ b/lib/ur/monad.ur
@@ -34,6 +34,19 @@ fun foldR2 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tr :: {K
        (fn _ _ => return i)
        [_] fl
 
+fun foldR3 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tr :: {K} -> Type]
+           (f : nm :: Name -> t :: K -> rest :: {K}
+                -> [[nm] ~ rest] =>
+            tf1 t -> tf2 t -> tf3 t -> tr rest -> m (tr ([nm = t] ++ rest)))
+           (i : tr []) [r :: {K}] (fl : folder r) =
+    Top.fold [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m (tr r)]
+       (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 
+                        (acc : _ -> _ -> _ -> m (tr rest)) r1 r2 r3 =>
+           acc' <- acc (r1 -- nm) (r2 -- nm) (r3 -- nm);
+           f [nm] [t] [rest] ! r1.nm r2.nm r3.nm acc')
+       (fn _ _ _ => return i)
+       [_] fl
+
 fun mapR [K] [m] (_ : monad m) [tf :: K -> Type] [tr :: K -> Type]
          (f : nm :: Name -> t :: K -> tf t -> m (tr t)) =
     @@foldR [m] _ [tf] [fn r => $(map tr r)]
diff --git a/lib/ur/monad.urs b/lib/ur/monad.urs
index 662d780f..f64e2362 100644
--- a/lib/ur/monad.urs
+++ b/lib/ur/monad.urs
@@ -22,6 +22,15 @@ val foldR2 : K --> m ::: (Type -> Type) -> monad m
              -> tr []
              -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> m (tr r)
 
+val foldR3 : K --> m ::: (Type -> Type) -> monad m
+             -> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type)
+             -> tr :: ({K} -> Type)
+             -> (nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tf3 t -> tr rest -> m (tr ([nm = t] ++ rest)))
+             -> tr []
+             -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m (tr r)
+
 val mapR : K --> m ::: (Type -> Type) -> monad m
            -> tf :: (K -> Type)
            -> tr :: (K -> Type)
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index ce110b27..7073884f 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -155,6 +155,17 @@ fun foldR2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tr :: {K} -> Type]
            f [nm] [t] [rest] ! r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
        (fn _ _ => i)
 
+fun foldR3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tr :: {K} -> Type]
+            (f : nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tf3 t -> tr rest -> tr ([nm = t] ++ rest))
+            (i : tr []) [r :: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> tr r]
+       (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 
+                        (acc : _ -> _ -> _ -> tr rest) r1 r2 r3 =>
+           f [nm] [t] [rest] ! r1.nm r2.nm r3.nm (acc (r1 -- nm) (r2 -- nm) (r3 -- nm)))
+       (fn _ _ _ => i)
+
 fun foldRX [K] [tf :: K -> Type] [ctx :: {Unit}]
             (f : nm :: Name -> t :: K -> rest :: {K}
                  -> [[nm] ~ rest] =>
@@ -174,6 +185,16 @@ fun foldRX2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [ctx :: {Unit}]
                <xml>{f [nm] [t] [rest] ! r1 r2}{acc}</xml>)
            <xml/>
 
+fun foldRX3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [ctx :: {Unit}]
+             (f : nm :: Name -> t :: K -> rest :: {K}
+                  -> [[nm] ~ rest] =>
+                        tf1 t -> tf2 t -> tf3 t -> xml ctx [] []) =
+    foldR3 [tf1] [tf2] [tf3] [fn _ => xml ctx [] []]
+           (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
+                            r1 r2 r3 acc =>
+               <xml>{f [nm] [t] [rest] ! r1 r2 r3}{acc}</xml>)
+           <xml/>
+
 fun queryI [tables ::: {{Type}}] [exps ::: {Type}]
            [tables ~ exps] (q : sql_query tables exps)
            (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index bdf9d904..a19961f4 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -84,6 +84,14 @@ val foldR2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
              -> tr []
              -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> tr r
 
+val foldR3 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type)
+             -> tr :: ({K} -> Type)
+             -> (nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tf3 t -> tr rest -> tr ([nm = t] ++ rest))
+             -> tr []
+             -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> tr r
+
 val foldRX : K --> tf :: (K -> Type) -> ctx :: {Unit}
              -> (nm :: Name -> t :: K -> rest :: {K}
                  -> [[nm] ~ rest] =>
@@ -97,6 +105,13 @@ val foldRX2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> ctx :: {Unit}
               -> r :: {K} -> folder r
               -> $(map tf1 r) -> $(map tf2 r) -> xml ctx [] []
 
+val foldRX3 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type) -> ctx :: {Unit}
+              -> (nm :: Name -> t :: K -> rest :: {K}
+                  -> [[nm] ~ rest] =>
+                        tf1 t -> tf2 t -> tf3 t -> xml ctx [] [])
+              -> r :: {K} -> folder r
+              -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> xml ctx [] []
+
 val queryI : tables ::: {{Type}} -> exps ::: {Type}
              -> [tables ~ exps] =>
              sql_query tables exps
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 572d1658..068282f2 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1235,7 +1235,7 @@ uw_Basis_string uw_Basis_jsifyString(uw_context ctx, uw_Basis_string s) {
   }
 
   strcpy(s2, "\"");
-  ctx->heap.front = s2 + 1;
+  ctx->heap.front = s2 + 2;
   return r;
 }
 
diff --git a/src/compiler.sml b/src/compiler.sml
index 13bb77f9..c99c0eeb 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -805,7 +805,7 @@ val monoize = {
 val toMonoize = transform monoize "monoize" o toEffectize
 
 val mono_opt = {
-    func = (fn x => (MonoOpt.removeServerCalls := false; MonoOpt.optimize x)),
+    func = MonoOpt.optimize,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
@@ -841,12 +841,7 @@ val jscomp = {
 
 val toJscomp = transform jscomp "jscomp" o toMono_opt2
 
-val mono_opt' = {
-    func = (fn x => (MonoOpt.removeServerCalls := true; MonoOpt.optimize x)),
-    print = MonoPrint.p_file MonoEnv.empty
-}
-
-val toMono_opt3 = transform mono_opt' "mono_opt3" o toJscomp
+val toMono_opt3 = transform mono_opt "mono_opt3" o toJscomp
 
 val fuse = {
     func = Fuse.fuse,
diff --git a/src/core_print.sml b/src/core_print.sml
index 5daf7137..84b247a2 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -427,6 +427,7 @@ fun p_exp' par env (e, _) =
                                     string x,
                                     space,
                                     string ":",
+                                    space,
                                     p_con env t,
                                     space,
                                     string "=",
diff --git a/src/jscomp.sml b/src/jscomp.sml
index f2a48cf3..7a6c3094 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -86,7 +86,7 @@ fun varDepth (e, _) =
       | ESignalReturn e => varDepth e
       | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2)
       | ESignalSource e => varDepth e
-      | EServerCall (e, ek, _, _, _) => Int.max (varDepth e, varDepth ek)
+      | EServerCall (e, ek, _, _) => Int.max (varDepth e, varDepth ek)
       | ERecv (e, ek, _) => Int.max (varDepth e, varDepth ek)
       | ESleep (e, ek) => Int.max (varDepth e, varDepth ek)
 
@@ -130,7 +130,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 (e, ek, _, _, _) => cu inner e andalso cu inner ek
+              | EServerCall (e, ek, _, _) => cu inner e andalso cu inner ek
               | ERecv (e, ek, _) => cu inner e andalso cu inner ek
               | ESleep (e, ek) => cu inner e andalso cu inner ek
     in
@@ -389,6 +389,7 @@ fun process file =
         fun unurlifyExp loc (t : typ, st) =
             case #1 t of
                 TRecord [] => ("null", st)
+              | TFfi ("Basis", "unit") => ("null", st)
               | TRecord [(x, t)] =>
                 let
                     val (e, st) = unurlifyExp loc (t, st)
@@ -524,6 +525,7 @@ fun process file =
 
                         fun unsupported s =
                             (EM.errorAt loc (s ^ " in code to be compiled to JavaScript[2]");
+                             Print.preface ("Code", MonoPrint.p_exp MonoEnv.empty e);
                              (str "ERROR", st))
 
                         val strcat = strcat loc
@@ -669,7 +671,24 @@ fun process file =
                                       raise Fail "Jscomp: deStrcat")
 
                         val quoteExp = quoteExp loc
+
+                        val hasQuery = U.Exp.exists {typ = fn _ => false,
+                                                     exp = fn EQuery _ => true
+                                                            | _ => false}
+
+                        val indirectQuery = U.Exp.exists {typ = fn _ => false,
+                                                          exp = fn ENamed n =>
+                                                                   (case IM.find (nameds, n) of
+                                                                        NONE => false
+                                                                      | SOME e => hasQuery e)
+                                                                 | _ => false}
+
                     in
+                        (*if indirectQuery e then
+                            Print.preface ("Indirect", MonoPrint.p_exp MonoEnv.empty e)
+                        else
+                            ();*)
+
                         (*Print.prefaces "jsE" [("e", MonoPrint.p_exp MonoEnv.empty e),
                                               ("inner", Print.PD.string (Int.toString inner))];*)
 
@@ -1041,7 +1060,7 @@ fun process file =
                                  st)
                             end
 
-                          | EServerCall (e, ek, t, eff, _) =>
+                          | EServerCall (e, ek, t, eff) =>
                             let
                                 val (e, st) = jsE inner (e, st)
                                 val (ek, st) = jsE inner (ek, st)
@@ -1320,13 +1339,12 @@ fun process file =
                      ((ESignalSource e, loc), st)
                  end
                  
-               | EServerCall (e1, e2, t, ef, ue) =>
+               | EServerCall (e1, e2, t, ef) =>
                  let
                      val (e1, st) = exp outer (e1, st)
                      val (e2, st) = exp outer (e2, st)
-                     val (ue, st) = exp outer (ue, st)
                  in
-                     ((EServerCall (e1, e2, t, ef, ue), loc), st)
+                     ((EServerCall (e1, e2, t, ef), loc), st)
                  end
                | ERecv (e1, e2, t) =>
                  let
diff --git a/src/mono.sml b/src/mono.sml
index 2d29af48..64ed448c 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -114,7 +114,7 @@ datatype exp' =
        | ESignalBind of exp * exp
        | ESignalSource of exp
 
-       | EServerCall of exp * exp * typ * effect * exp
+       | EServerCall of exp * exp * typ * effect
        | ERecv of exp * exp * typ
        | ESleep of exp * exp
 
diff --git a/src/mono_opt.sig b/src/mono_opt.sig
index 7368f684..1d0fec5c 100644
--- a/src/mono_opt.sig
+++ b/src/mono_opt.sig
@@ -29,7 +29,5 @@ signature MONO_OPT = sig
 
     val optimize : Mono.file -> Mono.file
     val optExp : Mono.exp -> Mono.exp
-
-    val removeServerCalls : bool ref
-
+    
 end
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 7bfce88b..bf39b311 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -30,8 +30,6 @@ structure MonoOpt :> MONO_OPT = struct
 open Mono
 structure U = MonoUtil
 
-val removeServerCalls = ref false
-
 fun typ t = t
 fun decl d = d
 
@@ -482,12 +480,6 @@ fun exp e =
                    | [] => raise Fail "MonoOpt impossible nil")
               | NONE => e
         end
-
-      | EServerCall (_, _, _, _, ue) =>
-        if !removeServerCalls then
-            optExp ue
-        else
-            e
         
       | _ => e
 
diff --git a/src/mono_print.sml b/src/mono_print.sml
index ed63b2a0..71bc734a 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -335,11 +335,11 @@ fun p_exp' par env (e, _) =
                                 p_exp env e,
                                 string ")"]
 
-      | EServerCall (n, e, _, _, _) => box [string "Server(",
-                                            p_exp env n,
-                                            string ")[",
-                                            p_exp env e,
-                                            string "]"]
+      | EServerCall (n, e, _, _) => box [string "Server(",
+                                         p_exp env n,
+                                         string ")[",
+                                         p_exp env e,
+                                         string "]"]
       | ERecv (n, e, _) => box [string "Recv(",
                                 p_exp env n,
                                 string ")[",
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 62368f9b..4bbb430d 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -354,7 +354,7 @@ fun reduce file =
                       | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
                       | ESignalSource e => summarize d e
 
-                      | EServerCall (e, ek, _, _, _) => summarize d e @ summarize d ek @ [Unsure]
+                      | EServerCall (e, ek, _, _) => summarize d e @ summarize d ek @ [Unsure]
                       | ERecv (e, ek, _) => summarize d e @ summarize d ek @ [Unsure]
                       | ESleep (e, ek) => summarize d e @ summarize d ek @ [Unsure]
             in
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 0a4bb048..e2bed8eb 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -362,16 +362,14 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                      fn e' =>
                         (ESignalSource e', loc))
 
-              | EServerCall (s, ek, t, eff, ue) =>
+              | EServerCall (s, ek, t, eff) =>
                 S.bind2 (mfe ctx s,
                          fn s' =>
                             S.bind2 (mfe ctx ek,
                                   fn ek' =>
-                                     S.bind2 (mft t,
+                                     S.map2 (mft t,
                                           fn t' =>
-                                             S.map2 (mfe ctx ue,
-                                                     fn ue' =>
-                                                        (EServerCall (s', ek', t', eff, ue'), loc)))))
+                                             (EServerCall (s', ek', t', eff), loc))))
               | ERecv (s, ek, t) =>
                 S.bind2 (mfe ctx s,
                       fn s' =>
diff --git a/src/monoize.sml b/src/monoize.sml
index a5772976..12112648 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3162,10 +3162,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                 val (ek, fm) = monoExp (env, st, fm) ek
 
-                val unRpced = foldl (fn (e1, e2) => (L'.EApp (e2, e1), loc)) (L'.ENamed n, loc) es
-                val unRpced = (L'.EApp (unRpced, (L'.ERecord [], loc)), loc)
-                val unRpced = (L'.EApp (ek, unRpced), loc)
-                val unRpced = (L'.EApp (unRpced, (L'.ERecord [], loc)), loc)
                 val unit = (L'.TRecord [], loc)
 
                 val ekf = (L'.EAbs ("f",
@@ -3186,7 +3182,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                           else
                               L'.ReadOnly
 
-                val e = (L'.EServerCall (call, ek, t, eff, unRpced), loc)
+                val e = (L'.EServerCall (call, ek, t, eff), loc)
                 val e = liftExpInExp 0 e
                 val e = (L'.EAbs ("_", unit, unit, e), loc)
             in
diff --git a/src/reduce.sml b/src/reduce.sml
index 82d37420..373d4cec 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -254,12 +254,12 @@ fun kindConAndExp (namedC, namedE) =
             let
                 (*val () = Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
                                                ("env", Print.PD.string (e2s env))]*)
-                (*val () = if dangling (edepth env) all then
+                val () = if dangling (edepth env) all then
                              (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
                                                     ("env", Print.PD.string (e2s env))];
                               raise Fail "!")
                          else
-                             ()*)
+                             ()
 
                 val r = case e of
                             EPrim _ => all
@@ -299,17 +299,6 @@ fun kindConAndExp (namedC, namedE) =
                           | EFfi _ => all
                           | EFfiApp (m, f, es) => (EFfiApp (m, f, map (exp env) es), loc)
 
-                          | EApp (
-                           (EApp
-                                ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1), _), t2), _),
-                                        _), _),
-                                 (EApp (
-                                  (EApp (
-                                   (ECApp (
-                                    (ECApp ((EFfi ("Basis", "return"), _), _), _),
-                                    _), _),
-                                   _), _), v), _)), _), trans2) => exp env (EApp (trans2, v), loc)
-
                           (*| EApp (
                            (EApp
                                 ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1), _), t2), _),
@@ -341,73 +330,216 @@ fun kindConAndExp (namedC, namedE) =
                                 loc)
                            end*)
 
-                          | EApp (
-                           (EApp
-                                ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1), _), t2), _),
-                                        (EFfi ("Basis", "transaction_monad"), _)), _),
-                                 (EServerCall (n, es, ke, dom, ran), _)), _),
-                           trans2) =>
-                           let
-                               val e' = (EFfi ("Basis", "bind"), loc)
-                               val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
-                               val e' = (ECApp (e', dom), loc)
-                               val e' = (ECApp (e', t2), loc)
-                               val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
-                               val e' = (EApp (e', (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), loc)
-                               val e' = (EApp (e', E.liftExpInExp 0 trans2), loc)
-                               val e' = (EAbs ("x", dom, t2, e'), loc)
-                               val e' = (EServerCall (n, es, e', dom, t2), loc)
-                           in
-                               exp env e'
-                           end
-
-                          | EApp (
-                            (EApp
-                                 ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), mt), _), _), _), t3), _),
-                                         me), _),
-                                  (EApp ((EApp
-                                              ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _),
-                                                      _), _),
-                                               trans1), _), trans2), _)), _),
-                            trans3) =>
-                            let
-                                val e'' = (EFfi ("Basis", "bind"), loc)
-                                val e'' = (ECApp (e'', mt), loc)
-                                val e'' = (ECApp (e'', t2), loc)
-                                val e'' = (ECApp (e'', t3), loc)
-                                val e'' = (EApp (e'', me), loc)
-                                val e'' = (EApp (e'', (EApp (E.liftExpInExp 0 trans2, (ERel 0, loc)), loc)), loc)
-                                val e'' = (EApp (e'', E.liftExpInExp 0 trans3), loc)
-                                val e'' = (EAbs ("xb", t1, (CApp (mt, t3), loc), e''), loc)
-
-                                val e' = (EFfi ("Basis", "bind"), loc)
-                                val e' = (ECApp (e', mt), loc)
-                                val e' = (ECApp (e', t1), loc)
-                                val e' = (ECApp (e', t3), loc)
-                                val e' = (EApp (e', me), loc)
-                                val e' = (EApp (e', trans1), loc)
-                                val e' = (EApp (e', e''), loc)
-                                (*val () = print "Before\n"*)
-                                val ee' = exp env e'
-                                (*val () = print "After\n"*)
-                            in
-                                (*Print.prefaces "Commute" [("Pre", CorePrint.p_exp CoreEnv.empty (e, loc)),
-                                                          ("Mid", CorePrint.p_exp CoreEnv.empty e'),
-                                                          ("env", Print.PD.string (e2s env)),
-                                                          ("Post", CorePrint.p_exp CoreEnv.empty ee')];*)
-                                ee'
-                            end
-
                           | EApp (e1, e2) =>
                             let
+                                val env' = deKnown env
+
+                                fun reassoc e =
+                                    case #1 e of
+                                        EApp
+                                            ((EApp
+                                                  ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _),
+                                                                          t1),
+                                                                   _), t2), _),
+                                                          (EFfi ("Basis", "transaction_monad"), _)), _),
+                                                   (EServerCall (n, es, (EAbs (_, _, _, ke), _), dom, ran), _)), _),
+                                             trans3) =>
+                                        let
+                                            val e' = (EFfi ("Basis", "bind"), loc)
+                                            val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
+                                            val e' = (ECApp (e', dom), loc)
+                                            val e' = (ECApp (e', t2), loc)
+                                            val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                                            val e' = (EApp (e', ke), loc)
+                                            val e' = (EApp (e', E.liftExpInExp 0 trans3), loc)
+                                            val e' = reassoc e'
+                                            val e' = (EAbs ("x", dom, t2, e'), loc)
+                                            val e' = (EServerCall (n, es, e', dom, t2), loc)
+                                        in
+                                            e'
+                                        end
+
+                                      | EApp
+                                            ((EApp
+                                                  ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _),
+                                                                          t1),
+                                                                   _), t2), _),
+                                                          (EFfi ("Basis", "transaction_monad"), _)), _),
+                                                   (EServerCall (n, es, ke, dom, ran), _)), _),
+                                             trans3) =>
+                                        let
+                                            val e' = (EFfi ("Basis", "bind"), loc)
+                                            val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
+                                            val e' = (ECApp (e', dom), loc)
+                                            val e' = (ECApp (e', t2), loc)
+                                            val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                                            val e' = (EApp (e', exp (UnknownE :: env')
+                                                                    (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)),
+                                                      loc)
+                                            val e' = (EApp (e', E.liftExpInExp 0 trans3), loc)
+                                            val e' = reassoc e'
+                                            val e' = (EAbs ("x", dom, t2, e'), loc)
+                                            val e' = (EServerCall (n, es, e', dom, t2), loc)
+                                        in
+                                            e'
+                                        end
+
+                                      | EApp
+                                            ((EApp
+                                                  ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), mt),
+                                                                           _), _), _), t3), _),
+                                                          me), _),
+                                                   (EApp ((EApp
+                                                               ((EApp ((ECApp ((ECApp ((ECApp (
+                                                                                        (EFfi ("Basis", "bind"), _), _), _),
+                                                                                       t1), _), t2), _),
+                                                                       _), _),
+                                                                trans1), _), (EAbs (_, _, _, trans2), _)), _)), _),
+                                             trans3) =>
+                                        let
+                                            val e'' = (EFfi ("Basis", "bind"), loc)
+                                            val e'' = (ECApp (e'', mt), loc)
+                                            val e'' = (ECApp (e'', t2), loc)
+                                            val e'' = (ECApp (e'', t3), loc)
+                                            val e'' = (EApp (e'', me), loc)
+                                            val e'' = (EApp (e'', trans2), loc)
+                                            val e'' = (EApp (e'', E.liftExpInExp 0 trans3), loc)
+                                            val e'' = reassoc e''
+                                            val e'' = (EAbs ("xb", t1, (CApp (mt, t3), loc), e''), loc)
+
+                                            val e' = (EFfi ("Basis", "bind"), loc)
+                                            val e' = (ECApp (e', mt), loc)
+                                            val e' = (ECApp (e', t1), loc)
+                                            val e' = (ECApp (e', t3), loc)
+                                            val e' = (EApp (e', me), loc)
+                                            val e' = (EApp (e', trans1), loc)
+                                            val e' = (EApp (e', e''), loc)
+                                        in
+                                            e'
+                                        end
+
+                                      | EApp
+                                            ((EApp
+                                                  ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), mt),
+                                                                           _), _), _), t3), _),
+                                                          me), _),
+                                                   (EApp ((EApp
+                                                               ((EApp ((ECApp ((ECApp ((ECApp (
+                                                                                        (EFfi ("Basis", "bind"), _), _), _),
+                                                                                       t1), _), t2), _),
+                                                                       _), _),
+                                                                trans1), _), trans2), _)), _),
+                                             trans3) =>
+                                        let
+                                            val e'' = (EFfi ("Basis", "bind"), loc)
+                                            val e'' = (ECApp (e'', mt), loc)
+                                            val e'' = (ECApp (e'', t2), loc)
+                                            val e'' = (ECApp (e'', t3), loc)
+                                            val e'' = (EApp (e'', me), loc)
+                                            val () = print "In2\n"
+                                            val e'' = (EApp (e'', exp (UnknownE :: env')
+                                                                      (EApp (E.liftExpInExp 0 trans2, (ERel 0, loc)),
+                                                                       loc)),
+                                                       loc)
+                                            val () = print "Out2\n"
+                                            val e'' = (EApp (e'', E.liftExpInExp 0 trans3), loc)
+                                            val e'' = reassoc e''
+                                            val e'' = (EAbs ("xb", t1, (CApp (mt, t3), loc), e''), loc)
+
+                                            val e' = (EFfi ("Basis", "bind"), loc)
+                                            val e' = (ECApp (e', mt), loc)
+                                            val e' = (ECApp (e', t1), loc)
+                                            val e' = (ECApp (e', t3), loc)
+                                            val e' = (EApp (e', me), loc)
+                                            val e' = (EApp (e', trans1), loc)
+                                            val e' = (EApp (e', e''), loc)
+                                        in
+                                            e'
+                                        end
+
+                                      | _ => e
+
                                 val e1 = exp env e1
                                 val e2 = exp env e2
+                                val e12 = reassoc (EApp (e1, e2), loc)
                             in
-                                case #1 e1 of
-                                    EAbs (_, _, _, b) =>
+                                case #1 e12 of
+                                    EApp ((EAbs (_, _, _, b), _), e2) =>
                                     ((*Print.preface ("Body", CorePrint.p_exp CoreEnv.empty b);*)
-                                     exp (KnownE e2 :: deKnown env) b)
-                                  | _ => (EApp (e1, e2), loc)
+                                     exp (KnownE e2 :: env') b)
+                                  (*| EApp
+                                        ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1),
+                                                         _), t2), _),
+                                                _), _),
+                                         (EApp (
+                                          (EApp (
+                                           (ECApp (
+                                            (ECApp ((EFfi ("Basis", "return"), _), _), _),
+                                            _), _),
+                                           _), _), v), _)) =>
+                                    (ELet ("rv", con env t1, v,
+                                           exp (deKnown env) (EApp (E.liftExpInExp 0 e2, (ERel 0, loc)), loc)), loc)*)
+                                  (*| EApp
+                                        ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1),
+                                                         _), t2), _),
+                                                (EFfi ("Basis", "transaction_monad"), _)), _),
+                                         (EServerCall (n, es, ke, dom, ran), _)) =>
+                                    let
+                                        val e' = (EFfi ("Basis", "bind"), loc)
+                                        val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
+                                        val e' = (ECApp (e', dom), loc)
+                                        val e' = (ECApp (e', t2), loc)
+                                        val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                                        val e' = (EApp (e', (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), loc)
+                                        val e' = (EApp (e', E.liftExpInExp 0 (exp env e2)), loc)
+                                        val e' = (EAbs ("x", dom, t2, e'), loc)
+                                        val e' = (EServerCall (n, es, e', dom, t2), loc)
+                                        val e' = exp (deKnown env) e'
+                                    in
+                                        (*Print.prefaces "SC" [("Old", CorePrint.p_exp CoreEnv.empty all),
+                                                             ("New", CorePrint.p_exp CoreEnv.empty e')]*)
+                                        e'
+                                    end
+                                  | EApp
+                                        ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), mt),
+                                                                 _), _), _), t3), _),
+                                                me), _),
+                                         (EApp ((EApp
+                                                     ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), _), _), _),
+                                                                             t1), _), t2), _),
+                                                             _), _),
+                                                      trans1), _), trans2), _)) =>
+                                    let
+                                        val e'' = (EFfi ("Basis", "bind"), loc)
+                                        val e'' = (ECApp (e'', mt), loc)
+                                        val e'' = (ECApp (e'', t2), loc)
+                                        val e'' = (ECApp (e'', t3), loc)
+                                        val e'' = (EApp (e'', me), loc)
+                                        val e'' = (EApp (e'', (EApp (E.liftExpInExp 0 trans2, (ERel 0, loc)), loc)), loc)
+                                        val e'' = (EApp (e'', E.liftExpInExp 0 e2), loc)
+                                        val e'' = (EAbs ("xb", t1, (CApp (mt, t3), loc), e''), loc)
+
+                                        val e' = (EFfi ("Basis", "bind"), loc)
+                                        val e' = (ECApp (e', mt), loc)
+                                        val e' = (ECApp (e', t1), loc)
+                                        val e' = (ECApp (e', t3), loc)
+                                        val e' = (EApp (e', me), loc)
+                                        val e' = (EApp (e', trans1), loc)
+                                        val e' = (EApp (e', e''), loc)
+                                        (*val () = Print.prefaces "Going in" [("e", CorePrint.p_exp CoreEnv.empty (e, loc)),
+                                                                            ("e1", CorePrint.p_exp CoreEnv.empty e1),
+                                                                            ("e'", CorePrint.p_exp CoreEnv.empty e')]*)
+                                        val ee' = exp (deKnown env) e'
+                                        val () = Print.prefaces "Coming out" [("ee'", CorePrint.p_exp CoreEnv.empty ee')]
+                                    in
+                                        (*Print.prefaces "Commute" [("Pre", CorePrint.p_exp CoreEnv.empty (e, loc)),
+                                                                  ("Mid", CorePrint.p_exp CoreEnv.empty e'),
+                                                                  ("env", Print.PD.string (e2s env)),
+                                                                  ("Post", CorePrint.p_exp CoreEnv.empty ee')];*)
+                                        ee'
+                                    end
+                                  | _ => (EApp (e1, exp env e2), loc)*)
+                                  | _ => e12
                             end
 
                           | EAbs (x, dom, ran, e) => (EAbs (x, con env dom, con env ran, exp (UnknownE :: env) e), loc)
@@ -568,7 +700,8 @@ fun kindConAndExp (namedC, namedE) =
                           | EWrite e => (EWrite (exp env e), loc)
                           | EClosure (n, es) => (EClosure (n, map (exp env) es), loc)
 
-                          | ELet (x, t, e1, e2) => (ELet (x, con env t, exp env e1, exp (UnknownE :: env) e2), loc)
+                          | ELet (x, t, e1, e2) =>
+                            (ELet (x, con env t, exp env e1, exp (UnknownE :: env) e2), loc)
 
                           | EServerCall (n, es, e, t1, t2) => (EServerCall (n, map (exp env) es, exp env e,
                                                                             con env t1, con env t2), loc)
@@ -618,7 +751,8 @@ fun reduce file =
                      (namedC, IM.insert (namedE, n, e)))
                 end
               | DValRec vis =>
-                ((DValRec (map (fn (x, n, t, e, s) => (x, n, con namedC [] t, exp (namedC, namedE) [] e, s)) vis), loc),
+                ((DValRec (map (fn (x, n, t, e, s) => (x, n, con namedC [] t,
+                                                       exp (namedC, namedE) [] e, s)) vis), loc),
                  st)
               | DExport _ => (d, st)
               | DTable (s, n, c, s', pe, pc, ce, cc) => ((DTable (s, n, con namedC [] c, s',
diff --git a/src/urweb.grm b/src/urweb.grm
index b954ba8c..37a74e5a 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1087,6 +1087,13 @@ eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
                                                        (EField (e, ident), loc))
                                                    (EVar (#1 path, #2 path, Infer), s (pathleft, pathright)) idents
                                          end)
+       | LPAREN eexp RPAREN DOT idents  (let
+                                             val loc = s (LPARENleft, identsright)
+                                         in
+                                             foldl (fn (ident, e) =>
+                                                       (EField (e, ident), loc))
+                                                   eexp idents
+                                         end)
        | AT path DOT idents             (let
                                              val loc = s (ATleft, identsright)
                                          in