diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Types.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Env.hs | 19 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 4 |
3 files changed, 17 insertions, 11 deletions
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs index 94d454055e..40cdf54d12 100644 --- a/compiler/GHC/Tc/Types.hs +++ b/compiler/GHC/Tc/Types.hs @@ -579,7 +579,10 @@ data TcGblEnv tcg_complete_matches :: !CompleteMatches, -- ^ Tracking indices for cost centre annotations - tcg_cc_st :: TcRef CostCentreState + tcg_cc_st :: TcRef CostCentreState, + + tcg_next_wrapper_num :: TcRef (ModuleEnv Int) + -- ^ See Note [Generating fresh names for FFI wrappers] } -- NB: topModIdentity, not topModSemantic! diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs index 7ffd2f2f2c..cf0f1b706b 100644 --- a/compiler/GHC/Tc/Utils/Env.hs +++ b/compiler/GHC/Tc/Utils/Env.hs @@ -1086,7 +1086,8 @@ mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM mkStableIdFromString str sig_ty loc occ_wrapper = do uniq <- newUnique mod <- getModule - name <- mkWrapperName "stable" str + nextWrapperNum <- tcg_next_wrapper_num <$> getGblEnv + name <- mkWrapperName nextWrapperNum "stable" str let occ = mkVarOccFS name :: OccName gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name id = mkExportedVanillaId gnm sig_ty :: Id @@ -1095,14 +1096,14 @@ mkStableIdFromString str sig_ty loc occ_wrapper = do mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId mkStableIdFromName nm = mkStableIdFromString (getOccString nm) -mkWrapperName :: (MonadIO m, HasDynFlags m, HasModule m) - => String -> String -> m FastString -mkWrapperName what nameBase - = do dflags <- getDynFlags - thisMod <- getModule - let -- Note [Generating fresh names for ccall wrapper] - wrapperRef = nextWrapperNum dflags - pkg = unitString (moduleUnit thisMod) +mkWrapperName :: (MonadIO m, HasModule m) + => IORef (ModuleEnv Int) -> String -> String -> m FastString +-- ^ @mkWrapperName ref what nameBase@ +-- +-- See Note [Generating fresh names for ccall wrapper] for @ref@'s purpose. +mkWrapperName wrapperRef what nameBase + = do thisMod <- getModule + let pkg = unitString (moduleUnit thisMod) mod = moduleNameString (moduleName thisMod) wrapperNum <- liftIO $ atomicModifyIORef' wrapperRef $ \mod_env -> let num = lookupWithDefaultModuleEnv mod_env 0 thisMod diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index fb613c8f8d..5568e34b75 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -260,6 +260,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this th_state_var <- newIORef Map.empty ; th_remote_state_var <- newIORef Nothing ; th_docs_var <- newIORef Map.empty ; + next_wrapper_num <- newIORef emptyModuleEnv ; let { -- bangs to avoid leaking the env (#19356) !dflags = hsc_dflags hsc_env ; @@ -347,7 +348,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this tcg_top_loc = loc, tcg_static_wc = static_wc_var, tcg_complete_matches = [], - tcg_cc_st = cc_st_var + tcg_cc_st = cc_st_var, + tcg_next_wrapper_num = next_wrapper_num } ; } ; |