Mercurial > urweb
diff src/elaborate.sml @ 141:63c699450281
Initial form support
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 20 Jul 2008 11:33:23 -0400 |
parents | f214c535d253 |
children | 80ac94b54e41 |
line wrap: on
line diff
--- a/src/elaborate.sml Sun Jul 20 10:40:25 2008 -0400 +++ b/src/elaborate.sml Sun Jul 20 11:33:23 2008 -0400 @@ -444,7 +444,7 @@ | COccursCheckFailed of L'.con * L'.con | CIncompatible of L'.con * L'.con | CExplicitness of L'.con * L'.con - | CKindof of L'.con + | CKindof of L'.kind * L'.con | CRecordFailure exception CUnify' of cunify_error @@ -468,9 +468,10 @@ eprefaces "Differing constructor function explicitness" [("Con 1", p_con env c1), ("Con 2", p_con env c2)] - | CKindof c => + | CKindof (k, c) => eprefaces "Kind unification variable blocks kindof calculation" - [("Con", p_con env c)] + [("Kind", p_kind k), + ("Con", p_con env c)] | CRecordFailure => eprefaces "Can't unify record constructors" [] @@ -526,10 +527,10 @@ end | L'.CApp (c, _) => - (case #1 (hnormKind (kindof env c)) of - L'.KArrow (_, k) => k - | L'.KError => kerror - | _ => raise CUnify' (CKindof c)) + (case hnormKind (kindof env c) of + (L'.KArrow (_, k), _) => k + | (L'.KError, _) => kerror + | k => raise CUnify' (CKindof (k, c))) | L'.CAbs (x, k, c) => (L'.KArrow (k, kindof (E.pushCRel env x k) c), loc) | L'.CDisjoint (_, _, c) => kindof env c @@ -551,7 +552,8 @@ fun rkindof c = case kindof env c of (L'.KRecord k, _) => k - | _ => raise CUnify' (CKindof c) + | (L'.KError, _) => kerror + | k => raise CUnify' (CKindof (k, c)) val k1 = rkindof c1 val k2 = rkindof c2 @@ -643,7 +645,8 @@ | (_, _, (_, r) :: rest) => let val r' = ref NONE - val cr' = (L'.CUnif (dummy, k, "recd", r'), dummy) + val kr = (L'.KRecord k, dummy) + val cr' = (L'.CUnif (dummy, kr, "recd", r'), dummy) val prefix = case (fs, others) of ([], other :: others) =>