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
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:
| ... | ... | @@ -887,7 +887,7 @@ Wrinkles: |
| 887 | 887 | |
| 888 | 888 | Plainly the (C a) constraint is unused; but the expanded decl will look like
|
| 889 | 889 | $dmop2 :: C a => a -> a
|
| 890 | - $dmop2 = op1 . op2
|
|
| 890 | + $dmop2 = op1 . op1
|
|
| 891 | 891 | |
| 892 | 892 | $fCList :: forall a. C a => C [a]
|
| 893 | 893 | $fCList @a (d::C a) = MkC (\(x:a).x) ($dmop2 @a d)
|
| ... | ... | @@ -902,10 +902,12 @@ Wrinkles: |
| 902 | 902 | It's a bit of a palaver, but not really difficult.
|
| 903 | 903 | All the logic is localised in `neededEvVars`.
|
| 904 | 904 | |
| 905 | - |
|
| 906 | - |
|
| 907 | ------ Reporting redundant constraints
|
|
| 908 | - |
|
| 905 | + But NOTE that this only applies to /vanilla/ default methods.
|
|
| 906 | + For /generic/ default methods, like
|
|
| 907 | + class D a where { op1 :: blah
|
|
| 908 | + ; default op1 :: Eq a => blah2 }
|
|
| 909 | + the (Eq a) constraint really is needed (e.g. class NFData and #25992).
|
|
| 910 | + Hence the `Bool` field of `MethSkol` indicates a /vanilla/ default method.
|
|
| 909 | 911 | |
| 910 | 912 | ----- Examples
|
| 911 | 913 |
| ... | ... | @@ -1889,7 +1889,8 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys |
| 1889 | 1889 | |
| 1890 | 1890 | Just (dm_name, dm_spec) ->
|
| 1891 | 1891 | do { (meth_bind, inline_prags) <- mkDefMethBind inst_loc dfun_id clas sel_id dm_name dm_spec
|
| 1892 | - ; tcMethodBody True clas tyvars dfun_ev_vars inst_tys
|
|
| 1892 | + ; tcMethodBody (is_vanilla_dm dm_spec)
|
|
| 1893 | + clas tyvars dfun_ev_vars inst_tys
|
|
| 1893 | 1894 | dfun_ev_binds is_derived hs_sig_fn
|
| 1894 | 1895 | spec_inst_prags inline_prags
|
| 1895 | 1896 | sel_id meth_bind inst_loc }
|
| ... | ... | @@ -1945,6 +1946,12 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys |
| 1945 | 1946 | cls_meth_nms = map (idName . fst) op_items
|
| 1946 | 1947 | mismatched_meths = bind_nms `minusList` cls_meth_nms
|
| 1947 | 1948 | |
| 1949 | + is_vanilla_dm :: DefMethSpec ty -> Bool
|
|
| 1950 | + -- See (TRC5) in Note [Tracking redundant constraints]
|
|
| 1951 | + -- in GHC.Tc.Solver.Solve
|
|
| 1952 | + is_vanilla_dm VanillaDM = True
|
|
| 1953 | + is_vanilla_dm (GenericDM {}) = False
|
|
| 1954 | + |
|
| 1948 | 1955 | {-
|
| 1949 | 1956 | Note [Mismatched class methods and associated type families]
|
| 1950 | 1957 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| ... | ... | @@ -2014,20 +2021,22 @@ Instead, we take the following approach: |
| 2014 | 2021 | -}
|
| 2015 | 2022 | |
| 2016 | 2023 | ------------------------
|
| 2017 | -tcMethodBody :: Bool
|
|
| 2024 | +tcMethodBody :: Bool -- True <=> This is a vanilla default method
|
|
| 2025 | + -- See (TRC5) in Note [Tracking redundant constraints]
|
|
| 2026 | + -- in GHC.Tc.Solver.Solve
|
|
| 2018 | 2027 | -> Class -> [TcTyVar] -> [EvVar] -> [TcType]
|
| 2019 | 2028 | -> TcEvBinds -> Bool
|
| 2020 | 2029 | -> HsSigFun
|
| 2021 | 2030 | -> [LTcSpecPrag] -> [LSig GhcRn]
|
| 2022 | 2031 | -> Id -> LHsBind GhcRn -> SrcSpan
|
| 2023 | 2032 | -> TcM (TcId, LHsBind GhcTc, Maybe Implication)
|
| 2024 | -tcMethodBody is_def_meth clas tyvars dfun_ev_vars inst_tys
|
|
| 2025 | - dfun_ev_binds is_derived
|
|
| 2026 | - sig_fn spec_inst_prags prags
|
|
| 2027 | - sel_id (L bind_loc meth_bind) bndr_loc
|
|
| 2033 | +tcMethodBody is_vanilla_dm clas tyvars dfun_ev_vars inst_tys
|
|
| 2034 | + dfun_ev_binds is_derived
|
|
| 2035 | + sig_fn spec_inst_prags prags
|
|
| 2036 | + sel_id (L bind_loc meth_bind) bndr_loc
|
|
| 2028 | 2037 | = add_meth_ctxt $
|
| 2029 | 2038 | do { traceTc "tcMethodBody" (ppr sel_id <+> ppr (idType sel_id) $$ ppr bndr_loc)
|
| 2030 | - ; let skol_info = MethSkol meth_name is_def_meth
|
|
| 2039 | + ; let skol_info = MethSkol meth_name is_vanilla_dm
|
|
| 2031 | 2040 | ; (global_meth_id, local_meth_id) <- setSrcSpan bndr_loc $
|
| 2032 | 2041 | mkMethIds clas tyvars dfun_ev_vars
|
| 2033 | 2042 | inst_tys sel_id
|
| ... | ... | @@ -291,10 +291,13 @@ data SkolemInfoAnon |
| 291 | 291 | PatersonSize -- Head has the given PatersonSize
|
| 292 | 292 | |
| 293 | 293 | | MethSkol Name Bool -- Bound by the type of class method op
|
| 294 | - -- True <=> it's a default method
|
|
| 295 | - -- False <=> it's a user-written method
|
|
| 294 | + -- True <=> it's a vanilla default method
|
|
| 295 | + -- False <=> it's a user-written, or generic-default, method
|
|
| 296 | + -- See (TRC5) in Note [Tracking redundant constraints]
|
|
| 297 | + -- in GHC.Tc.Solver.Solve
|
|
| 296 | 298 | |
| 297 | 299 | | FamInstSkol -- Bound at a family instance decl
|
| 300 | + |
|
| 298 | 301 | | PatSkol -- An existential type variable bound by a pattern for
|
| 299 | 302 | ConLike -- a data constructor with an existential type.
|
| 300 | 303 | HsMatchContextRn
|
| 1 | +{-# OPTIONS_GHC -Wredundant-constraints #-}
|
|
| 2 | + |
|
| 3 | +module T25992 where
|
|
| 4 | + |
|
| 5 | +import Control.DeepSeq
|
|
| 6 | +import GHC.Generics (Generic)
|
|
| 7 | + |
|
| 8 | +data Foo a = Foo a
|
|
| 9 | + deriving (Generic)
|
|
| 10 | + |
|
| 11 | +instance NFData a => NFData (Foo a)
|
|
| 12 | + |
| ... | ... | @@ -944,3 +944,4 @@ test('T26020a', [extra_files(['T26020a_help.hs'])], multimod_compile, ['T26020a' |
| 944 | 944 | test('T25992', normal, compile, [''])
|
| 945 | 945 | test('T14010', normal, compile, [''])
|
| 946 | 946 | test('T26256a', normal, compile, [''])
|
| 947 | +test('T25992a', normal, compile, ['']) |