+
+ -- Given data T a b c = ... deriving( C d ),
+ -- we want to drop type variables from T so that (C d (T a)) is well-kinded
+ ; let cls_tyvars = classTyVars cls
+ kind = tyVarKind (last cls_tyvars)
+ (arg_kinds, _) = splitKindFunTys kind
+ n_args_to_drop = length arg_kinds
+ n_args_to_keep = tyConArity tc - n_args_to_drop
+ inst_ty = mkTyConApp tc (take n_args_to_keep tc_args)
+ inst_ty_kind = typeKind inst_ty
+
+ -- Check that the result really is well-kinded
+ ; checkTc (n_args_to_keep >= 0 && (inst_ty_kind `eqKind` kind))
+ (derivingKindErr tc cls cls_tys kind)
+
+ -- Type families can't be partially applied
+ -- e.g. newtype instance T Int a = ... deriving( Monad )
+ ; checkTc (not (isOpenTyCon tc) || n_args_to_drop == 0)
+ (typeFamilyPapErr tc cls cls_tys inst_ty)
+
+ ; mkEqnHelp DerivOrigin (tvs++deriv_tvs) cls cls_tys inst_ty Nothing } }
+ where
+ -- Tiresomely we must figure out the "lhs", which is awkward for type families
+ -- E.g. data T a b = .. deriving( Eq )
+ -- Here, the lhs is (T a b)
+ -- data instance TF Int b = ... deriving( Eq )
+ -- Here, the lhs is (TF Int b)
+ -- But if we just look up the tycon_name, we get is the *family*
+ -- tycon, but not pattern types -- they are in the *rep* tycon.
+ get_lhs Nothing = do { tc <- tcLookupTyCon tycon_name
+ ; let tvs = tyConTyVars tc
+ ; return (tvs, tc, mkTyVarTys tvs) }
+ get_lhs (Just pats) = do { let hs_app = nlHsTyConApp tycon_name pats
+ ; (tvs, tc_app) <- tcHsQuantifiedType tv_names hs_app
+ ; let (tc, tc_args) = tcSplitTyConApp tc_app
+ ; return (tvs, tc, tc_args) }