+
+inferConstraints :: [TyVar] -> Class -> [TcType] -> TyCon -> [TcType] -> ThetaType
+-- Generate a sufficiently large set of constraints that typechecking the
+-- generated method definitions should succeed. This set will be simplified
+-- before being used in the instance declaration
+inferConstraints _ cls inst_tys rep_tc rep_tc_args
+ = ASSERT2( equalLength rep_tc_tvs all_rep_tc_args, ppr cls <+> ppr rep_tc )
+ stupid_constraints ++ extra_constraints
+ ++ sc_constraints ++ con_arg_constraints
+ where
+ -- Constraints arising from the arguments of each constructor
+ con_arg_constraints
+ = [ mkClassPred cls [arg_ty]
+ | data_con <- tyConDataCons rep_tc,
+ arg_ty <- ASSERT( isVanillaDataCon data_con )
+ get_constrained_tys $
+ dataConInstOrigArgTys data_con all_rep_tc_args,
+ not (isUnLiftedType arg_ty) ]
+ -- No constraints for unlifted types
+ -- Where they are legal we generate specilised function calls
+
+ -- For functor-like classes, two things are different
+ -- (a) We recurse over argument types to generate constraints
+ -- See Functor examples in TcGenDeriv
+ -- (b) The rep_tc_args will be one short
+ is_functor_like = getUnique cls `elem` functorLikeClassKeys
+
+ get_constrained_tys :: [Type] -> [Type]
+ get_constrained_tys tys
+ | is_functor_like = concatMap (deepSubtypesContaining last_tv) tys
+ | otherwise = tys
+
+ rep_tc_tvs = tyConTyVars rep_tc
+ last_tv = last rep_tc_tvs
+ all_rep_tc_args | is_functor_like = rep_tc_args ++ [mkTyVarTy last_tv]
+ | otherwise = rep_tc_args
+
+ -- Constraints arising from superclasses
+ -- See Note [Superclasses of derived instance]
+ sc_constraints = substTheta (zipOpenTvSubst (classTyVars cls) inst_tys)
+ (classSCTheta cls)
+
+ -- Stupid constraints
+ stupid_constraints = substTheta subst (tyConStupidTheta rep_tc)
+ subst = zipTopTvSubst rep_tc_tvs all_rep_tc_args
+
+ -- Extra Data constraints
+ -- The Data class (only) requires that for
+ -- instance (...) => Data (T t1 t2)
+ -- IF t1:*, t2:*
+ -- THEN (Data t1, Data t2) are among the (...) constraints
+ -- Reason: when the IF holds, we generate a method
+ -- dataCast2 f = gcast2 f
+ -- and we need the Data constraints to typecheck the method
+ extra_constraints
+ | cls `hasKey` dataClassKey
+ , all (isLiftedTypeKind . typeKind) rep_tc_args
+ = [mkClassPred cls [ty] | ty <- rep_tc_args]
+ | otherwise
+ = []
+