Mercurial > urweb
diff src/elaborate.sml @ 6:38bf996e1c2e
Check for leftover kind unifs
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 26 Jan 2008 16:44:39 -0500 |
parents | 258261a53842 |
children | a455a9f85cc3 |
line wrap: on
line diff
--- a/src/elaborate.sml Sat Jan 26 16:02:47 2008 -0500 +++ b/src/elaborate.sml Sat Jan 26 16:44:39 2008 -0500 @@ -261,6 +261,28 @@ ((L'.CConcat (c1', c2'), loc), k) end +fun kunifsRemain k = + case k of + L'.KUnif (_, ref NONE) => true + | _ => false + +val kunifsInKind = U.Kind.exists kunifsRemain +val kunifsInCon = U.Con.exists {kind = kunifsRemain, + con = fn _ => false} + +datatype decl_error = + KunifsRemainKind of ErrorMsg.span * L'.kind + | KunifsRemainCon of ErrorMsg.span * L'.con + +fun declError env err = + case err of + KunifsRemainKind (loc, k) => + (ErrorMsg.errorAt loc "Some kind unification variables are undetermined in kind"; + eprefaces' [("Kind", p_kind k)]) + | KunifsRemainCon (loc, c) => + (ErrorMsg.errorAt loc "Some kind unification variables are undetermined in constructor"; + eprefaces' [("Constructor", p_con env c)]) + fun elabDecl env (d, loc) = (resetKunif (); case d of @@ -274,6 +296,17 @@ val (env', n) = E.pushCNamed env x k' in checkKind env c' ck k'; + + if kunifsInKind k' then + declError env (KunifsRemainKind (loc, k')) + else + (); + + if kunifsInCon c' then + declError env (KunifsRemainCon (loc, c')) + else + (); + (env', (L'.DCon (x, n, k', c'), loc)) end)