From cfc8f7c2a49494d47d2966b310c5b3fbc2ae2499 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Fri, 9 Apr 2010 18:44:20 +0000 Subject: [PATCH] Fix Trac #3965: tighten conditions when deriving Data It's tricky to set up the context for a Data instance. I got it wrong once, and fixed it -- hence the "extra_constraints" in TcDeriv.inferConstraints. But it still wasn't right! The tricky bit is that dataCast1 is only generated when T :: *->*, and dataCast2 when T :: *->*->*. (See the code in TcGenDeriv for dataCastX. --- compiler/typecheck/TcDeriv.lhs | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 2aba527..3a05380 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -743,7 +743,7 @@ inferConstraints :: [TyVar] -> Class -> [TcType] -> TyCon -> [TcType] -> ThetaTy -- 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 tvs cls inst_tys rep_tc rep_tc_args +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 @@ -784,15 +784,20 @@ inferConstraints tvs cls inst_tys rep_tc rep_tc_args stupid_constraints = substTheta subst (tyConStupidTheta rep_tc) subst = zipTopTvSubst rep_tc_tvs all_rep_tc_args - -- Extra constraints + -- Extra Data constraints -- The Data class (only) requires that for - -- instance (...) => Data (T a b) - -- then (Data a, Data b) are among the (...) constraints - -- Reason: that's what you need to typecheck the method - -- dataCast1 f = gcast1 f + -- 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 = [mkClassPred cls [mkTyVarTy tv] | tv <- tvs] - | otherwise = [] + | cls `hasKey` dataClassKey + , all (isLiftedTypeKind . typeKind) rep_tc_args + = [mkClassPred cls [ty] | ty <- rep_tc_args] + | otherwise + = [] ------------------------------------------------------------------ -- Check side conditions that dis-allow derivability for particular classes @@ -1295,6 +1300,7 @@ inferInstanceContexts oflag infer_specs weird_preds = [pred | pred <- theta, not (tyVarsOfPred pred `subVarSet` tv_set)] ; mapM_ (addErrTc . badDerivedPred) weird_preds + ; traceTc (text "TcDeriv" <+> (ppr deriv_rhs $$ ppr theta)) -- Claim: the result instance declaration is guaranteed valid -- Hence no need to call: -- checkValidInstance tyvars theta clas inst_tys -- 1.7.10.4