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) =>