summaryrefslogtreecommitdiff
path: root/src/monoize.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-08-31 15:47:32 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-08-31 15:47:32 -0400
commit003594fd2ed4739b9f1fdc8df350615fdc11a3f7 (patch)
tree8705b6c057ab6c4bca2a68a6f3901722a9802d03 /src/monoize.sml
parent1d2a33433b530bdfe2c4cf7c7f0e6bc7190d87c5 (diff)
Monoize relops
Diffstat (limited to 'src/monoize.sml')
-rw-r--r--src/monoize.sml45
1 files changed, 43 insertions, 2 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index 35d474e6..c9bec0c5 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -586,7 +586,18 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
if List.exists (fn x => x = NONE) tables then
NONE
else
- SOME (List.mapPartial (fn x => x) tables)
+ let
+ val tables = List.mapPartial (fn x => x) tables
+ val tables = ListMergeSort.sort
+ (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER)
+ tables
+ val tables = map (fn (x, xts) =>
+ (x, ListMergeSort.sort
+ (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER)
+ xts)) tables
+ in
+ SOME tables
+ end
end
in
case (doTables tables, doTables grouped, doTables stables, monoType env (L.TRecord sexps, loc)) of
@@ -784,7 +795,37 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_), _),
(L.CName tab, _)), _),
(L.CName field, _)) => ((L'.EPrim (Prim.String (tab ^ "." ^ field)), loc), fm)
-
+
+ | L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.EFfi ("Basis", "sql_relop"), _),
+ _), _),
+ _), _),
+ _), _),
+ _) =>
+ 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_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.EApp (
(L.ECApp (
(L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),