From 5fe1d3e662e7b0ce8c2da31514d553a7f50ef179 Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Mon, 15 May 2023 11:35:00 +0100
Subject: 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
---
 compiler/GHC/Tc/Solver/Canonical.hs | 5 +++--
 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
-- 
cgit v1.2.1