diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2023-05-15 11:35:00 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-05-17 21:42:00 -0400 |
| commit | 5fe1d3e662e7b0ce8c2da31514d553a7f50ef179 (patch) | |
| tree | 18459b8311fc80c02f38970ae19aa4be27e4ff1b | |
| parent | 2972fd66f91cb51426a1df86b8166a067015e231 (diff) | |
| download | haskell-5fe1d3e662e7b0ce8c2da31514d553a7f50ef179.tar.gz | |
Use setSrcSpan rather than setLclEnv in solveForAll
In subsequent MRs (#23409) we want to remove the TcLclEnv argument from
a CtLoc. This MR prepares us for that by removing the one place where
the entire TcLclEnv is used, by using it more precisely to just set the
contexts source location.
Fixes #23390
| -rw-r--r-- | compiler/GHC/Tc/Solver/Canonical.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Solver/Monad.hs | 7 |
2 files changed, 7 insertions, 5 deletions
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs index 49210cefa8..b775e12d1a 100644 --- a/compiler/GHC/Tc/Solver/Canonical.hs +++ b/compiler/GHC/Tc/Solver/Canonical.hs @@ -53,6 +53,7 @@ import GHC.Data.Bag import Data.Maybe ( isJust ) import qualified Data.Semigroup as S +import GHC.Tc.Utils.Monad (getLclEnvLoc) {- ************************************************************************ @@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] - setLclEnv (ctLocEnv loc) $ - -- This setLclEnv is important: the emitImplicationTcS uses that + setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $ + -- This setSrcSpan 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 empty_subst = mkEmptySubst $ mkInScopeSet $ diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs index 91e20becf8..08982a1a32 100644 --- a/compiler/GHC/Tc/Solver/Monad.hs +++ b/compiler/GHC/Tc/Solver/Monad.hs @@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad ( getSolvedDicts, setSolvedDicts, getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, setLclEnv, + getTopEnv, getGblEnv, getLclEnv, setSrcSpan, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, tcLookupClass, tcLookupId, tcLookupTyCon, @@ -194,6 +194,7 @@ import Data.IORef import Data.List ( mapAccumL ) import Data.Foldable import qualified Data.Semigroup as S +import GHC.Types.SrcLoc #if defined(DEBUG) import GHC.Types.Unique.Set (nonDetEltsUniqSet) @@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv getLclEnv :: TcS TcLclEnv getLclEnv = wrapTcS $ TcM.getLclEnv -setLclEnv :: TcLclEnv -> TcS a -> TcS a -setLclEnv env = wrap2TcS (TcM.setLclEnv env) +setSrcSpan :: RealSrcSpan -> TcS a -> TcS a +setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c |