Rename getCtLoc, setCtLoc

getCtLoc -> getCtLocM
setCtLoc -> setCtLocM

These operations are monadic, and I want to introduce a
pure version of setCtLoc :: Ct -> CtLoc -> Ct

6 files changed, 13 insertions, 13 deletions

diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index 07d7e0a3b3..fecb11ac72 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -70,7 +70,7 @@ import Data.Maybe( isJust )
 
 newWanted :: CtOrigin -> PredType -> TcM CtEvidence
 newWanted orig pty
-  = do loc <- getCtLoc orig
+  = do loc <- getCtLocM orig
        v <- newEvVar pty
        return $ CtWanted { ctev_evar = v
                          , ctev_pred = pty
@@ -84,7 +84,7 @@ emitWanteds origin theta = mapM (emitWanted origin) theta
 
 emitWanted :: CtOrigin -> TcPredType -> TcM EvVar
 emitWanted origin pred
-  = do { loc <- getCtLoc origin
+  = do { loc <- getCtLocM origin
        ; ev  <- newEvVar pred
        ; emitSimple $ mkNonCanonical $
          CtWanted { ctev_pred = pred, ctev_evar = ev, ctev_loc = loc }
@@ -403,7 +403,7 @@ tcSyntaxName orig ty (std_nm, user_nm_expr) = do
 syntaxNameCtxt :: HsExpr Name -> CtOrigin -> Type -> TidyEnv
                -> TcRn (TidyEnv, SDoc)
 syntaxNameCtxt name orig ty tidy_env
-  = do { inst_loc <- getCtLoc orig
+  = do { inst_loc <- getCtLocM orig
        ; let msg = vcat [ ptext (sLit "When checking that") <+> quotes (ppr name)
                           <+> ptext (sLit "(needed by a syntactic construct)")
                         , nest 2 (ptext (sLit "has the required type:")
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 36b794750d..946ecdeeb6 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -1688,7 +1688,7 @@ warnDefaulting wanteds default_ty
              warn_msg  = hang (ptext (sLit "Defaulting the following constraint(s) to type")
                                 <+> quotes (ppr default_ty))
                             2 ppr_wanteds
-       ; setCtLoc loc $ warnTc warn_default warn_msg }
+       ; setCtLocM loc $ warnTc warn_default warn_msg }
 
 {-
 Note [Runtime skolems]
@@ -1707,7 +1707,7 @@ are created by in RtClosureInspect.zonkRTTIType.
 
 solverDepthErrorTcS :: CtLoc -> TcType -> TcM a
 solverDepthErrorTcS loc ty
-  = setCtLoc loc $
+  = setCtLocM loc $
     do { ty <- zonkTcType ty
        ; env0 <- tcInitTidyEnv
        ; let tidy_env     = tidyFreeTyVars env0 (tyVarsOfType ty)
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index a9622588a0..7b47fcf5cb 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -131,7 +131,7 @@ tcHole occ res_ty
  = do { ty <- newFlexiTyVarTy liftedTypeKind
       ; name <- newSysName occ
       ; let ev = mkLocalId name ty
-      ; loc <- getCtLoc HoleOrigin
+      ; loc <- getCtLocM HoleOrigin
       ; let can = CHoleCan { cc_ev = CtWanted ty ev loc, cc_occ = occ
                            , cc_hole = ExprHole }
       ; emitInsoluble can
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 3c69b9527b..0e44c4ca78 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -956,16 +956,16 @@ updCtxt upd = updLclEnv (\ env@(TcLclEnv { tcl_ctxt = ctxt }) ->
 popErrCtxt :: TcM a -> TcM a
 popErrCtxt = updCtxt (\ msgs -> case msgs of { [] -> []; (_ : ms) -> ms })
 
-getCtLoc :: CtOrigin -> TcM CtLoc
-getCtLoc origin
+getCtLocM :: CtOrigin -> TcM CtLoc
+getCtLocM origin
   = do { env <- getLclEnv
        ; return (CtLoc { ctl_origin = origin
                        , ctl_env = env
                        , ctl_depth = initialSubGoalDepth }) }
 
-setCtLoc :: CtLoc -> TcM a -> TcM a
+setCtLocM :: CtLoc -> TcM a -> TcM a
 -- Set the SrcSpan and error context from the CtLoc
-setCtLoc (CtLoc { ctl_env = lcl }) thing_inside
+setCtLocM (CtLoc { ctl_env = lcl }) thing_inside
   = updLclEnv (\env -> env { tcl_loc   = tcl_loc lcl
                            , tcl_bndrs = tcl_bndrs lcl
                            , tcl_ctxt  = tcl_ctxt lcl })
@@ -1241,7 +1241,7 @@ traceTcConstraints msg
 
 emitWildcardHoleConstraints :: [(Name, TcTyVar)] -> TcM ()
 emitWildcardHoleConstraints wcs
-  = do { ctLoc <- getCtLoc HoleOrigin
+  = do { ctLoc <- getCtLocM HoleOrigin
        ; forM_ wcs $ \(name, tv) -> do {
        ; let real_span = case nameSrcSpan name of
                            RealSrcSpan span  -> span
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index f78cdc62cb..c131f61e46 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -2468,7 +2468,7 @@ addUsedRdrNamesTcS names = wrapTcS  $ addUsedRdrNames names
 
 checkWellStagedDFun :: PredType -> DFunId -> CtLoc -> TcS ()
 checkWellStagedDFun pred dfun_id loc
-  = wrapTcS $ TcM.setCtLoc loc $
+  = wrapTcS $ TcM.setCtLocM loc $
     do { use_stage <- TcM.getStage
        ; TcM.checkWellStaged pp_thing bind_lvl (thLevel use_stage) }
   where
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index b2f31be688..3f540f5faf 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -667,7 +667,7 @@ uType, uType_defer
 -- See Note [Deferred unification]
 uType_defer origin ty1 ty2
   = do { eqv <- newEq ty1 ty2
-       ; loc <- getCtLoc origin
+       ; loc <- getCtLocM origin
        ; emitSimple $ mkNonCanonical $
              CtWanted { ctev_evar = eqv
                       , ctev_pred = mkTcEqPred ty1 ty2