From 229aaa59fd13e69778cb1ec809d065fa25b40a43 Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:34:23 +0000 Subject: [PATCH] Fix kind lookup in kcIdxTyPats Mon Sep 18 18:58:14 EDT 2006 Manuel M T Chakravarty * Fix kind lookup in kcIdxTyPats Tue Aug 15 21:02:34 EDT 2006 Manuel M T Chakravarty * Fix kind lookup in kcIdxTyPats --- compiler/typecheck/TcTyClsDecls.lhs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) 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} -- 1.7.10.4