[Git][ghc/ghc][master] Use setSrcSpan rather than setLclEnv in solveForAll

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00
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

- - - - -


2 changed files:

- compiler/GHC/Tc/Solver/Canonical.hs
- compiler/GHC/Tc/Solver/Monad.hs


Changes:

=====================================
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 $


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5fe1d3e662e7b0ce8c2da31514d553a7f50ef179

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5fe1d3e662e7b0ce8c2da31514d553a7f50ef179
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230517/abc700f1/attachment-0001.html>