diff src/monoize.sml @ 307:52d4c60518d4

First INSERT works
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 15:05:52 -0400
parents 59dc042629b9
children 72480e249130
line wrap: on
line diff
--- a/src/monoize.sml	Sun Sep 07 14:38:14 2008 -0400
+++ b/src/monoize.sml	Sun Sep 07 15:05:52 2008 -0400
@@ -591,6 +591,39 @@
                  fm)
             end
 
+          | L.EFfiApp ("Basis", "dml", [e]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+                val un = (L'.TRecord [], loc)
+            in
+                ((L'.EAbs ("_", un, un,
+                           (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, _) =>
+                 let
+                     val s = (L'.TFfi ("Basis", "string"), loc)
+                     val fields = map (fn (x, _) => (x, s)) fields
+                     val rt = (L'.TRecord fields, loc)
+                     fun sc s = (L'.EPrim (Prim.String s), loc)
+                 in
+                     ((L'.EAbs ("tab", s, (L'.TFun (rt, s), loc),
+                                (L'.EAbs ("fs", rt, s,
+                                          strcat loc [sc "INSERT INTO ",
+                                                      (L'.ERel 1, loc),
+                                                      sc " (",
+                                                      strcatComma loc (map (fn (x, _) => sc ("lw_" ^ x)) fields),
+                                                      sc ") VALUES (",
+                                                      strcatComma loc (map (fn (x, _) =>
+                                                                               (L'.EField ((L'.ERel 0, loc),
+                                                                                           x), loc)) fields),
+                                                      sc ")"]), loc)), loc),
+                      fm)
+                 end
+               | _ => poly ())
+
           | L.ECApp (
             (L.ECApp (
              (L.ECApp ((L.EFfi ("Basis", "query"), _), (L.CRecord (_, tables), _)), _),