Simon Peyton Jones pushed to branch wip/T25992 at Glasgow Haskell Compiler / GHC Commits: 8e5f3bd4 by Simon Peyton Jones at 2025-05-23T09:40:33+01:00 Further wibbles - - - - - 4 changed files: - compiler/GHC/Tc/Solver/Default.hs - + testsuite/tests/typecheck/should_compile/T25992.hs - + testsuite/tests/typecheck/should_compile/T25992.stderr - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Default.hs ===================================== @@ -247,11 +247,11 @@ tryUnsatisfiableGivens wc = ; solveAgainIf did_work final_wc } where go_wc (WC { wc_simple = wtds, wc_impl = impls, wc_errors = errs }) - = do impls' <- mapMaybeBagM go_impl impls + = do impls' <- mapBagM go_impl impls return $ WC { wc_simple = wtds, wc_impl = impls', wc_errors = errs } go_impl impl | isSolvedStatus (ic_status impl) - = return $ Just impl + = return impl -- Is there a Given with type "Unsatisfiable msg"? -- If so, use it to solve all other Wanteds. | unsat_given:_ <- mapMaybe unsatisfiableEv_maybe (ic_given impl) @@ -271,7 +271,7 @@ unsatisfiableEv_maybe v = (v,) <$> isUnsatisfiableCt_maybe (idType v) -- | We have an implication with an 'Unsatisfiable' Given; use that Given to -- solve all the other Wanted constraints, including those nested within -- deeper implications. -solveImplicationUsingUnsatGiven :: (EvVar, Type) -> Implication -> TcS (Maybe Implication) +solveImplicationUsingUnsatGiven :: (EvVar, Type) -> Implication -> TcS Implication solveImplicationUsingUnsatGiven unsat_given@(given_ev,_) impl@(Implic { ic_wanted = wtd, ic_tclvl = tclvl, ic_binds = ev_binds_var @@ -279,7 +279,7 @@ solveImplicationUsingUnsatGiven | isCoEvBindsVar ev_binds_var -- We can't use Unsatisfiable evidence in kinds. -- See Note [Coercion evidence only] in GHC.Tc.Types.Evidence. - = return $ Just impl + = return impl | otherwise = do { wcs <- nestImplicTcS ev_binds_var tclvl $ go_wc wtd ; setImplicationStatus $ @@ -290,7 +290,7 @@ solveImplicationUsingUnsatGiven go_wc :: WantedConstraints -> TcS WantedConstraints go_wc wc@(WC { wc_simple = wtds, wc_impl = impls }) = do { mapBagM_ go_simple wtds - ; impls <- mapMaybeBagM (solveImplicationUsingUnsatGiven unsat_given) impls + ; impls <- mapBagM (solveImplicationUsingUnsatGiven unsat_given) impls ; return $ wc { wc_simple = emptyBag, wc_impl = impls } } go_simple :: Ct -> TcS () go_simple ct = case ctEvidence ct of ===================================== testsuite/tests/typecheck/should_compile/T25992.hs ===================================== @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -Wredundant-constraints #-} + +module T25992 where + +data P a = P + +instance Eq a => Semigroup (P a) where + P <> P = P ===================================== testsuite/tests/typecheck/should_compile/T25992.stderr ===================================== @@ -0,0 +1,3 @@ + T25992.hs:7:10: error: [GHC-30606] [-Wredundant-constraints, Werror=redundant-constraints] + • Redundant constraint: Eq a + • In the instance declaration for ‘Semigroup (P a)’ ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -941,3 +941,4 @@ test('T25597', normal, compile, ['']) test('T25960', normal, compile, ['']) test('T26020', normal, compile, ['']) test('T26020a', [extra_files(['T26020a_help.hs'])], multimod_compile, ['T26020a', '-v0']) +test('T25992', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e5f3bd4c27578ad355bbdeeaf1283a9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e5f3bd4c27578ad355bbdeeaf1283a9... You're receiving this email because of your account on gitlab.haskell.org.