# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1270156876 14400
# Node ID 134da5110bf7cb4237e2b08a7ad636ab2f8f88e7
# Parent  aff5e661b5f89b9bf0c2ef98522e6b626603d740
Relational operators portability

diff -r aff5e661b5f8 -r 134da5110bf7 src/monoize.sml
--- a/src/monoize.sml	Sun Mar 28 10:10:35 2010 -0400
+++ b/src/monoize.sml	Thu Apr 01 17:21:16 2010 -0400
@@ -2403,16 +2403,26 @@
                 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 [sc "((",
-                                                       (L'.ERel 1, loc),
-                                                       sc ") ",
-                                                       (L'.ERel 2, loc),
-                                                       sc " (",
-                                                       (L'.ERel 0, loc),
-                                                       sc "))"]), loc)), loc)), loc),
+                (if #nestedRelops (Settings.currentDbms ()) then
+                     (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 [sc "((",
+                                                           (L'.ERel 1, loc),
+                                                           sc ") ",
+                                                           (L'.ERel 2, loc),
+                                                           sc " (",
+                                                           (L'.ERel 0, loc),
+                                                           sc "))"]), loc)), loc)), loc)
+                 else
+                   (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 [(L'.ERel 1, loc),
+                                                           sc " ",
+                                                           (L'.ERel 2, loc),
+                                                           sc " ",
+                                                           (L'.ERel 0, loc)]), loc)), loc)), loc),
                  fm)
             end
           | L.ECApp (
@@ -2433,8 +2443,18 @@
             end
 
           | L.EFfi ("Basis", "sql_union") => ((L'.EPrim (Prim.String "UNION"), loc), fm)
-          | L.EFfi ("Basis", "sql_intersect") => ((L'.EPrim (Prim.String "INTERSECT"), loc), fm)
-          | L.EFfi ("Basis", "sql_except") => ((L'.EPrim (Prim.String "EXCEPT"), loc), fm)
+          | L.EFfi ("Basis", "sql_intersect") =>
+            (if #onlyUnion (Settings.currentDbms ()) then
+                 ErrorMsg.errorAt loc "The DBMS you've selected doesn't support INTERSECT."
+             else
+                 ();
+             ((L'.EPrim (Prim.String "INTERSECT"), loc), fm))
+          | L.EFfi ("Basis", "sql_except") =>
+            (if #onlyUnion (Settings.currentDbms ()) then
+                 ErrorMsg.errorAt loc "The DBMS you've selected doesn't support EXCEPT."
+             else
+                 ();
+             ((L'.EPrim (Prim.String "EXCEPT"), loc), fm))
 
           | L.ECApp (
             (L.ECApp (
diff -r aff5e661b5f8 -r 134da5110bf7 src/mysql.sml
--- a/src/mysql.sml	Sun Mar 28 10:10:35 2010 -0400
+++ b/src/mysql.sml	Thu Apr 01 17:21:16 2010 -0400
@@ -1544,6 +1544,8 @@
                   sqlPrefix = "SET storage_engine=InnoDB;\n\n",
                   supportsOctetLength = true,
                   trueString = "TRUE",
-                  falseString = "FALSE"}
+                  falseString = "FALSE",
+                  onlyUnion = true,
+                  nestedRelops = false}
 
 end
diff -r aff5e661b5f8 -r 134da5110bf7 src/postgres.sml
--- a/src/postgres.sml	Sun Mar 28 10:10:35 2010 -0400
+++ b/src/postgres.sml	Thu Apr 01 17:21:16 2010 -0400
@@ -951,7 +951,9 @@
                   sqlPrefix = "",
                   supportsOctetLength = true,
                   trueString = "TRUE",
-                  falseString = "FALSE"}
+                  falseString = "FALSE",
+                  onlyUnion = false,
+                  nestedRelops = true}
 
 val () = setDbms "postgres"
 
diff -r aff5e661b5f8 -r 134da5110bf7 src/settings.sig
--- a/src/settings.sig	Sun Mar 28 10:10:35 2010 -0400
+++ b/src/settings.sig	Thu Apr 01 17:21:16 2010 -0400
@@ -167,7 +167,9 @@
          sqlPrefix : string,
          supportsOctetLength : bool,
          trueString : string,
-         falseString : string
+         falseString : string,
+         onlyUnion : bool,
+         nestedRelops : bool
     }
 
     val addDbms : dbms -> unit
diff -r aff5e661b5f8 -r 134da5110bf7 src/settings.sml
--- a/src/settings.sml	Sun Mar 28 10:10:35 2010 -0400
+++ b/src/settings.sml	Thu Apr 01 17:21:16 2010 -0400
@@ -383,7 +383,9 @@
      sqlPrefix : string,
      supportsOctetLength : bool,
      trueString : string,
-     falseString : string
+     falseString : string,
+     onlyUnion : bool,
+     nestedRelops : bool
 }
 
 val dbmses = ref ([] : dbms list)
@@ -411,7 +413,9 @@
                   sqlPrefix = "",
                   supportsOctetLength = false,
                   trueString = "",
-                  falseString = ""} : dbms)
+                  falseString = "",
+                  onlyUnion = false,
+                  nestedRelops = false} : dbms)
 
 fun addDbms v = dbmses := v :: !dbmses
 fun setDbms s =
diff -r aff5e661b5f8 -r 134da5110bf7 src/sqlite.sml
--- a/src/sqlite.sml	Sun Mar 28 10:10:35 2010 -0400
+++ b/src/sqlite.sml	Thu Apr 01 17:21:16 2010 -0400
@@ -837,6 +837,8 @@
                   sqlPrefix = "",
                   supportsOctetLength = false,
                   trueString = "1",
-                  falseString = "0"}
+                  falseString = "0",
+                  onlyUnion = false,
+                  nestedRelops = false}
 
 end