Mercurial > urweb
diff src/monoize.sml @ 704:70cbdcf5989b
UNIQUE constraints
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 07 Apr 2009 12:24:31 -0400 |
parents | 755a71c99be5 |
children | e6706a1df013 |
line wrap: on
line diff
--- a/src/monoize.sml Sun Apr 05 16:17:32 2009 -0400 +++ b/src/monoize.sml Tue Apr 07 12:24:31 2009 -0400 @@ -149,6 +149,10 @@ (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraints"), _), _), _), _) => + (L'.TFfi ("Basis", "sql_constraints"), loc) + | L.CApp ((L.CFfi ("Basis", "sql_constraint"), _), _) => + (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_subset"), _), _), _), _) => (L'.TRecord [], loc) @@ -1155,6 +1159,32 @@ fm) end + | L.ECApp ((L.EFfi ("Basis", "no_constraint"), _), _) => + ((L'.ERecord [], loc), + fm) + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "one_constraint"), _), _), _), (L.CName name, _)) => + ((L'.EAbs ("c", + (L'.TFfi ("Basis", "string"), loc), + (L'.TFfi ("Basis", "sql_constraints"), loc), + (L'.ERecord [(name, (L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))], loc)), loc), + fm) + | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "join_constraints"), _), _), _), _), _), _) => + let + val constraints = (L'.TFfi ("Basis", "sql_constraints"), loc) + in + ((L'.EAbs ("cs1", constraints, (L'.TFun (constraints, constraints), loc), + (L'.EAbs ("cs2", constraints, constraints, + (L'.EStrcat ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc), + fm) + end + + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "unique"), _), _), _), + (L.CRecord (_, unique), _)) => + ((L'.EPrim (Prim.String ("UNIQUE (" + ^ String.concatWith ", " (map (fn (x, _) => "uw_" ^ monoName env x) unique) + ^ ")")), loc), + fm) + | L.EFfiApp ("Basis", "dml", [e]) => let val (e, fm) = monoExp (env, st, fm) e @@ -2451,19 +2481,21 @@ in SOME (env, fm, [(L'.DExport (ek, s, n, ts, ran), loc)]) end - | L.DTable (x, n, (L.CRecord (_, xts), _), s) => + | L.DTable (x, n, (L.CRecord (_, xts), _), s, e) => let val t = (L.CFfi ("Basis", "string"), loc) val t' = (L'.TFfi ("Basis", "string"), loc) val s = "uw_" ^ s - val e = (L'.EPrim (Prim.String s), loc) + val e_name = (L'.EPrim (Prim.String s), loc) val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts + + val (e, fm) = monoExp (env, St.empty, fm) e in SOME (Env.pushENamed env x n t NONE s, fm, - [(L'.DTable (s, xts), loc), - (L'.DVal (x, n, t', e, s), loc)]) + [(L'.DTable (s, xts, e), loc), + (L'.DVal (x, n, t', e_name, s), loc)]) end | L.DTable _ => poly () | L.DSequence (x, n, s) => @@ -2583,7 +2615,7 @@ in foldl (fn ((d, _), e) => case d of - L.DTable (_, _, xts, tab) => doTable (tab, #1 xts, e) + L.DTable (_, _, xts, tab, _) => doTable (tab, #1 xts, e) | _ => e) e file end @@ -2628,7 +2660,7 @@ in foldl (fn ((d, _), e) => case d of - L.DTable (_, _, xts, tab) => doTable (tab, #1 xts, e) + L.DTable (_, _, xts, tab, _) => doTable (tab, #1 xts, e) | _ => e) e file end