X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyClsDecls.lhs;h=71e8659b15d906080ab8f97897dfd9fc947f42c5;hp=3177b66a4866fd9a8eed9b6148c0106ab6149014;hb=9a4ef343a46e823bcf949af8501c13cc8ca98fb1;hpb=80d071f68134bf3ad89d4de0d83807e2f0ec32c0

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 3177b66..71e8659 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -275,7 +275,8 @@ tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name})
        ; checkTc (isSynTyCon family) (wrongKindOfFamily family)
 
        ; -- (1) kind check the right-hand side of the type equation
-       ; k_rhs <- kcCheckLHsType (tcdSynRhs decl) resKind
+       ; k_rhs <- kcCheckLHsType (tcdSynRhs decl) (EK resKind EkUnk)
+       	       	  -- ToDo: the ExpKind could be better
 
          -- we need the exact same number of type parameters as the family
          -- declaration 
@@ -378,7 +379,8 @@ kcIdxTyPats :: TyClDecl Name
 	    -> TcM a
 kcIdxTyPats decl thing_inside
   = kcHsTyVars (tcdTyVars decl) $ \tvs -> 
-    do { fam_tycon <- tcLookupLocatedTyCon (tcdLName decl)
+    do { let tc_name = tcdLName decl
+       ; fam_tycon <- tcLookupLocatedTyCon tc_name
        ; let { (kinds, resKind) = splitKindFunTys (tyConKind fam_tycon)
 	     ; hs_typats	= fromJust $ tcdTyPats decl }
 
@@ -388,10 +390,11 @@ kcIdxTyPats decl thing_inside
 
          -- type functions can have a higher-kinded result
        ; let resultKind = mkArrowKinds (drop (length hs_typats) kinds) resKind
-       ; typats <- zipWithM kcCheckLHsType hs_typats kinds
+       ; typats <- zipWithM kcCheckLHsType hs_typats 
+       	 	   	    [ EK kind (EkArg (ppr tc_name) n) 
+                            | (kind,n) <- kinds `zip` [1..]]
        ; thing_inside tvs typats resultKind fam_tycon
        }
-  where
 \end{code}