diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-04-07 12:24:31 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-04-07 12:24:31 -0400 |
| commit | e52d6c0bc6e2e911515d21c6acc1e311a8e30db9 (patch) | |
| tree | b422a6ade536f96b318a9d9547f2f2c95562691a /src/monoize.sml | |
| parent | 69400f0524e8bcaa264eed203b8581992a4d1f7d (diff) | |
UNIQUE constraints
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 44 |
1 files changed, 38 insertions, 6 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 620e43a5..af414c08 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -149,6 +149,10 @@ fun monoType env = (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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 @@ fun monoDecl (env, fm) (all as (d, loc)) = 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 @@ fun monoize env file = 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 @@ fun monoize env file = 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 |