Mercurial > urweb
changeset 252:7e9bd70ad3ce
Monoized and optimized initial query test
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 31 Aug 2008 13:58:47 -0400 |
| parents | 326fb4686f60 |
| children | 7f6620853c36 |
| files | lib/basis.urs src/cjrize.sml src/mono.sml src/mono_print.sml src/mono_reduce.sml src/mono_util.sml src/monoize.sig src/monoize.sml |
| diffstat | 8 files changed, 449 insertions(+), 64 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/basis.urs Sun Aug 31 10:36:54 2008 -0400 +++ b/lib/basis.urs Sun Aug 31 13:58:47 2008 -0400 @@ -156,8 +156,8 @@ -> transaction t2 val query : tables ::: {{Type}} -> exps ::: {Type} -> tables ~ exps + -> state ::: Type -> sql_query tables exps - -> state ::: Type -> ($(exps ++ fold (fn nm (fields :: {Type}) acc => [nm] ~ acc => [nm = $fields] ++ acc) [] tables) -> state -> transaction state)
--- a/src/cjrize.sml Sun Aug 31 10:36:54 2008 -0400 +++ b/src/cjrize.sml Sun Aug 31 13:58:47 2008 -0400 @@ -280,6 +280,8 @@ | 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) =>
--- a/src/mono.sml Sun Aug 31 10:36:54 2008 -0400 +++ b/src/mono.sml Sun Aug 31 13:58:47 2008 -0400 @@ -75,6 +75,13 @@ | 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
--- a/src/mono_print.sml Sun Aug 31 10:36:54 2008 -0400 +++ b/src/mono_print.sml Sun Aug 31 13:58:47 2008 -0400 @@ -38,6 +38,8 @@ 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 @@ | 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 @@ 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 @@ 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 @@ 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 @@ 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) =
--- a/src/mono_reduce.sml Sun Aug 31 10:36:54 2008 -0400 +++ b/src/mono_reduce.sml Sun Aug 31 13:58:47 2008 -0400 @@ -34,20 +34,38 @@ 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 @@ 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 @@ (_, _, 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 @@ 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
--- a/src/mono_util.sml Sun Aug 31 10:36:54 2008 -0400 +++ b/src/mono_util.sml Sun Aug 31 13:58:47 2008 -0400 @@ -218,7 +218,7 @@ 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 @@ 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
--- a/src/monoize.sig Sun Aug 31 10:36:54 2008 -0400 +++ b/src/monoize.sig Sun Aug 31 13:58:47 2008 -0400 @@ -29,4 +29,6 @@ val monoize : CoreEnv.env -> Core.file -> Mono.file + val liftExpInExp : int -> Mono.exp -> Mono.exp + end
--- a/src/monoize.sml Sun Aug 31 10:36:54 2008 -0400 +++ b/src/monoize.sml Sun Aug 31 13:58:47 2008 -0400 @@ -37,6 +37,21 @@ 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 @@ (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 @@ | 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 @@ ((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) => - 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.ECApp ((L.EFfi ("Basis", "return"), _), t) => - ((L'.EAbs ("x", monoType env t, (L'.TRecord [], loc), (L'.ERel 0, loc)), loc), fm) + let + val t = monoType env t + in + ((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.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 @@ | 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 @@ 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) =>