diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2021-03-05 12:48:57 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-03-14 12:55:45 -0400 |
commit | 1793ca9d43bd5e78eb9e7d6e4212bf6196812786 (patch) | |
tree | 1efe9b16ffcdb9f725585c6086c0aeb86e5f2eae /compiler/GHC/Core | |
parent | cd793767a1f388d10cda69f244479b63536f0a3d (diff) | |
download | haskell-1793ca9d43bd5e78eb9e7d6e4212bf6196812786.tar.gz |
Pmc: Consider Required Constraints when guessing PatSyn arg types (#19475)
This patch makes `guessConLikeUnivTyArgsFromResTy` consider required
Thetas of PatSynCons, by treating them as Wanted constraints to be
discharged with the constraints from the Nabla's TyState and saying
"does not match the match type" if the Wanted constraints are unsoluble.
It calls out into a new function `GHC.Tc.Solver.tcCheckWanteds` to do
so.
In pushing the failure logic around call sites of `initTcDsForSolver`
inside it by panicking, I realised that there was a bunch of dead code
surrounding `pmTopMoraliseType`: I was successfully able to delete the
`NoChange` data constructor of `TopNormaliseTypeResult`.
The details are in `Note [Matching against a ConLike result type]` and
`Note [Instantiating a ConLike].
The regression test is in `T19475`. It's pretty much a fork of `T14422`
at the moment.
Co-authored-by: Cale Gibbard <cgibbard@gmail.com>
Diffstat (limited to 'compiler/GHC/Core')
-rw-r--r-- | compiler/GHC/Core/TyCo/Subst.hs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs index 6394879e8c..39695bbc06 100644 --- a/compiler/GHC/Core/TyCo/Subst.hs +++ b/compiler/GHC/Core/TyCo/Subst.hs @@ -18,7 +18,7 @@ module GHC.Core.TyCo.Subst mkTCvSubst, mkTvSubst, mkCvSubst, getTvSubstEnv, getCvSubstEnv, getTCvInScope, getTCvSubstRangeFVs, - isInScope, notElemTCvSubst, + isInScope, elemTCvSubst, notElemTCvSubst, setTvSubstEnv, setCvSubstEnv, zapTCvSubst, extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubst, extendTCvSubstWithClone, @@ -293,12 +293,15 @@ getTCvSubstRangeFVs (TCvSubst _ tenv cenv) isInScope :: Var -> TCvSubst -> Bool isInScope v (TCvSubst in_scope _ _) = v `elemInScopeSet` in_scope -notElemTCvSubst :: Var -> TCvSubst -> Bool -notElemTCvSubst v (TCvSubst _ tenv cenv) +elemTCvSubst :: Var -> TCvSubst -> Bool +elemTCvSubst v (TCvSubst _ tenv cenv) | isTyVar v - = not (v `elemVarEnv` tenv) + = v `elemVarEnv` tenv | otherwise - = not (v `elemVarEnv` cenv) + = v `elemVarEnv` cenv + +notElemTCvSubst :: Var -> TCvSubst -> Bool +notElemTCvSubst v = not . elemTCvSubst v setTvSubstEnv :: TCvSubst -> TvSubstEnv -> TCvSubst setTvSubstEnv (TCvSubst in_scope _ cenv) tenv = TCvSubst in_scope tenv cenv |