X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyClsDecls.lhs;h=d69e632f2c0861dee50c170b6dc2c3e189dae322;hp=e87cd6643c6ef56ffc0c976bfc9d5f7beb780182;hb=229aaa59fd13e69778cb1ec809d065fa25b40a43;hpb=e8a591c1a3dbdeccec2dd2aacccd7435004b0d51

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index e87cd66..d69e632 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -50,7 +50,7 @@ import TyCon		( TyCon, AlgTyConRhs( AbstractTyCon, OpenDataTyCon,
 			  tyConDataCons, mkForeignTyCon, isProductTyCon,
 			  isRecursiveTyCon, isOpenTyCon,
 			  tyConStupidTheta, synTyConRhs, isSynTyCon, tyConName,
-                          isNewTyCon )
+                          isNewTyCon, tyConKind )
 import DataCon		( DataCon, dataConUserType, dataConName, 
 			  dataConFieldLabels, dataConTyCon, dataConAllTyVars,
 			  dataConFieldType, dataConResTys )
@@ -338,9 +338,10 @@ kcIdxTyPats :: TyClDecl Name
 kcIdxTyPats decl thing_inside
   = kcHsTyVars (tcdTyVars decl) $ \tvs -> 
     do { tc_ty_thing <- tcLookupLocated (tcdLName decl)
-       ; let tc_kind          = case tc_ty_thing of { AThing k -> k }
-	     (kinds, resKind) = splitKindFunTys tc_kind
-	     hs_typats	      = fromJust $ tcdTyPats decl
+       ; let { tc_kind = case tc_ty_thing of 
+		           AGlobal (ATyCon tycon) -> tyConKind tycon
+             ; (kinds, resKind) = splitKindFunTys tc_kind
+	     ; hs_typats	= fromJust $ tcdTyPats decl }
 
          -- we may not have more parameters than the kind indicates
        ; checkTc (length kinds >= length hs_typats) $
@@ -351,6 +352,7 @@ kcIdxTyPats decl thing_inside
        ; typats <- zipWithM kcCheckHsType hs_typats kinds
        ; thing_inside tvs typats resultKind
        }
+  where
 \end{code}