Mercurial > urweb
diff 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 |
line wrap: on
line diff
--- a/src/monoize.sml Thu Apr 09 12:31:56 2009 -0400 +++ b/src/monoize.sml Thu Apr 09 13:59:34 2009 -0400 @@ -155,6 +155,8 @@ (L'.TFfi ("Basis", "sql_constraints"), loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraint"), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CApp ((L.CFfi ("Basis", "linkable"), _), _), _), _) => + (L'.TRecord [], loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "matching"), _), _), _), _) => let val string = (L'.TFfi ("Basis", "string"), loc) @@ -1226,6 +1228,13 @@ fm) end + | L.ECApp ((L.EFfi ("Basis", "linkable_same"), loc), _) => + ((L'.ERecord [], loc), fm) + | L.ECApp ((L.EFfi ("Basis", "linkable_from_nullable"), loc), _) => + ((L'.ERecord [], loc), fm) + | L.ECApp ((L.EFfi ("Basis", "linkable_to_nullable"), loc), _) => + ((L'.ERecord [], loc), fm) + | L.EFfi ("Basis", "mat_nil") => let val string = (L'.TFfi ("Basis", "string"), loc) @@ -1239,7 +1248,9 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "mat_cons"), _), + (L.ECApp ( + (L.EFfi ("Basis", "mat_cons"), _), + _), _), _), _), _), _), _), _), @@ -1249,21 +1260,27 @@ val string = (L'.TFfi ("Basis", "string"), loc) val mat = (L'.TRecord [("1", string), ("2", string)], loc) in - ((L'.EAbs ("m", mat, mat, - (L'.ECase ((L'.EField ((L'.ERel 0, loc), "1"), loc), - [((L'.PPrim (Prim.String ""), loc), - (L'.ERecord [("1", (L'.EPrim (Prim.String ("uw_" ^ nm1)), loc), string), - ("2", (L'.EPrim (Prim.String ("uw_" ^ nm2)), loc), string)], loc)), - ((L'.PWild, loc), - (L'.ERecord [("1", (L'.EStrcat ( - (L'.EPrim (Prim.String ("uw_" ^ nm1 ^ ", ")), loc), - (L'.EField ((L'.ERel 0, loc), "1"), loc)), loc), string), - ("2", (L'.EStrcat ( - (L'.EPrim (Prim.String ("uw_" ^ nm2 ^ ", ")), loc), - (L'.EField ((L'.ERel 0, loc), "2"), loc)), loc), string)], - loc))], - {disc = string, - result = mat}), loc)), loc), + ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (mat, mat), loc), + (L'.EAbs ("m", mat, mat, + (L'.ECase ((L'.EField ((L'.ERel 0, loc), "1"), loc), + [((L'.PPrim (Prim.String ""), loc), + (L'.ERecord [("1", (L'.EPrim (Prim.String ("uw_" ^ nm1)), + loc), string), + ("2", (L'.EPrim (Prim.String ("uw_" ^ nm2)), + loc), string)], loc)), + ((L'.PWild, loc), + (L'.ERecord [("1", (L'.EStrcat ( + (L'.EPrim (Prim.String ("uw_" ^ nm1 ^ ", ")), + loc), + (L'.EField ((L'.ERel 0, loc), "1"), loc)), + loc), string), + ("2", (L'.EStrcat ( + (L'.EPrim (Prim.String ("uw_" ^ nm2 ^ ", ")), loc), + (L'.EField ((L'.ERel 0, loc), "2"), loc)), + loc), string)], + loc))], + {disc = string, + result = mat}), loc)), loc)), loc), fm) end