[Git][ghc/ghc][wip/restore-lcl-env] Use setSrcSpan rather than setLclEnv in solveForAll

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/restore-lcl-env at Glasgow Haskell Compiler / GHC


Commits:
20edcfca by Matthew Pickering at 2023-05-16T15:10:22+01: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/20edcfcadd07b59d07e192714e47b8288e60c299

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20edcfcadd07b59d07e192714e47b8288e60c299
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/ceb447fa/attachment-0001.html>