Mercurial > urweb
changeset 1196:134da5110bf7
Relational operators portability
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 01 Apr 2010 17:21:16 -0400 |
| parents | aff5e661b5f8 |
| children | 6d8e3dcb9713 |
| files | src/monoize.sml src/mysql.sml src/postgres.sml src/settings.sig src/settings.sml src/sqlite.sml |
| diffstat | 6 files changed, 50 insertions(+), 18 deletions(-) [+] |
line wrap: on
line diff
--- 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 (
--- 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
--- 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"
--- 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
--- 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 =