X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyClsDecls.lhs;h=ddccb2f11f212aa661bebc2b6a5aff15f2cf6d7d;hb=275dde6de685153db621b11f2f404aa78d9183e2;hp=c2054e3962376a64244b2eff13c03d34a4828e9b;hpb=80c89b80c355b2aaebcd53330e6c6170c3f05aca;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index c2054e3..ddccb2f 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -306,13 +306,12 @@ tcIdxTyInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
        ; checkTc (new_or_data == DataType || isSingleton k_cons) $
 	   newtypeConError tc_name (length k_cons)
 
-       ; final_tvs <- tcDataKindSig (Just $ tyConKind family)
        ; t_typats     <- mappM tcHsKindedType k_typats
        ; stupid_theta <- tcHsKindedContext k_ctxt
 
        ; tycon <- fixM (\ tycon -> do 
 	     { data_cons <- mappM (addLocM (tcConDecl unbox_strict new_or_data 
-					      tycon final_tvs (Just t_typats)))
+					      tycon t_tvs (Just t_typats)))
 				  k_cons
 	     ; tc_rhs <-
 		 case new_or_data of
@@ -616,7 +615,8 @@ tcTyClDecl calc_isrec decl
 tcTyClDecl1 _calc_isrec 
   (TyFunction {tcdLName = L _ tc_name, tcdTyVars = tvs, tcdKind = kind})
   = tcTyVarBndrs tvs  $ \ tvs' -> do 
-  { gla_exts <- doptM Opt_GlasgowExts
+  { traceTc (text "type family: " <+> ppr tc_name) 
+  ; gla_exts <- doptM Opt_GlasgowExts
 
 	-- Check that we don't use kind signatures without Glasgow extensions
   ; checkTc gla_exts $ badSigTyDecl tc_name
@@ -627,9 +627,10 @@ tcTyClDecl1 _calc_isrec
   -- kind signature for an indexed data type
 tcTyClDecl1 _calc_isrec 
   (TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs,
-	   tcdLName = L _ tc_name, tcdKindSig = mb_ksig, tcdCons = []})
+	   tcdLName = L _ tc_name, tcdKindSig = Just ksig, tcdCons = []})
   = tcTyVarBndrs tvs  $ \ tvs' -> do 
-  { extra_tvs <- tcDataKindSig mb_ksig
+  { traceTc (text "data/newtype family: " <+> ppr tc_name) 
+  ; extra_tvs <- tcDataKindSig (Just ksig)
   ; let final_tvs = tvs' ++ extra_tvs    -- we may not need these
 
   ; checkTc (null . unLoc $ ctxt) $ badKindSigCtxt tc_name