diff options
| author | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2022-01-26 11:42:36 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2022-01-26 18:09:39 +0000 |
| commit | d3cb316636413dfc48480b950bd9a5437746edae (patch) | |
| tree | dc8d4d1fb99ac2348dd55935951b5d0147bdc8b5 /compiler/GHC/Tc/Solver | |
| parent | 011990f5f515e741b1643d6b5988c0ba77cc22ad (diff) | |
| download | haskell-wip/T21006.tar.gz | |
Set the TcLclEnv when solving a ForAll constraintwip/T21006
Fix a simple omission in GHC.Tc.Solver.Canonical.solveForAll,
where we ended up with the wrong TcLclEnv captured in an implication.
Result: unhelpful error message (#21006)
Diffstat (limited to 'compiler/GHC/Tc/Solver')
| -rw-r--r-- | compiler/GHC/Tc/Solver/Canonical.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Solver/Monad.hs | 8 |
2 files changed, 11 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs index e07f2a4633..db1c3c1652 100644 --- a/compiler/GHC/Tc/Solver/Canonical.hs +++ b/compiler/GHC/Tc/Solver/Canonical.hs @@ -871,6 +871,10 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool solveForAll ev tvs theta pred pend_sc | CtWanted { ctev_dest = dest } <- ev = -- See Note [Solving a Wanted forall-constraint] + setLclEnv (ctLocEnv loc) $ + -- This setLclEnv is important: the emitImplicationTcS uses that + -- TcLclEnv for the implication, and that in turn sets the location + -- for the Givens when solving the constraint (#21006) do { let skol_info = QuantCtxtSkol empty_subst = mkEmptyTCvSubst $ mkInScopeSet $ tyCoVarsOfTypes (pred:theta) `delVarSetList` tvs diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs index a53074fab1..25bde37642 100644 --- a/compiler/GHC/Tc/Solver/Monad.hs +++ b/compiler/GHC/Tc/Solver/Monad.hs @@ -52,7 +52,7 @@ module GHC.Tc.Solver.Monad ( getSolvedDicts, setSolvedDicts, getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, + getTopEnv, getGblEnv, getLclEnv, setLclEnv, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, tcLookupClass, tcLookupId, @@ -1247,6 +1247,9 @@ wrapTcS :: TcM a -> TcS a -- and TcS is supposed to have limited functionality wrapTcS action = mkTcS $ \_env -> action -- a TcM action will not use the TcEvBinds +wrap2TcS :: (TcM a -> TcM a) -> TcS a -> TcS a +wrap2TcS fn (TcS thing) = mkTcS $ \env -> fn (thing env) + wrapErrTcS :: TcM a -> TcS a -- The thing wrapped should just fail -- There's no static check; it's up to the user @@ -1780,6 +1783,9 @@ getGblEnv = wrapTcS $ TcM.getGblEnv getLclEnv :: TcS TcLclEnv getLclEnv = wrapTcS $ TcM.getLclEnv +setLclEnv :: TcLclEnv -> TcS a -> TcS a +setLclEnv env = wrap2TcS (TcM.setLclEnv env) + tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c |