Mercurial > urweb
diff src/elaborate.sml @ 149:7420fa18d657
Record cut
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 24 Jul 2008 10:09:21 -0400 |
parents | eb16f2aadbe9 |
children | 67ab26888839 |
line wrap: on
line diff
--- a/src/elaborate.sml Tue Jul 22 19:12:25 2008 -0400 +++ b/src/elaborate.sml Thu Jul 24 10:09:21 2008 -0400 @@ -895,6 +895,7 @@ | L'.ERecord xes => (L'.TRecord (L'.CRecord (ktype, map (fn (x, _, t) => (x, t)) xes), loc), loc) | L'.EField (_, _, {field, ...}) => field + | L'.ECut (_, _, {rest, ...}) => (L'.TRecord rest, loc) | L'.EFold dom => foldType (dom, loc) | L'.EError => cerror @@ -1108,6 +1109,23 @@ ((L'.EField (e', c', {field = ft, rest = rest}), loc), ft, gs1 @ gs2 @ gs3 @ gs4) end + | L.ECut (e, c) => + let + val (e', et, gs1) = elabExp (env, denv) e + val (c', ck, gs2) = elabCon (env, denv) c + + val ft = cunif (loc, ktype) + val rest = cunif (loc, ktype_record) + val first = (L'.CRecord (ktype, [(c', ft)]), loc) + + val gs3 = + checkCon (env, denv) e' et + (L'.TRecord (L'.CConcat (first, rest), loc), loc) + val gs4 = D.prove env denv (first, rest, loc) + in + ((L'.ECut (e', c', {field = ft, rest = rest}), loc), (L'.TRecord rest, loc), gs1 @ gs2 @ gs3 @ gs4) + end + | L.EFold => let val dom = kunif loc