Mercurial > urweb

comparison src/monoize.sml @ 441:c5335613f31e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
CURRENT_TIMESTAMP
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Oct 2008 15:33:28 -0400
parents 322c8620bbdf
children dfc8c991abd0
comparison
equal deleted inserted replaced
440:19d7f79cd584 441:c5335613f31e
169 (L'.TFfi ("Basis", "string"), loc) 169 (L'.TFfi ("Basis", "string"), loc)
170 | L.CApp ((L.CFfi ("Basis", "sql_summable"), _), _) => 170 | L.CApp ((L.CFfi ("Basis", "sql_summable"), _), _) =>
171 (L'.TRecord [], loc) 171 (L'.TRecord [], loc)
172 | L.CApp ((L.CFfi ("Basis", "sql_maxable"), _), _) => 172 | L.CApp ((L.CFfi ("Basis", "sql_maxable"), _), _) =>
173 (L'.TRecord [], loc) 173 (L'.TRecord [], loc)
174 | L.CApp ((L.CFfi ("Basis", "sql_nfunc"), _), _) =>
175 (L'.TFfi ("Basis", "string"), loc)
174 176
175 | L.CRel _ => poly () 177 | L.CRel _ => poly ()
176 | L.CNamed n => 178 | L.CNamed n =>
177 (case IM.find (dtmap, n) of 179 (case IM.find (dtmap, n) of
178 SOME r => (L'.TDatatype (n, r), loc) 180 SOME r => (L'.TDatatype (n, r), loc)
1124 end 1126 end
1125 end 1127 end
1126 in 1128 in
1127 case (doTables tables, doTables grouped, doTables stables, monoType env (L.TRecord sexps, loc)) of 1129 case (doTables tables, doTables grouped, doTables stables, monoType env (L.TRecord sexps, loc)) of
1128 (SOME tables, SOME grouped, SOME stables, (L'.TRecord sexps, _)) => 1130 (SOME tables, SOME grouped, SOME stables, (L'.TRecord sexps, _)) =>
1129 ((L'.EAbs ("r", 1131 let
1130 (L'.TRecord [("From", (L'.TRecord (map (fn (x, _) => (x, s)) tables), loc)), 1132 val sexps = ListMergeSort.sort
1131 ("Where", s), 1133 (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) sexps
1132 ("GroupBy", un), 1134 in
1133 ("Having", s), 1135 ((L'.EAbs ("r",
1134 ("SelectFields", un), 1136 (L'.TRecord [("From", (L'.TRecord (map (fn (x, _) => (x, s)) tables), loc)),
1135 ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))], 1137 ("Where", s),
1136 loc), 1138 ("GroupBy", un),
1137 s, 1139 ("Having", s),
1138 strcat loc [sc "SELECT ", 1140 ("SelectFields", un),
1139 strcatComma loc (map (fn (x, t) => 1141 ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))],
1140 strcat loc [ 1142 loc),
1141 (L'.EField (gf "SelectExps", x), loc), 1143 s,
1142 sc (" AS _" ^ x) 1144 strcat loc [sc "SELECT ",
1145 strcatComma loc (map (fn (x, t) =>
1146 strcat loc [
1147 (L'.EField (gf "SelectExps", x), loc),
1148 sc (" AS _" ^ x)
1143 ]) sexps 1149 ]) sexps
1144 @ map (fn (x, xts) => 1150 @ map (fn (x, xts) =>
1145 strcatComma loc 1151 strcatComma loc
1146 (map (fn (x', _) => 1152 (map (fn (x', _) =>
1147 sc (x ^ ".uw_" ^ x')) 1153 sc (x ^ ".uw_" ^ x'))
1148 xts)) stables), 1154 xts)) stables),
1149 sc " FROM ", 1155 sc " FROM ",
1150 strcatComma loc (map (fn (x, _) => strcat loc [(L'.EField (gf "From", x), loc), 1156 strcatComma loc (map (fn (x, _) => strcat loc [(L'.EField (gf "From", x), loc),
1151 sc (" AS " ^ x)]) tables), 1157 sc (" AS " ^ x)]) tables),
1152 (L'.ECase (gf "Where", 1158 (L'.ECase (gf "Where",
1153 [((L'.PPrim (Prim.String "TRUE"), loc), 1159 [((L'.PPrim (Prim.String "TRUE"), loc),
1154 sc ""), 1160 sc ""),
1155 ((L'.PWild, loc), 1161 ((L'.PWild, loc),
1156 strcat loc [sc " WHERE ", gf "Where"])], 1162 strcat loc [sc " WHERE ", gf "Where"])],
1157 {disc = s, 1163 {disc = s,
1158 result = s}), loc), 1164 result = s}), loc),
1159 1165
1160 if List.all (fn (x, xts) => 1166 if List.all (fn (x, xts) =>
1161 case List.find (fn (x', _) => x' = x) grouped of 1167 case List.find (fn (x', _) => x' = x) grouped of
1162 NONE => List.null xts 1168 NONE => List.null xts
1163 | SOME (_, xts') => 1169 | SOME (_, xts') =>
1164 List.all (fn (x, _) => 1170 List.all (fn (x, _) =>
1165 List.exists (fn (x', _) => x' = x) 1171 List.exists (fn (x', _) => x' = x)
1166 xts') xts) tables then 1172 xts') xts) tables then
1167 sc "" 1173 sc ""
1168 else 1174 else
1169 strcat loc [ 1175 strcat loc [
1170 sc " GROUP BY ", 1176 sc " GROUP BY ",
1171 strcatComma loc (map (fn (x, xts) => 1177 strcatComma loc (map (fn (x, xts) =>
1172 strcatComma loc 1178 strcatComma loc
1173 (map (fn (x', _) => 1179 (map (fn (x', _) =>
1174 sc (x ^ ".uw_" ^ x')) 1180 sc (x ^ ".uw_" ^ x'))
1175 xts)) grouped) 1181 xts)) grouped)
1176 ], 1182 ],
1177 1183
1178 (L'.ECase (gf "Having", 1184 (L'.ECase (gf "Having",
1179 [((L'.PPrim (Prim.String "TRUE"), loc), 1185 [((L'.PPrim (Prim.String "TRUE"), loc),
1180 sc ""), 1186 sc ""),
1181 ((L'.PWild, loc), 1187 ((L'.PWild, loc),
1182 strcat loc [sc " HAVING ", gf "Having"])], 1188 strcat loc [sc " HAVING ", gf "Having"])],
1183 {disc = s, 1189 {disc = s,
1184 result = s}), loc) 1190 result = s}), loc)
1185 ]), loc), 1191 ]), loc),
1186 fm) 1192 fm)
1193 end
1187 | _ => poly () 1194 | _ => poly ()
1188 end 1195 end
1189 1196
1190 | L.ECApp ( 1197 | L.ECApp (
1191 (L.ECApp ( 1198 (L.ECApp (
1495 (L'.EPrim (Prim.String "MIN"), loc)), loc), 1502 (L'.EPrim (Prim.String "MIN"), loc)), loc),
1496 fm) 1503 fm)
1497 1504
1498 | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm) 1505 | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm)
1499 | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm) 1506 | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm)
1507
1508 | L.ECApp (
1509 (L.ECApp (
1510 (L.ECApp (
1511 (L.ECApp (
1512 (L.EFfi ("Basis", "sql_nfunc"), _),
1513 _), _),
1514 _), _),
1515 _), _),
1516 _) =>
1517 let
1518 val s = (L'.TFfi ("Basis", "string"), loc)
1519 fun sc s = (L'.EPrim (Prim.String s), loc)
1520 in
1521 ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc),
1522 fm)
1523 end
1524 | L.EFfi ("Basis", "sql_current_timestamp") => ((L'.EPrim (Prim.String "CURRENT_TIMESTAMP"), loc), fm)
1500 1525
1501 | L.EFfiApp ("Basis", "nextval", [e]) => 1526 | L.EFfiApp ("Basis", "nextval", [e]) =>
1502 let 1527 let
1503 val un = (L'.TRecord [], loc) 1528 val un = (L'.TRecord [], loc)
1504 val int = (L'.TFfi ("Basis", "int"), loc) 1529 val int = (L'.TFfi ("Basis", "int"), loc)