diff src/monoize.sml @ 308:72480e249130

First UPDATE works
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 15:12:47 -0400
parents 52d4c60518d4
children ea62b15da922
line wrap: on
line diff
--- a/src/monoize.sml	Sun Sep 07 15:05:52 2008 -0400
+++ b/src/monoize.sml	Sun Sep 07 15:12:47 2008 -0400
@@ -600,6 +600,7 @@
                            (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 @@
                  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), _)), _),