Minor refactorwip/misc-cleanup5

* Introduce refactorDupsOn f = refactorDups (comparing f)
* Make mkBigTupleCase and coreCaseTuple monadic.
  Every call to those functions was preceded by calling newUniqueSupply.
* Use mkUserLocalOrCoVar, which is equivalent to combining
  mkLocalIdOrCoVar with mkInternalName.

17 files changed, 52 insertions, 65 deletions

diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 45561d784c..2f7ab56b5b 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -96,7 +96,6 @@ import Data.Foldable      ( for_, toList )
 import Data.List.NonEmpty ( NonEmpty(..), groupWith )
 import Data.List          ( partition )
 import Data.Maybe
-import Data.Ord           ( comparing )
 import GHC.Data.Pair
 import GHC.Base (oneShot)
 import GHC.Data.Unboxed
@@ -478,7 +477,7 @@ lintCoreBindings' cfg binds
     --    M.n{r3}  = ...
     --    M.n{r29} = ...
     -- because they both get the same linker symbol
-    ext_dups = snd $ removeDups (comparing ord_ext) $
+    ext_dups = snd $ removeDupsOn ord_ext $
                filter isExternalName $ map Var.varName binders
     ord_ext n = (nameModule n, nameOccName n)
 
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index abd28baa47..c11f84d9ba 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -648,12 +648,12 @@ mkSmallTupleSelector1 vars the_var scrut_var scrut
 -- To avoid shadowing, we use uniques to invent new variables.
 --
 -- If necessary we pattern match on a "big" tuple.
-mkBigTupleCase :: UniqSupply       -- ^ For inventing names of intermediate variables
-               -> [Id]             -- ^ The tuple identifiers to pattern match on;
+mkBigTupleCase :: MonadUnique m    --   For inventing names of intermediate variables
+               => [Id]             -- ^ The tuple identifiers to pattern match on;
                                    --   Bring these into scope in the body
                -> CoreExpr         -- ^ Body of the case
                -> CoreExpr         -- ^ Scrutinee
-               -> CoreExpr
+               -> m CoreExpr
 -- ToDo: eliminate cases where none of the variables are needed.
 --
 --         mkBigTupleCase uniqs [a,b,c,d] body v e
@@ -661,11 +661,11 @@ mkBigTupleCase :: UniqSupply       -- ^ For inventing names of intermediate vari
 --             case p of p { (a,b) ->
 --             case q of q { (c,d) ->
 --             body }}}
-mkBigTupleCase us vars body scrut
-  = mk_tuple_case wrapped_us (chunkify wrapped_vars) wrapped_body
+mkBigTupleCase vars body scrut
+  = do us <- getUniqueSupplyM
+       let (wrapped_us, wrapped_vars, wrapped_body) = foldr unwrap (us,[],body) vars
+       return $ mk_tuple_case wrapped_us (chunkify wrapped_vars) wrapped_body
   where
-    (wrapped_us, wrapped_vars, wrapped_body) = foldr unwrap (us,[],body) vars
-
     scrut_ty = exprType scrut
 
     unwrap var (us,vars,body)
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 35023c6576..ff3357e87b 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -2090,9 +2090,8 @@ dataConInstPat fss uniqs mult con inst_tys
     arg_ids = zipWith4 mk_id_var id_uniqs id_fss arg_tys arg_strs
     mk_id_var uniq fs (Scaled m ty) str
       = setCaseBndrEvald str $  -- See Note [Mark evaluated arguments]
-        mkLocalIdOrCoVar name (mult `mkMultMul` m) (Type.substTy full_subst ty)
-      where
-        name = mkInternalName uniq (mkVarOccFS fs) noSrcSpan
+        mkUserLocalOrCoVar (mkVarOccFS fs) uniq
+                           (mult `mkMultMul` m) (Type.substTy full_subst ty) noSrcSpan
 
 {-
 Note [Mark evaluated arguments]
diff --git a/compiler/GHC/Data/List/SetOps.hs b/compiler/GHC/Data/List/SetOps.hs
index 99bf2fe903..5aff54c949 100644
--- a/compiler/GHC/Data/List/SetOps.hs
+++ b/compiler/GHC/Data/List/SetOps.hs
@@ -18,7 +18,7 @@ module GHC.Data.List.SetOps (
         Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing,
 
         -- Duplicate handling
-        hasNoDups, removeDups, nubOrdBy, findDupsEq,
+        hasNoDups, removeDups, removeDupsOn, nubOrdBy, findDupsEq,
         equivClasses,
 
         -- Indexing
@@ -37,6 +37,7 @@ import GHC.Utils.Misc
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
 import Data.List.NonEmpty (NonEmpty(..))
+import Data.Ord (comparing)
 import qualified Data.Set as S
 
 getNth :: Outputable a => [a] -> Int -> a
@@ -193,6 +194,9 @@ removeDups cmp xs
     collect_dups dups_so_far (x :| [])     = (dups_so_far,      x)
     collect_dups dups_so_far dups@(x :| _) = (dups:dups_so_far, x)
 
+removeDupsOn :: Ord b => (a -> b) -> [a] -> ([a], [NonEmpty a])
+removeDupsOn f x = removeDups (comparing f) x
+
 -- | Remove the duplicates from a list using the provided
 -- comparison function.
 nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a]
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 3a6b964aa8..3013524a2d 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -158,9 +158,9 @@ because the list of variables is typically not yet defined.
 --      = case v of v { (x1, .., xn) -> body }
 -- But the matching may be nested if the tuple is very big
 
-coreCaseTuple :: UniqSupply -> Id -> [Id] -> CoreExpr -> CoreExpr
-coreCaseTuple uniqs scrut_var vars body
-  = mkBigTupleCase uniqs vars body (Var scrut_var)
+coreCaseTuple :: Id -> [Id] -> CoreExpr -> DsM CoreExpr
+coreCaseTuple scrut_var vars body
+  = mkBigTupleCase vars body (Var scrut_var)
 
 coreCasePair :: Id -> Id -> Id -> CoreExpr -> CoreExpr
 coreCasePair scrut_var var1 var2 body
@@ -231,9 +231,8 @@ matchEnvStack   :: [Id]         -- x1..xn
                 -> CoreExpr     -- e
                 -> DsM CoreExpr
 matchEnvStack env_ids stack_id body = do
-    uniqs <- newUniqueSupply
     tup_var <- newSysLocalDs ManyTy (mkBigCoreVarTupTy env_ids)
-    let match_env = coreCaseTuple uniqs tup_var env_ids body
+    match_env <- coreCaseTuple tup_var env_ids body
     pair_id <- newSysLocalDs ManyTy (mkCorePairTy (idType tup_var) (idType stack_id))
     return (Lam pair_id (coreCasePair pair_id tup_var stack_id match_env))
 
@@ -250,9 +249,9 @@ matchEnv :: [Id]        -- x1..xn
          -> CoreExpr    -- e
          -> DsM CoreExpr
 matchEnv env_ids body = do
-    uniqs <- newUniqueSupply
     tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy env_ids)
-    return (Lam tup_id (coreCaseTuple uniqs tup_id env_ids body))
+    tup_case <- coreCaseTuple tup_id env_ids body
+    return (Lam tup_id tup_case)
 
 ----------------------------------------------
 --              matchVarStack
@@ -957,11 +956,10 @@ dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd) env_ids = do
     --          \ (p, (xs2)) -> (zs)
 
     env_id <- newSysLocalDs ManyTy env_ty2
-    uniqs <- newUniqueSupply
     let
        after_c_ty = mkCorePairTy pat_ty env_ty2
        out_ty = mkBigCoreVarTupTy out_ids
-       body_expr = coreCaseTuple uniqs env_id env_ids2 (mkBigCoreVarTup out_ids)
+    body_expr <- coreCaseTuple env_id env_ids2 (mkBigCoreVarTup out_ids)
 
     fail_expr <- mkFailExpr (StmtCtxt (HsDoStmt (DoExpr Nothing))) out_ty
     pat_id    <- selectSimpleMatchVarL ManyTy pat
@@ -1029,12 +1027,11 @@ dsCmdStmt ids local_vars out_ids
 
     -- post_loop_fn = \((later_ids),(env2_ids)) -> (out_ids)
 
-    uniqs <- newUniqueSupply
     env2_id <- newSysLocalDs ManyTy env2_ty
     let
         later_ty = mkBigCoreVarTupTy later_ids
         post_pair_ty = mkCorePairTy later_ty env2_ty
-        post_loop_body = coreCaseTuple uniqs env2_id env2_ids (mkBigCoreVarTup out_ids)
+    post_loop_body <- coreCaseTuple env2_id env2_ids (mkBigCoreVarTup out_ids)
 
     post_loop_fn <- matchEnvStack later_ids env2_id post_loop_body
 
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index ca89c468ed..d338d331db 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -444,15 +444,13 @@ mkUnzipBind _ elt_tys
 
        ; unzip_fn <- newSysLocalDs ManyTy unzip_fn_ty
 
-       ; [us1, us2] <- sequence [newUniqueSupply, newUniqueSupply]
-
        ; let nil_tuple = mkBigCoreTup (map mkNilExpr elt_tys)
              concat_expressions = map mkConcatExpression (zip3 elt_tys (map Var xs) (map Var xss))
              tupled_concat_expression = mkBigCoreTup concat_expressions
 
-             folder_body_inner_case = mkBigTupleCase us1 xss tupled_concat_expression (Var axs)
-             folder_body_outer_case = mkBigTupleCase us2 xs folder_body_inner_case (Var ax)
-             folder_body = mkLams [ax, axs] folder_body_outer_case
+       ; folder_body_inner_case <- mkBigTupleCase xss tupled_concat_expression (Var axs)
+       ; folder_body_outer_case <- mkBigTupleCase xs folder_body_inner_case (Var ax)
+       ; let folder_body = mkLams [ax, axs] folder_body_outer_case
 
        ; unzip_body <- mkFoldrExpr elt_tuple_ty elt_list_tuple_ty folder_body nil_tuple (Var ys)
        ; return (Just (unzip_fn, mkLams [ys] unzip_body)) }
@@ -546,9 +544,8 @@ dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs
        ; body        <- dsMcStmts stmts_rest
        ; n_tup_var'  <- newSysLocalDs ManyTy n_tup_ty'
        ; tup_n_expr' <- mkMcUnzipM form fmap_op n_tup_var' from_bndr_tys
-       ; us          <- newUniqueSupply
        ; let rhs'  = mkApps usingExpr' usingArgs'
-             body' = mkBigTupleCase us to_bndrs body tup_n_expr'
+       ; body'       <- mkBigTupleCase to_bndrs body tup_n_expr'
 
        ; dsSyntaxExpr bind_op [rhs', Lam n_tup_var' body'] }
 
@@ -592,9 +589,9 @@ matchTuple :: [Id] -> CoreExpr -> DsM CoreExpr
 --       returns the Core term
 --  \x. case x of (a,b,c) -> body
 matchTuple ids body
-  = do { us <- newUniqueSupply
-       ; tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy ids)
-       ; return (Lam tup_id $ mkBigTupleCase us ids body (Var tup_id)) }
+  = do { tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy ids)
+       ; tup_case <- mkBigTupleCase ids body (Var tup_id)
+       ; return (Lam tup_id tup_case) }
 
 -- general `rhs' >>= \pat -> stmts` desugaring where `rhs'` is already a
 -- desugared `CoreExpr`
diff --git a/compiler/GHC/HsToCore/Pmc/Solver.hs b/compiler/GHC/HsToCore/Pmc/Solver.hs
index cfc98273e3..30b55388dd 100644
--- a/compiler/GHC/HsToCore/Pmc/Solver.hs
+++ b/compiler/GHC/HsToCore/Pmc/Solver.hs
@@ -640,8 +640,7 @@ nameTyCt :: PredType -> DsM EvVar
 nameTyCt pred_ty = do
   unique <- getUniqueM
   let occname = mkVarOccFS (fsLit ("pm_"++show unique))
-      idname  = mkInternalName unique occname noSrcSpan
-  return (mkLocalIdOrCoVar idname ManyTy pred_ty)
+  return (mkUserLocalOrCoVar occname unique ManyTy pred_ty noSrcSpan)
 
 -----------------------------
 -- ** Adding term constraints
diff --git a/compiler/GHC/HsToCore/Pmc/Utils.hs b/compiler/GHC/HsToCore/Pmc/Utils.hs
index a2a73067a9..771f51916d 100644
--- a/compiler/GHC/HsToCore/Pmc/Utils.hs
+++ b/compiler/GHC/HsToCore/Pmc/Utils.hs
@@ -51,8 +51,7 @@ traceWhenFailPm herald doc act = MaybeT $ do
 mkPmId :: Type -> DsM Id
 mkPmId ty = getUniqueM >>= \unique ->
   let occname = mkVarOccFS $ fsLit "pm"
-      name    = mkInternalName unique occname noSrcSpan
-  in  return (mkLocalIdOrCoVar name ManyTy ty)
+  in  return (mkUserLocalOrCoVar occname unique ManyTy ty noSrcSpan)
 {-# NOINLINE mkPmId #-} -- We'll CPR deeply, that should be enough
 
 -- | All warning flags that need to run the pattern match checker.
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index eeef41ecc1..a67fdfe334 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -262,9 +262,9 @@ newIfaceName occ
 
 newIfaceNames :: [OccName] -> IfL [Name]
 newIfaceNames occs
-  = do  { uniqs <- newUniqueSupply
+  = do  { uniqs <- getUniquesM
         ; return [ mkInternalName uniq occ noSrcSpan
-                 | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
+                 | (occ,uniq) <- occs `zip` uniqs] }
 
 trace_if :: Logger -> SDoc -> IO ()
 {-# INLINE trace_if #-}
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index 7138c0433e..4a4c2a6cee 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1674,8 +1674,7 @@ tcIfaceAlt scrut mult (tycon, inst_tys) (IfaceAlt (IfaceDataAlt data_occ) arg_st
 tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [FastString] -> IfaceExpr
                -> IfL CoreAlt
 tcIfaceDataAlt mult con inst_tys arg_strs rhs
-  = do  { us <- newUniqueSupply
-        ; let uniqs = uniqsFromSupply us
+  = do  { uniqs <- getUniquesM
         ; let (ex_tvs, arg_ids)
                       = dataConRepFSInstPat arg_strs uniqs mult con inst_tys
 
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 24462a21bc..47e6217f56 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -64,7 +64,7 @@ import GHC.Types.Name.Reader
 import GHC.Types.Unique.Set
 import GHC.Types.SourceText
 import GHC.Utils.Misc
-import GHC.Data.List.SetOps ( removeDups )
+import GHC.Data.List.SetOps ( removeDupsOn )
 import GHC.Utils.Error
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
@@ -1305,7 +1305,7 @@ rnParallelStmts ctxt return_op segs thing_inside
             -> [Name] -> [ParStmtBlock GhcPs GhcPs]
             -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
     rn_segs _ bndrs_so_far []
-      = do { let (bndrs', dups) = removeDups cmpByOcc bndrs_so_far
+      = do { let (bndrs', dups) = removeDupsOn nameOccName bndrs_so_far
            ; mapM_ dupErr dups
            ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs')
            ; return (([], thing), fvs) }
@@ -1321,7 +1321,6 @@ rnParallelStmts ctxt return_op segs thing_inside
            ; let seg' = ParStmtBlock x stmts' used_bndrs return_op
            ; return ((seg':segs', thing), fvs) }
 
-    cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
     dupErr vs = addErr $ TcRnListComprehensionDuplicateBinding (NE.head vs)
 
 lookupQualifiedDoStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 597d6acc27..7bb5b56afc 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -62,7 +62,7 @@ import GHC.Driver.Session
 import GHC.Utils.Misc   ( lengthExceeds, partitionWith )
 import GHC.Utils.Panic
 import GHC.Driver.Env ( HscEnv(..), hsc_home_unit)
-import GHC.Data.List.SetOps ( findDupsEq, removeDups, equivClasses )
+import GHC.Data.List.SetOps ( findDupsEq, removeDupsOn, equivClasses )
 import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..)
                                , stronglyConnCompFromEdgedVerticesUniq )
 import GHC.Types.Unique.Set
@@ -1604,7 +1604,7 @@ rnStandaloneKindSignatures
   -> [LStandaloneKindSig GhcPs]
   -> RnM [(LStandaloneKindSig GhcRn, FreeVars)]
 rnStandaloneKindSignatures tc_names kisigs
-  = do { let (no_dups, dup_kisigs) = removeDups (compare `on` get_name) kisigs
+  = do { let (no_dups, dup_kisigs) = removeDupsOn get_name kisigs
              get_name = standaloneKindSigName . unLoc
        ; mapM_ dupKindSig_Err dup_kisigs
        ; mapM (wrapLocFstMA (rnStandaloneKindSignature tc_names)) no_dups
@@ -1682,7 +1682,7 @@ rnRoleAnnots :: NameSet
 rnRoleAnnots tc_names role_annots
   = do {  -- Check for duplicates *before* renaming, to avoid
           -- lumping together all the unboundNames
-         let (no_dups, dup_annots) = removeDups (compare `on` get_name) role_annots
+         let (no_dups, dup_annots) = removeDupsOn get_name role_annots
              get_name = roleAnnotDeclName . unLoc
        ; mapM_ dupRoleAnnotErr dup_annots
        ; mapM (wrapLocMA rn_role_annot1) no_dups }
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 25c91eb62c..f0f5b426b7 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -57,7 +57,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Misc
 import GHC.Types.Basic  ( TopLevelFlag(..), Origin(Generated) )
-import GHC.Data.List.SetOps ( removeDups )
+import GHC.Data.List.SetOps ( removeDupsOn )
 import GHC.Data.Maybe ( whenIsJust )
 import GHC.Driver.Session
 import GHC.Data.FastString
@@ -114,14 +114,14 @@ checkDupRdrNames :: [LocatedN RdrName] -> RnM ()
 checkDupRdrNames rdr_names_w_loc
   = mapM_ (dupNamesErr getLocA) dups
   where
-    (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
+    (_, dups) = removeDupsOn unLoc rdr_names_w_loc
 
 checkDupRdrNamesN :: [LocatedN RdrName] -> RnM ()
 -- Check for duplicated names in a binding group
 checkDupRdrNamesN rdr_names_w_loc
   = mapM_ (dupNamesErr getLocA) dups
   where
-    (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
+    (_, dups) = removeDupsOn unLoc rdr_names_w_loc
 
 checkDupNames :: [Name] -> RnM ()
 -- Check for duplicated names in a binding group
@@ -132,7 +132,7 @@ check_dup_names :: [Name] -> RnM ()
 check_dup_names names
   = mapM_ (dupNamesErr nameSrcSpan) dups
   where
-    (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names
+    (_, dups) = removeDupsOn nameOccName names
 
 ---------------------
 checkShadowedRdrNames :: [LocatedN RdrName] -> RnM ()
diff --git a/compiler/GHC/Stg/Lift/Monad.hs b/compiler/GHC/Stg/Lift/Monad.hs
index 0003150e19..930c3963b2 100644
--- a/compiler/GHC/Stg/Lift/Monad.hs
+++ b/compiler/GHC/Stg/Lift/Monad.hs
@@ -275,15 +275,13 @@ withSubstBndrs = runContT . traverse (ContT . withSubstBndr)
 -- binder and fresh name generation.
 withLiftedBndr :: DIdSet -> Id -> (Id -> LiftM a) -> LiftM a
 withLiftedBndr abs_ids bndr inner = do
-  uniq <- getUniqueM
   let str = fsLit "$l" `appendFS` occNameFS (getOccName bndr)
   let ty = mkLamTypes (dVarSetElems abs_ids) (idType bndr)
-  let bndr'
+  bndr' <-
         -- See Note [transferPolyIdInfo] in GHC.Types.Id. We need to do this at least
         -- for arity information.
-        = transferPolyIdInfo bndr (dVarSetElems abs_ids)
-        . mkSysLocal str uniq ManyTy
-        $ ty
+            transferPolyIdInfo bndr (dVarSetElems abs_ids)
+        <$> mkSysLocalM str ManyTy ty
   LiftM $ RWS.local
     (\e -> e
       { e_subst = extendSubst bndr bndr' $ extendInScope bndr' $ e_subst e
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index bf15393048..222755f6c9 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -3692,14 +3692,13 @@ splitTyConKind :: SkolemInfo
 -- See also Note [Datatype return kinds] in GHC.Tc.TyCl
 splitTyConKind skol_info in_scope avoid_occs kind
   = do  { loc     <- getSrcSpanM
-        ; uniqs   <- newUniqueSupply
+        ; new_uniqs <- getUniquesM
         ; rdr_env <- getLocalRdrEnv
         ; lvl     <- getTcLevel
         ; let new_occs = Inf.filter (\ occ ->
                   isNothing (lookupLocalRdrOcc rdr_env occ) &&
                   -- Note [Avoid name clashes for associated data types]
                   not (occ `elem` avoid_occs)) $ mkOccName tvName <$> allNameStrings
-              new_uniqs = uniqsFromSupply uniqs
               subst = mkEmptySubst in_scope
               details = SkolemTv skol_info (pushTcLevel lvl) False
                         -- As always, allocate skolems one level in
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index afc7633ff2..ecd3ab3249 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -729,9 +729,9 @@ newSysLocalId fs w ty
 
 newSysLocalIds :: FastString -> [Scaled TcType] -> TcRnIf gbl lcl [TcId]
 newSysLocalIds fs tys
-  = do  { us <- newUniqueSupply
+  = do  { us <- getUniquesM
         ; let mkId' n (Scaled w t) = mkSysLocal fs n w t
-        ; return (zipWith mkId' (uniqsFromSupply us) tys) }
+        ; return (zipWith mkId' us tys) }
 
 instance MonadUnique (IOEnv (Env gbl lcl)) where
         getUniqueM = newUnique
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index 89614378cd..d0afe71560 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -770,13 +770,11 @@ newMetaTyVarName :: FastString -> TcM Name
 -- the unifier; see GHC.Tc.Utils.Unify.nicer_to_update_tv1, and
 -- GHC.Tc.Solver.Canonical.canEqTyVarTyVar (nicer_to_update_tv2)
 newMetaTyVarName str
-  = do { uniq <- newUnique
-       ; return (mkSystemName uniq (mkTyVarOccFS str)) }
+  = newSysName (mkTyVarOccFS str)
 
 cloneMetaTyVarName :: Name -> TcM Name
 cloneMetaTyVarName name
-  = do { uniq <- newUnique
-       ; return (mkSystemName uniq (nameOccName name)) }
+  = newSysName (nameOccName name)
          -- See Note [Name of an instantiated type variable]
 
 {- Note [Name of an instantiated type variable]