summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2010-04-01 17:21:16 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2010-04-01 17:21:16 -0400
commit5426959c49c3eeb40f6aac7595d91b867b4e4417 (patch)
tree640b653b8f73d907847dbf5887f47484ce9f0255
parent163747f5d60201ae83f2e57b72ee5d32b247cae5 (diff)
Relational operators portability
-rw-r--r--src/monoize.sml44
-rw-r--r--src/mysql.sml4
-rw-r--r--src/postgres.sml4
-rw-r--r--src/settings.sig4
-rw-r--r--src/settings.sml8
-rw-r--r--src/sqlite.sml4
6 files changed, 50 insertions, 18 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index 9799ae95..25ea87f5 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2403,16 +2403,26 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 --git a/src/mysql.sml b/src/mysql.sml
index b894bfac..fa49ced3 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1544,6 +1544,8 @@ val () = addDbms {name = "mysql",
sqlPrefix = "SET storage_engine=InnoDB;\n\n",
supportsOctetLength = true,
trueString = "TRUE",
- falseString = "FALSE"}
+ falseString = "FALSE",
+ onlyUnion = true,
+ nestedRelops = false}
end
diff --git a/src/postgres.sml b/src/postgres.sml
index a3f33db1..8541ca4a 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -951,7 +951,9 @@ val () = addDbms {name = "postgres",
sqlPrefix = "",
supportsOctetLength = true,
trueString = "TRUE",
- falseString = "FALSE"}
+ falseString = "FALSE",
+ onlyUnion = false,
+ nestedRelops = true}
val () = setDbms "postgres"
diff --git a/src/settings.sig b/src/settings.sig
index 94472eb1..a5f0cfa7 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -167,7 +167,9 @@ signature SETTINGS = sig
sqlPrefix : string,
supportsOctetLength : bool,
trueString : string,
- falseString : string
+ falseString : string,
+ onlyUnion : bool,
+ nestedRelops : bool
}
val addDbms : dbms -> unit
diff --git a/src/settings.sml b/src/settings.sml
index 97c16675..b9056c5b 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -383,7 +383,9 @@ type dbms = {
sqlPrefix : string,
supportsOctetLength : bool,
trueString : string,
- falseString : string
+ falseString : string,
+ onlyUnion : bool,
+ nestedRelops : bool
}
val dbmses = ref ([] : dbms list)
@@ -411,7 +413,9 @@ val curDb = ref ({name = "",
sqlPrefix = "",
supportsOctetLength = false,
trueString = "",
- falseString = ""} : dbms)
+ falseString = "",
+ onlyUnion = false,
+ nestedRelops = false} : dbms)
fun addDbms v = dbmses := v :: !dbmses
fun setDbms s =
diff --git a/src/sqlite.sml b/src/sqlite.sml
index 593db22e..26cfc9d5 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -837,6 +837,8 @@ val () = addDbms {name = "sqlite",
sqlPrefix = "",
supportsOctetLength = false,
trueString = "1",
- falseString = "0"}
+ falseString = "0",
+ onlyUnion = false,
+ nestedRelops = false}
end