Monoized and optimized initial query test

7 files changed, 448 insertions, 63 deletions

diff --git a/src/cjrize.sml b/src/cjrize.sml
index aa8ae562..7dbabe74 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -280,6 +280,8 @@ fun cifyExp ((e, loc), sm) =
       | L.EClosure _ => (ErrorMsg.errorAt loc "Nested closure remains in code generation";
                          (dummye, sm))
 
+      | L.EQuery _ => raise Fail "Cjrize EQuery"
+
 fun cifyDecl ((d, loc), sm) =
     case d of
         L.DDatatype (x, n, xncs) =>
diff --git a/src/mono.sml b/src/mono.sml
index c38e58ed..ae1b95dc 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -75,6 +75,13 @@ datatype exp' =
 
        | EClosure of int * exp list
 
+       | EQuery of { exps : (string * typ) list,
+                     tables : (string * (string * typ) list) list,
+                     state : typ,
+                     query : exp,
+                     body : exp,
+                     initial : exp }
+
 
 withtype exp = exp' located
 
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 9ac80b42..39db4c1c 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -38,6 +38,8 @@ structure E = MonoEnv
 
 val debug = ref false
 
+val dummyt = (TRecord [], ErrorMsg.dummySpan)
+
 fun p_typ' par env (t, _) =
     case t of
         TFun (t1, t2) => parenIf par (box [p_typ' true env t1,
@@ -133,17 +135,17 @@ fun p_exp' par env (e, _) =
       | EApp (e1, e2) => parenIf par (box [p_exp env e1,
                                            space,
                                            p_exp' true env e2])
-      | EAbs (x, t, _, e) => parenIf par (box [string "fn",
-                                               space,
-                                               string x,
-                                               space,
-                                               string ":",
-                                               space,
-                                               p_typ env t,
-                                               space,
-                                               string "=>",
-                                               space,
-                                               p_exp (E.pushERel env x t NONE) e])
+      | EAbs (x, t, _, e) => parenIf true (box [string "fn",
+                                                space,
+                                                string x,
+                                                space,
+                                                string ":",
+                                                space,
+                                                p_typ env t,
+                                                space,
+                                                string "=>",
+                                                space,
+                                                p_exp (E.pushERel env x t NONE) e])
 
       | ERecord xes => box [string "{",
                             p_list (fn (x, e, _) =>
@@ -158,18 +160,18 @@ fun p_exp' par env (e, _) =
              string ".",
              string x]
 
-      | ECase (e, pes, _) => parenIf par (box [string "case",
-                                               space,
-                                               p_exp env e,
-                                               space,
-                                               string "of",
-                                               space,
-                                               p_list_sep (box [space, string "|", space])
-                                                          (fn (p, e) => box [p_pat env p,
-                                                                             space,
-                                                                             string "=>",
-                                                                             space,
-                                                                             p_exp (E.patBinds env p) e]) pes])
+      | ECase (e, pes, _) => parenIf true (box [string "case",
+                                                space,
+                                                p_exp env e,
+                                                space,
+                                                string "of",
+                                                space,
+                                                p_list_sep (box [space, string "|", space])
+                                                           (fn (p, e) => box [p_pat env p,
+                                                                              space,
+                                                                              string "=>",
+                                                                              space,
+                                                                              p_exp (E.patBinds env p) e]) pes])
 
       | EStrcat (e1, e2) => box [p_exp' true env e1,
                                  space,
@@ -185,7 +187,7 @@ fun p_exp' par env (e, _) =
                               string ";",
                               space,
                               p_exp env e2]
-      | ELet (x, t, e1, e2) => box [string "let",
+      | ELet (x, t, e1, e2) => box [string "(let",
                                     space,
                                     string x,
                                     space,
@@ -195,11 +197,15 @@ fun p_exp' par env (e, _) =
                                     space,
                                     string "=",
                                     space,
+                                    string "(",
                                     p_exp env e1,
+                                    string ")",
                                     space,
                                     string "in",
                                     space,
-                                    p_exp (E.pushERel env x t NONE) e2]
+                                    string "(",
+                                    p_exp (E.pushERel env x t NONE) e2,
+                                    string "))"]
 
       | EClosure (n, es) => box [string "CLOSURE(",
                                  p_enamed env n,
@@ -207,6 +213,31 @@ fun p_exp' par env (e, _) =
                                                                       p_exp env e]) es,
                                  string ")"]
 
+      | EQuery {exps, tables, state, query, body, initial} =>
+        box [string "query[",
+             p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps,
+             string "] [",
+             p_list (fn (x, xts) => box [string x,
+                                         space,
+                                         string ":",
+                                         space,
+                                         string "{",
+                                         p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) xts,
+                                         string "}"]) tables,
+             string "] [",
+             p_typ env state,
+             string "]",
+             space,
+             p_exp env query,
+             space,
+             string "initial",
+             space,
+             p_exp env initial,
+             space,
+             string "in",
+             space,
+             p_exp (E.pushERel (E.pushERel env "r" dummyt NONE) "acc" dummyt NONE) body]
+
 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 31757daa..1941f0cc 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -34,20 +34,38 @@ open Mono
 structure E = MonoEnv
 structure U = MonoUtil
 
-val liftExpInExp =
-    U.Exp.mapB {typ = fn t => t,
-                exp = fn bound => fn e =>
-                                     case e of
-                                         ERel xn =>
-                                         if xn < bound then
-                                             e
-                                         else
-                                             ERel (xn + 1)
-                                       | _ => e,
-                bind = fn (bound, U.Exp.RelE _) => bound + 1
-                        | (bound, _) => bound}
-
-val subExpInExp =
+
+fun impure (e, _) =
+    case e of
+        EWrite _ => true
+      | EQuery _ => true
+      | EAbs _ => false
+
+      | EPrim _ => false
+      | ERel _ => false
+      | ENamed _ => false
+      | ECon (_, _, eo) => (case eo of NONE => false | SOME e => impure e)
+      | EFfi _ => false
+      | EFfiApp _ => false
+      | EApp ((EFfi _, _), _) => false
+      | EApp _ => true
+
+      | ERecord xes => List.exists (fn (_, e, _) => impure e) xes
+      | EField (e, _) => impure e
+
+      | ECase (e, pes, _) => impure e orelse List.exists (fn (_, e) => impure e) pes
+
+      | EStrcat (e1, e2) => impure e1 orelse impure e2
+
+      | ESeq (e1, e2) => impure e1 orelse impure e2
+      | ELet (_, _, e1, e2) => impure e1 orelse impure e2
+
+      | EClosure (_, es) => List.exists impure es
+
+
+val liftExpInExp = Monoize.liftExpInExp
+
+val subExpInExp' =
     U.Exp.mapB {typ = fn t => t,
                 exp = fn (xn, rep) => fn e =>
                                   case e of
@@ -60,11 +78,15 @@ val subExpInExp =
                 bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, liftExpInExp 0 rep)
                         | (ctx, _) => ctx}
 
-fun bind (env, b) =
-    case b of
-        U.Decl.Datatype (x, n, xncs) => E.pushDatatype env x n xncs
-      | U.Decl.RelE (x, t) => E.pushERel env x t NONE
-      | U.Decl.NamedE (x, n, t, eo, s) => E.pushENamed env x n t eo s
+fun subExpInExp (n, e1) e2 =
+    let
+        val r = subExpInExp' (n, e1) e2
+    in
+        (*Print.prefaces "subExpInExp" [("e1", MonoPrint.p_exp MonoEnv.empty e1),
+                                      ("e2", MonoPrint.p_exp MonoEnv.empty e2),
+                                      ("r", MonoPrint.p_exp MonoEnv.empty r)];*)
+        r
+    end
 
 fun typ c = c
 
@@ -132,8 +154,13 @@ fun exp env e =
              (_, _, SOME e', _) => #1 e'
            | _ => e)
 
-      | EApp ((EAbs (_, _, _, e1), loc), e2) =>
-        #1 (reduceExp env (subExpInExp (0, e2) e1))
+      | EApp ((EAbs (x, t, _, e1), loc), e2) =>
+        ((*Print.prefaces "Considering" [("e1", MonoPrint.p_exp env e1),
+                                       ("e2", MonoPrint.p_exp env e2)];*)
+        if impure e2 then
+            #1 (reduceExp env (ELet (x, t, e2, e1), loc))
+        else
+            #1 (reduceExp env (subExpInExp (0, e2) e1)))
 
       | ECase (disc, pes, _) =>
         (case ListUtil.search (fn (p, body) =>
@@ -143,8 +170,38 @@ fun exp env e =
              NONE => e
            | SOME e' => e')
 
+      | EField ((ERecord xes, _), x) =>
+        (case List.find (fn (x', _, _) => x' = x) xes of
+             SOME (_, e, _) => #1 e
+           | NONE => e)
+
+      | ELet (x1, t1, (ELet (x2, t2, e1, b1), loc), b2) =>
+        let
+            val e' = (ELet (x2, t2, e1,
+                            (ELet (x1, t1, b1,
+                                   liftExpInExp 1 b2), loc)), loc)
+        in
+            Print.prefaces "ELet commute" [("e", MonoPrint.p_exp env (e, loc)),
+                                           ("e'", MonoPrint.p_exp env e')];
+            #1 (reduceExp env e')
+        end
+      | EApp ((ELet (x, t, e, b), loc), e') =>
+        #1 (reduceExp env (ELet (x, t, e,
+                                 (EApp (b, liftExpInExp 0 e'), loc)), loc))
+      | ELet (x, t, e', b) =>
+        if impure e' then
+            e
+        else
+            #1 (reduceExp env (subExpInExp (0, e') b))
+
       | _ => e
 
+and bind (env, b) =
+    case b of
+        U.Decl.Datatype (x, n, xncs) => E.pushDatatype env x n xncs
+      | U.Decl.RelE (x, t) => E.pushERel env x t NONE
+      | U.Decl.NamedE (x, n, t, eo, s) => E.pushENamed env x n t (Option.map (reduceExp env) eo) s
+
 and reduceExp env = U.Exp.mapB {typ = typ, exp = exp, bind = bind} env
 
 fun decl env d = d
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 8f5b29e8..0b2817f1 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -218,7 +218,7 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                          fn t' =>
                             S.bind2 (mfe ctx e1,
                                   fn e1' =>
-                                     S.map2 (mfe (bind (ctx, RelE (x, t))) e2,
+                                     S.map2 (mfe (bind (ctx, RelE (x, t'))) e2,
                                           fn e2' =>
                                              (ELet (x, t', e1', e2'), loc))))
 
@@ -226,6 +226,34 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                 S.map2 (ListUtil.mapfold (mfe ctx) es,
                      fn es' =>
                         (EClosure (n, es'), loc))
+
+              | EQuery {exps, tables, state, query, body, initial} =>
+                S.bind2 (ListUtil.mapfold (fn (x, t) =>
+                                              S.map2 (mft t,
+                                                      fn t' => (x, t'))) exps,
+                         fn exps' =>
+                            S.bind2 (ListUtil.mapfold (fn (x, xts) =>
+                                                          S.map2 (ListUtil.mapfold
+                                                                       (fn (x, t) =>
+                                                                           S.map2 (mft t,
+                                                                                fn t' => (x, t'))) xts,
+                                                                   fn xts' => (x, xts'))) tables,
+                                  fn tables' =>
+                                     S.bind2 (mft state,
+                                              fn state' =>
+                                                 S.bind2 (mfe ctx query,
+                                                          fn query' =>
+                                                             S.bind2 (mfe ctx body,
+                                                                     fn body' =>
+                                                                        S.map2 (mfe ctx initial,
+                                                                                fn initial' =>
+                                                                                   (EQuery {exps = exps',
+                                                                                            tables = tables',
+                                                                                            state = state',
+                                                                                            query = query',
+                                                                                            body = body',
+                                                                                            initial = initial'},
+                                                                                    loc)))))))
     in
         mfe
     end
diff --git a/src/monoize.sig b/src/monoize.sig
index 0e9c23c3..838d7c4c 100644
--- a/src/monoize.sig
+++ b/src/monoize.sig
@@ -29,4 +29,6 @@ signature MONOIZE = sig
 
     val monoize : CoreEnv.env -> Core.file -> Mono.file
 
+    val liftExpInExp : int -> Mono.exp -> Mono.exp
+
 end
diff --git a/src/monoize.sml b/src/monoize.sml
index b1a38558..abbd4f40 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -37,6 +37,21 @@ structure IM = IntBinaryMap
 
 val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan)
 
+structure U = MonoUtil
+
+val liftExpInExp =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         L'.ERel xn =>
+                                         if xn < bound then
+                                             e
+                                         else
+                                             L'.ERel (xn + 1)
+                                       | _ => e,
+                bind = fn (bound, U.Exp.RelE _) => bound + 1
+                        | (bound, _) => bound}
+
 fun monoName env (all as (c, loc)) =
     let
         fun poly () =
@@ -71,7 +86,43 @@ fun monoType env =
                     (L'.TFfi ("Basis", "string"), loc)
 
                   | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
-                    (L'.TFun (mt env dtmap t, (L'.TRecord [], loc)), loc)
+                    (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_table"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_subset"), _), _), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CFfi ("Basis", "sql_relop") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_direction") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_order_by"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_limit") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_offset") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+
+                  | L.CApp ((L.CFfi ("Basis", "sql_injectable"), _), t) =>
+                    (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_unary"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_binary"), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_comparison") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_aggregate"), _), t) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_summable"), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_maxable"), _), _) =>
+                    (L'.TRecord [], loc)
 
                   | L.CRel _ => poly ()
                   | L.CNamed n =>
@@ -347,6 +398,41 @@ fun monoPat env (all as (p, loc)) =
           | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc)
     end
 
+fun strcat loc es =
+    case es of
+        [] => (L'.EPrim (Prim.String ""), loc)
+      | [e] => e
+      | _ =>
+        let
+            val e2 = List.last es
+            val es = List.take (es, length es - 1)
+            val e1 = List.last es
+            val es = List.take (es, length es - 1)
+        in
+            foldr (fn (e, e') => (L'.EStrcat (e, e'), loc))
+            (L'.EStrcat (e1, e2), loc) es
+        end
+
+fun strcatComma loc es =
+    case es of
+        [] => (L'.EPrim (Prim.String ""), loc)
+      | [e] => e
+      | _ =>
+        let
+            val e1 = List.last es
+            val es = List.take (es, length es - 1)
+        in
+            foldr (fn (e, e') =>
+                      case e of
+                          (L'.EPrim (Prim.String ""), _) => e'
+                        | _ =>
+                          (L'.EStrcat (e,
+                                       (L'.EStrcat ((L'.EPrim (Prim.String ", "), loc), e'), loc)), loc))
+            e1 es
+        end
+
+fun strcatR loc e xs = strcatComma loc (map (fn (x, _) => (L'.EField (e, x), loc)) xs)
+
 fun monoExp (env, st, fm) (all as (e, loc)) =
     let
         fun poly () =
@@ -373,32 +459,195 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((L'.ECon (dk, monoPatCon env pc, eo), loc), fm)
             end
           | L.ECon _ => poly ()
-          | L.EFfi mx => ((L'.EFfi mx, loc), fm)
-          | L.EFfiApp (m, x, es) =>
+
+          | L.ECApp ((L.EFfi ("Basis", "return"), _), t) =>
             let
-                val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
+                val t = monoType env t
             in
-                ((L'.EFfiApp (m, x, es), loc), fm)
+                ((L'.EAbs ("x", t,
+                           (L'.TFun ((L'.TRecord [], loc), t), loc),
+                           (L'.EAbs ("_", (L'.TRecord [], loc), t,
+                                     (L'.ERel 1, loc)), loc)), loc), fm)
             end
-
-          | L.ECApp ((L.EFfi ("Basis", "return"), _), t) =>
-            ((L'.EAbs ("x", monoType env t, (L'.TRecord [], loc), (L'.ERel 0, loc)), loc), fm)
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), t1), _), t2) =>
             let
                 val t1 = monoType env t1
                 val t2 = monoType env t2
                 val un = (L'.TRecord [], loc)
-                val mt1 = (L'.TFun (t1, un), loc)
-                val mt2 = (L'.TFun (t2, un), loc)
+                val mt1 = (L'.TFun (un, t1), loc)
+                val mt2 = (L'.TFun (un, t2), loc)
             in
-                ((L'.EAbs ("m1", mt1, (L'.TFun (mt1, (L'.TFun (mt2, un), loc)), loc),
-                           (L'.EAbs ("m2", mt2, un,
-                                     (L'.ELet ("r", t1, (L'.ERel 1, loc),
-                                               (L'.EApp ((L'.ERel 1, loc), (L'.ERel 0, loc)),
-                                                loc)), loc)), loc)), loc),
+                ((L'.EAbs ("m1", mt1, (L'.TFun (mt1, (L'.TFun (mt2, (L'.TFun (un, un), loc)), loc)), loc),
+                           (L'.EAbs ("m2", mt2, (L'.TFun (un, un), loc),
+                                     (L'.EAbs ("_", un, un,
+                                               (L'.ELet ("r", t1, (L'.EApp ((L'.ERel 2, loc),
+                                                                            (L'.ERecord [], loc)), loc),
+                                                         (L'.EApp (
+                                                          (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc),
+                                                          (L'.ERecord [], loc)),
+                                                          loc)), loc)), loc)), loc)), loc),
                  fm)
             end
 
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp ((L.EFfi ("Basis", "query"), _), (L.CRecord (_, tables), _)), _),
+             exps), _),
+            state) =>
+            (case monoType env (L.TRecord exps, loc) of
+                 (L'.TRecord exps, _) =>
+                 let
+                     val tables = map (fn ((L.CName x, _), xts) =>
+                                        (case monoType env (L.TRecord xts, loc) of
+                                             (L'.TRecord xts, _) => SOME (x, xts)
+                                           | _ => NONE)
+                                      | _ => NONE) tables
+                 in
+                     if List.exists (fn x => x = NONE) tables then
+                         poly ()
+                     else
+                         let
+                             val tables = List.mapPartial (fn x => x) tables
+                             val state = monoType env state
+                             val s = (L'.TFfi ("Basis", "string"), loc)
+                             val un = (L'.TRecord [], loc)
+
+                             val rt = exps @ map (fn (x, xts) => (x, (L'.TRecord xts, loc))) tables
+                             val ft = (L'.TFun ((L'.TRecord rt, loc),
+                                                (L'.TFun (state,
+                                                          (L'.TFun (un, state), loc)),
+                                                 loc)), loc)
+
+                             val body' = (L'.EAbs ("r", (L'.TRecord rt, loc),
+                                                   (L'.TFun (state, state), loc),
+                                                   (L'.EAbs ("acc", state, state,
+                                                             (L'.EApp (
+                                                              (L'.EApp (
+                                                               (L'.EApp ((L'.ERel 4, loc),
+                                                                         (L'.ERel 1, loc)), loc),
+                                                               (L'.ERel 0, loc)), loc),
+                                                              (L'.ERecord [], loc)), loc)), loc)), loc)
+
+                             val body = (L'.EQuery {exps = exps,
+                                                    tables = tables,
+                                                    state = state,
+                                                    query = (L'.ERel 3, loc),
+                                                    body = body',
+                                                    initial = (L'.ERel 1, loc)},
+                                         loc)
+                         in
+                             ((L'.EAbs ("q", s, (L'.TFun (ft, (L'.TFun (state, (L'.TFun (un, state), loc)), loc)), loc),
+                                        (L'.EAbs ("f", ft, (L'.TFun (state, (L'.TFun (un, state), loc)), loc),
+                                                  (L'.EAbs ("i", state, (L'.TFun (un, state), loc),
+                                                            (L'.EAbs ("_", un, state,
+                                                                      body), loc)), loc)), loc)), loc), fm)
+                         end
+                 end
+               | _ => poly ())
+
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_query"), _), _), _), _), _), _) =>
+            let
+                fun sc s = (L'.EPrim (Prim.String s), loc)
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc)
+            in
+                ((L'.EAbs ("r",
+                           (L'.TRecord [("Rows", s), ("OrderBy", s), ("Limit", s), ("Offset", s)], loc),
+                           s,
+                           strcat loc [gf "Rows",
+                                       gf "OrderBy",
+                                       gf "Limit",
+                                       gf "Offset"]), loc), fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_query1"), _),
+               (L.CRecord (_, tables), _)), _),
+              (L.CRecord (_, grouped), _)), _),
+             (L.CRecord (_, stables), _)), _),
+            sexps) =>
+            let
+                fun sc s = (L'.EPrim (Prim.String s), loc)
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val un = (L'.TRecord [], loc)
+                fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc)
+
+                fun doTables tables =
+                    let
+                        val tables = map (fn ((L.CName x, _), xts) =>
+                                             (case monoType env (L.TRecord xts, loc) of
+                                                  (L'.TRecord xts, _) => SOME (x, xts)
+                                                | _ => NONE)
+                                           | _ => NONE) tables
+                    in
+                        if List.exists (fn x => x = NONE) tables then
+                            NONE
+                        else
+                            SOME (List.mapPartial (fn x => x) tables)
+                    end
+            in
+                case (doTables tables, doTables grouped, doTables stables, monoType env (L.TRecord sexps, loc)) of
+                    (SOME tables, SOME grouped, SOME stables, (L'.TRecord sexps, _)) =>
+                    ((L'.EAbs ("r",
+                               (L'.TRecord [("From", (L'.TRecord (map (fn (x, _) => (x, s)) tables), loc)),
+                                            ("Where", s),
+                                            ("GroupBy", un),
+                                            ("Having", s),
+                                            ("SelectFields", un),
+                                            ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))],
+                                loc),
+                               s,
+                               strcat loc [sc "SELECT ",
+                                           strcatR loc (gf "SelectExps") sexps,
+                                           case sexps of
+                                               [] => sc ""
+                                             | _ => sc ", ",
+                                           strcatComma loc (map (fn (x, xts) =>
+                                                                    strcatComma loc
+                                                                        (map (fn (x', _) =>
+                                                                                 sc (x ^ "." ^ x'))
+                                                                         xts)) stables),
+                                           sc " FROM ",
+                                           strcatComma loc (map (fn (x, _) => strcat loc [(L'.EField (gf "From", x), loc),
+                                                                                          sc (" AS " ^ x)]) tables)
+                              ]), loc),
+                     fm)
+                  | _ => poly ()
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_inject"), _),
+               _), _),
+              _), _),
+             _), _),
+            t) =>
+            let
+                val t = monoType env t
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("f", (L'.TFun (t, s), loc), (L'.TFun (t, s), loc),
+                           (L'.ERel 0, loc)), loc), fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "sql_subset"), _), _) =>
+            ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_subset_all"), _), _) =>
+            ((L'.ERecord [], loc), fm)
+
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) =>
+            ((L'.EPrim (Prim.String ""), loc), fm)
+
+          | L.EFfi ("Basis", "sql_no_limit") =>
+            ((L'.EPrim (Prim.String ""), loc), fm)
+          | L.EFfi ("Basis", "sql_no_offset") =>
+            ((L'.EPrim (Prim.String ""), loc), fm)
+                    
           | L.EApp (
             (L.ECApp (
              (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
@@ -721,6 +970,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.ECApp _ => poly ()
           | L.ECAbs _ => poly ()
 
+          | L.EFfi mx => ((L'.EFfi mx, loc), fm)
+          | L.EFfiApp (m, x, es) =>
+            let
+                val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
+            in
+                ((L'.EFfiApp (m, x, es), loc), fm)
+            end
+
           | L.ERecord xes =>
             let
                 val (xes, fm) = ListUtil.foldlMap
@@ -762,7 +1019,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             let
                 val (e, fm) = monoExp (env, st, fm) e
             in
-                ((L'.EWrite e, loc), fm)
+                ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                           (L'.EWrite (liftExpInExp 0 e), loc)), loc), fm)
             end
 
           | L.EClosure (n, es) =>