diff options
| -rw-r--r-- | src/monoize.sml | 44 | ||||
| -rw-r--r-- | src/mysql.sml | 4 | ||||
| -rw-r--r-- | src/postgres.sml | 4 | ||||
| -rw-r--r-- | src/settings.sig | 4 | ||||
| -rw-r--r-- | src/settings.sml | 8 | ||||
| -rw-r--r-- | src/sqlite.sml | 4 |
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 |