changeset 254:f8d9395575ec

Monoized binary operators
author Adam Chlipala <adamc@hcoop.net>
date Sun, 31 Aug 2008 14:33:22 -0400
parents 7f6620853c36
children 69d337f186eb
files src/monoize.sml tests/query.ur
diffstat 2 files changed, 37 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/src/monoize.sml	Sun Aug 31 14:27:01 2008 -0400
+++ b/src/monoize.sml	Sun Aug 31 14:33:22 2008 -0400
@@ -684,6 +684,38 @@
             (L.ECApp (
              (L.ECApp (
               (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.EFfi ("Basis", "sql_binary"), _),
+                 _), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                fun sc s = (L'.EPrim (Prim.String s), loc)
+            in
+                ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                           (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
+                                     (L'.EAbs ("e2", s, s,
+                                               strcat loc [sc "(",
+                                                           (L'.ERel 1, loc),
+                                                           sc " ",
+                                                           (L'.ERel 2, loc),
+                                                           sc " ",
+                                                           (L'.ERel 0, loc),
+                                                           sc ")"]), loc)), loc)), loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "sql_and") => ((L'.EPrim (Prim.String "AND"), loc), fm)
+          | L.EFfi ("Basis", "sql_or") => ((L'.EPrim (Prim.String "OR"), loc), fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
                (L.EFfi ("Basis", "sql_comparison"), _),
                _), _),
               _), _),
@@ -696,11 +728,13 @@
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
                                      (L'.EAbs ("e2", s, s,
-                                               strcat loc [(L'.ERel 1, loc),
+                                               strcat loc [sc "(",
+                                                           (L'.ERel 1, loc),
                                                            sc " ",
                                                            (L'.ERel 2, loc),
                                                            sc " ",
-                                                           (L'.ERel 0, loc)]), loc)), loc)), loc),
+                                                           (L'.ERel 0, loc),
+                                                           sc ")"]), loc)), loc)), loc),
                  fm)
             end
 
--- a/tests/query.ur	Sun Aug 31 14:27:01 2008 -0400
+++ b/tests/query.ur	Sun Aug 31 14:33:22 2008 -0400
@@ -3,8 +3,7 @@
 
 datatype list a = Nil | Cons of a * list a
 
-(*val q1 = (SELECT * FROM t1)*)
-val q1 = (SELECT * FROM t1 WHERE t1.A = 0)
+val q1 = (SELECT * FROM t1)
 
 val r1 : transaction (list {A : int, B : string, C : float, D : bool}) =
         query q1