summaryrefslogtreecommitdiff
path: root/src/monoize.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-09-07 15:12:47 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-09-07 15:12:47 -0400
commitb7606fcacfb9435651b6be6cbbb2e3a89414ef3a (patch)
tree5712f7979a29c059e091b083efc28a66804d15e9 /src/monoize.sml
parent0ba7ae8dbfdaf703260e58f700ce6e2ccf1ce2e9 (diff)
First UPDATE works
Diffstat (limited to 'src/monoize.sml')
-rw-r--r--src/monoize.sml30
1 files changed, 30 insertions, 0 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), _)), _),