comparison src/monoize.sml @ 712:915ec60592d4

More flexible foreign keying
author Adam Chlipala <adamc@hcoop.net>
date Thu, 09 Apr 2009 13:59:34 -0400
parents 0406e9cccb72
children 0f42461273cf
comparison
equal deleted inserted replaced
711:7292bcb7c02d 712:915ec60592d4
153 (L'.TFfi ("Basis", "string"), loc) 153 (L'.TFfi ("Basis", "string"), loc)
154 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraints"), _), _), _), _) => 154 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraints"), _), _), _), _) =>
155 (L'.TFfi ("Basis", "sql_constraints"), loc) 155 (L'.TFfi ("Basis", "sql_constraints"), loc)
156 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraint"), _), _), _), _) => 156 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraint"), _), _), _), _) =>
157 (L'.TFfi ("Basis", "string"), loc) 157 (L'.TFfi ("Basis", "string"), loc)
158 | L.CApp ((L.CApp ((L.CFfi ("Basis", "linkable"), _), _), _), _) =>
159 (L'.TRecord [], loc)
158 | L.CApp ((L.CApp ((L.CFfi ("Basis", "matching"), _), _), _), _) => 160 | L.CApp ((L.CApp ((L.CFfi ("Basis", "matching"), _), _), _), _) =>
159 let 161 let
160 val string = (L'.TFfi ("Basis", "string"), loc) 162 val string = (L'.TFfi ("Basis", "string"), loc)
161 in 163 in
162 (L'.TRecord [("1", string), ("2", string)], loc) 164 (L'.TRecord [("1", string), ("2", string)], loc)
1224 ^ String.concatWith ", " (map (fn (x, _) => "uw_" ^ monoName env x) unique) 1226 ^ String.concatWith ", " (map (fn (x, _) => "uw_" ^ monoName env x) unique)
1225 ^ ")")), loc), 1227 ^ ")")), loc),
1226 fm) 1228 fm)
1227 end 1229 end
1228 1230
1231 | L.ECApp ((L.EFfi ("Basis", "linkable_same"), loc), _) =>
1232 ((L'.ERecord [], loc), fm)
1233 | L.ECApp ((L.EFfi ("Basis", "linkable_from_nullable"), loc), _) =>
1234 ((L'.ERecord [], loc), fm)
1235 | L.ECApp ((L.EFfi ("Basis", "linkable_to_nullable"), loc), _) =>
1236 ((L'.ERecord [], loc), fm)
1237
1229 | L.EFfi ("Basis", "mat_nil") => 1238 | L.EFfi ("Basis", "mat_nil") =>
1230 let 1239 let
1231 val string = (L'.TFfi ("Basis", "string"), loc) 1240 val string = (L'.TFfi ("Basis", "string"), loc)
1232 val stringE = (L'.EPrim (Prim.String ""), loc) 1241 val stringE = (L'.EPrim (Prim.String ""), loc)
1233 in 1242 in
1237 | L.ECApp ( 1246 | L.ECApp (
1238 (L.ECApp ( 1247 (L.ECApp (
1239 (L.ECApp ( 1248 (L.ECApp (
1240 (L.ECApp ( 1249 (L.ECApp (
1241 (L.ECApp ( 1250 (L.ECApp (
1242 (L.EFfi ("Basis", "mat_cons"), _), 1251 (L.ECApp (
1252 (L.EFfi ("Basis", "mat_cons"), _),
1253 _), _),
1243 _), _), 1254 _), _),
1244 _), _), 1255 _), _),
1245 _), _), 1256 _), _),
1246 (L.CName nm1, _)), _), 1257 (L.CName nm1, _)), _),
1247 (L.CName nm2, _)) => 1258 (L.CName nm2, _)) =>
1248 let 1259 let
1249 val string = (L'.TFfi ("Basis", "string"), loc) 1260 val string = (L'.TFfi ("Basis", "string"), loc)
1250 val mat = (L'.TRecord [("1", string), ("2", string)], loc) 1261 val mat = (L'.TRecord [("1", string), ("2", string)], loc)
1251 in 1262 in
1252 ((L'.EAbs ("m", mat, mat, 1263 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (mat, mat), loc),
1253 (L'.ECase ((L'.EField ((L'.ERel 0, loc), "1"), loc), 1264 (L'.EAbs ("m", mat, mat,
1254 [((L'.PPrim (Prim.String ""), loc), 1265 (L'.ECase ((L'.EField ((L'.ERel 0, loc), "1"), loc),
1255 (L'.ERecord [("1", (L'.EPrim (Prim.String ("uw_" ^ nm1)), loc), string), 1266 [((L'.PPrim (Prim.String ""), loc),
1256 ("2", (L'.EPrim (Prim.String ("uw_" ^ nm2)), loc), string)], loc)), 1267 (L'.ERecord [("1", (L'.EPrim (Prim.String ("uw_" ^ nm1)),
1257 ((L'.PWild, loc), 1268 loc), string),
1258 (L'.ERecord [("1", (L'.EStrcat ( 1269 ("2", (L'.EPrim (Prim.String ("uw_" ^ nm2)),
1259 (L'.EPrim (Prim.String ("uw_" ^ nm1 ^ ", ")), loc), 1270 loc), string)], loc)),
1260 (L'.EField ((L'.ERel 0, loc), "1"), loc)), loc), string), 1271 ((L'.PWild, loc),
1261 ("2", (L'.EStrcat ( 1272 (L'.ERecord [("1", (L'.EStrcat (
1262 (L'.EPrim (Prim.String ("uw_" ^ nm2 ^ ", ")), loc), 1273 (L'.EPrim (Prim.String ("uw_" ^ nm1 ^ ", ")),
1263 (L'.EField ((L'.ERel 0, loc), "2"), loc)), loc), string)], 1274 loc),
1264 loc))], 1275 (L'.EField ((L'.ERel 0, loc), "1"), loc)),
1265 {disc = string, 1276 loc), string),
1266 result = mat}), loc)), loc), 1277 ("2", (L'.EStrcat (
1278 (L'.EPrim (Prim.String ("uw_" ^ nm2 ^ ", ")), loc),
1279 (L'.EField ((L'.ERel 0, loc), "2"), loc)),
1280 loc), string)],
1281 loc))],
1282 {disc = string,
1283 result = mat}), loc)), loc)), loc),
1267 fm) 1284 fm)
1268 end 1285 end
1269 1286
1270 | L.ECApp ((L.EFfi ("Basis", "restrict"), _), _) => ((L'.EPrim (Prim.String "RESTRICT"), loc), fm) 1287 | L.ECApp ((L.EFfi ("Basis", "restrict"), _), _) => ((L'.EPrim (Prim.String "RESTRICT"), loc), fm)
1271 | L.ECApp ((L.EFfi ("Basis", "cascade"), _), _) => ((L'.EPrim (Prim.String "CASCADE"), loc), fm) 1288 | L.ECApp ((L.EFfi ("Basis", "cascade"), _), _) => ((L'.EPrim (Prim.String "CASCADE"), loc), fm)