Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f4bac607 by Simon Peyton Jones at 2025-08-19T16:28:47-04:00 Take yet more care with reporting redundant constraints This small patch fixes #25992, which relates to reporting redundant constraints on default-method declarations. See (TRC5) in Note [Tracking redundant constraints] - - - - - 5 changed files: - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs - + testsuite/tests/typecheck/should_compile/T25992a.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -887,7 +887,7 @@ Wrinkles: Plainly the (C a) constraint is unused; but the expanded decl will look like $dmop2 :: C a => a -> a - $dmop2 = op1 . op2 + $dmop2 = op1 . op1 $fCList :: forall a. C a => C [a] $fCList @a (d::C a) = MkC (\(x:a).x) ($dmop2 @a d) @@ -902,10 +902,12 @@ Wrinkles: It's a bit of a palaver, but not really difficult. All the logic is localised in `neededEvVars`. - - ------ Reporting redundant constraints - + But NOTE that this only applies to /vanilla/ default methods. + For /generic/ default methods, like + class D a where { op1 :: blah + ; default op1 :: Eq a => blah2 } + the (Eq a) constraint really is needed (e.g. class NFData and #25992). + Hence the `Bool` field of `MethSkol` indicates a /vanilla/ default method. ----- Examples ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1889,7 +1889,8 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys Just (dm_name, dm_spec) -> do { (meth_bind, inline_prags) <- mkDefMethBind inst_loc dfun_id clas sel_id dm_name dm_spec - ; tcMethodBody True clas tyvars dfun_ev_vars inst_tys + ; tcMethodBody (is_vanilla_dm dm_spec) + clas tyvars dfun_ev_vars inst_tys dfun_ev_binds is_derived hs_sig_fn spec_inst_prags inline_prags sel_id meth_bind inst_loc } @@ -1945,6 +1946,12 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys cls_meth_nms = map (idName . fst) op_items mismatched_meths = bind_nms `minusList` cls_meth_nms + is_vanilla_dm :: DefMethSpec ty -> Bool + -- See (TRC5) in Note [Tracking redundant constraints] + -- in GHC.Tc.Solver.Solve + is_vanilla_dm VanillaDM = True + is_vanilla_dm (GenericDM {}) = False + {- Note [Mismatched class methods and associated type families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2014,20 +2021,22 @@ Instead, we take the following approach: -} ------------------------ -tcMethodBody :: Bool +tcMethodBody :: Bool -- True <=> This is a vanilla default method + -- See (TRC5) in Note [Tracking redundant constraints] + -- in GHC.Tc.Solver.Solve -> Class -> [TcTyVar] -> [EvVar] -> [TcType] -> TcEvBinds -> Bool -> HsSigFun -> [LTcSpecPrag] -> [LSig GhcRn] -> Id -> LHsBind GhcRn -> SrcSpan -> TcM (TcId, LHsBind GhcTc, Maybe Implication) -tcMethodBody is_def_meth clas tyvars dfun_ev_vars inst_tys - dfun_ev_binds is_derived - sig_fn spec_inst_prags prags - sel_id (L bind_loc meth_bind) bndr_loc +tcMethodBody is_vanilla_dm clas tyvars dfun_ev_vars inst_tys + dfun_ev_binds is_derived + sig_fn spec_inst_prags prags + sel_id (L bind_loc meth_bind) bndr_loc = add_meth_ctxt $ do { traceTc "tcMethodBody" (ppr sel_id <+> ppr (idType sel_id) $$ ppr bndr_loc) - ; let skol_info = MethSkol meth_name is_def_meth + ; let skol_info = MethSkol meth_name is_vanilla_dm ; (global_meth_id, local_meth_id) <- setSrcSpan bndr_loc $ mkMethIds clas tyvars dfun_ev_vars inst_tys sel_id ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -291,10 +291,13 @@ data SkolemInfoAnon PatersonSize -- Head has the given PatersonSize | MethSkol Name Bool -- Bound by the type of class method op - -- True <=> it's a default method - -- False <=> it's a user-written method + -- True <=> it's a vanilla default method + -- False <=> it's a user-written, or generic-default, method + -- See (TRC5) in Note [Tracking redundant constraints] + -- in GHC.Tc.Solver.Solve | FamInstSkol -- Bound at a family instance decl + | PatSkol -- An existential type variable bound by a pattern for ConLike -- a data constructor with an existential type. HsMatchContextRn ===================================== testsuite/tests/typecheck/should_compile/T25992a.hs ===================================== @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -Wredundant-constraints #-} + +module T25992 where + +import Control.DeepSeq +import GHC.Generics (Generic) + +data Foo a = Foo a + deriving (Generic) + +instance NFData a => NFData (Foo a) + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -944,3 +944,4 @@ test('T26020a', [extra_files(['T26020a_help.hs'])], multimod_compile, ['T26020a' test('T25992', normal, compile, ['']) test('T14010', normal, compile, ['']) test('T26256a', normal, compile, ['']) +test('T25992a', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f4bac60722ac990d349bdffa3e4fcfca... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f4bac60722ac990d349bdffa3e4fcfca... You're receiving this email because of your account on gitlab.haskell.org.