summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/monoize.sml30
-rw-r--r--tests/update.ur2
2 files changed, 31 insertions, 1 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index 449306ca..87aaaff5 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -600,6 +600,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.EDml (liftExpInExp 0 e), loc)), loc),
fm)
end
+
| L.ECApp ((L.EFfi ("Basis", "insert"), _), fields) =>
(case monoType env (L.TRecord fields, loc) of
(L'.TRecord fields, _) =>
@@ -624,6 +625,35 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
end
| _ => poly ())
+ | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "update"), _), changed), _), _) =>
+ (case monoType env (L.TRecord changed, loc) of
+ (L'.TRecord changed, _) =>
+ let
+ val s = (L'.TFfi ("Basis", "string"), loc)
+ val changed = map (fn (x, _) => (x, s)) changed
+ val rt = (L'.TRecord changed, loc)
+ fun sc s = (L'.EPrim (Prim.String s), loc)
+ in
+ ((L'.EAbs ("fs", rt, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+ (L'.EAbs ("tab", s, (L'.TFun (s, s), loc),
+ (L'.EAbs ("e", s, s,
+ strcat loc [sc "UPDATE ",
+ (L'.ERel 1, loc),
+ sc " AS T SET ",
+ strcatComma loc (map (fn (x, _) =>
+ strcat loc [sc ("lw_" ^ x
+ ^ " = "),
+ (L'.EField
+ ((L'.ERel 2,
+ loc),
+ x), loc)])
+ changed),
+ sc " WHERE ",
+ (L'.ERel 0, loc)]), loc)), loc)), loc),
+ fm)
+ end
+ | _ => poly ())
+
| L.ECApp (
(L.ECApp (
(L.ECApp ((L.EFfi ("Basis", "query"), _), (L.CRecord (_, tables), _)), _),
diff --git a/tests/update.ur b/tests/update.ur
index e58c10cb..49545cc7 100644
--- a/tests/update.ur
+++ b/tests/update.ur
@@ -1,5 +1,5 @@
table t1 : {A : int, B : string, C : float, D : bool}
fun main () : transaction page =
- () <- dml (UPDATE t1 SET B = '6', C = 7.0 WHERE T.A = 5);
+ () <- dml (UPDATE t1 SET B = 'Hi', C = 12.34 WHERE T.A = 5);
return <html><body>Updated.</body></html>