diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 35d4a89a23a1ecbbd9b53a45f755cd9f77e8858c..27d3c524c2d524bcc3a969a9756c32bd203f6941 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -48,6 +48,8 @@ module Module
         pprModule,
         mkModule,
         stableModuleCmp,
+        HasModule(..),
+        ContainsModule(..),
 
         -- * The ModuleLocation type
         ModLocation(..),
@@ -276,6 +278,12 @@ pprPackagePrefix p mod = getPprStyle doc
                 -- the PrintUnqualified tells us which modules have to
                 -- be qualified with package names
        | otherwise = empty
+
+class ContainsModule t where
+    extractModule :: t -> Module
+
+class HasModule m where
+    getModule :: m Module
 \end{code}
 
 %************************************************************************
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index 59124e32e1be9767fbf5bb1b61e3bb57939b6947..daf49eebacd28bea281f67c5cf2f44d89448625e 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -212,11 +212,7 @@ dsFCall fn_id co fcall mDeclHeader = do
     (fcall', cDoc) <-
               case fcall of
               CCall (CCallSpec (StaticTarget cName mPackageId isFun) CApiConv safety) ->
-               do thisMod <- getModuleDs
-                  let pkg = packageIdString  (modulePackageId thisMod)
-                      mod = moduleNameString (moduleName      thisMod)
-                      wrapperNameComponents = [pkg, mod, unpackFS cName]
-                  wrapperName <- mkWrapperName "ghc_wrapper" wrapperNameComponents
+               do wrapperName <- mkWrapperName "ghc_wrapper" (unpackFS cName)
                   let fcall' = CCall (CCallSpec (StaticTarget wrapperName mPackageId True) CApiConv safety)
                       c = includes
                        $$ fun_proto <+> braces (cRet <> semi)
diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs
index 6ed0f64a0610615cf4aa35d65f9ba7b5e103e6c2..5e94d515d79a21e81e2ecfc737e1cd0732481218 100644
--- a/compiler/deSugar/DsMonad.lhs
+++ b/compiler/deSugar/DsMonad.lhs
@@ -167,6 +167,9 @@ data DsGblEnv
         , ds_parr_bi :: PArrBuiltin             -- desugarar names for '-XParallelArrays'
         }
 
+instance ContainsModule DsGblEnv where
+    extractModule = ds_mod
+
 data DsLclEnv = DsLclEnv {
         ds_meta    :: DsMetaEnv,        -- Template Haskell bindings
         ds_loc     :: SrcSpan           -- to put in pattern-matching error msgs
diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index fbbaf658193a5903411be5b22e63ed698d3cb570..717b885e6347a20449bcc906879a99b23ba43116 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -39,6 +39,7 @@ import RnTypes        ( bindSigTyVarsFV, rnHsSigType, rnLHsType, checkPrecMatch
 import RnPat
 import RnEnv
 import DynFlags
+import Module
 import Name
 import NameEnv
 import NameSet
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index f29d64c55c05dabbab71623494f076ee55f75b51..5e466c9a3251c49d9e8fac27ee21aae033faf3eb 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -52,7 +52,7 @@ import Name
 import NameSet
 import NameEnv
 import Avail
-import Module           ( ModuleName, moduleName )
+import Module
 import UniqFM
 import DataCon          ( dataConFieldLabels, dataConTyCon )
 import TyCon            ( isTupleTyCon, tyConArity )
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 038f75440679bf63f08ffa4ae6c35b3ebb9b6753..606549161faabbf232c1e64ba199b5053cebce46 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -40,6 +40,7 @@ import DynFlags
 import BasicTypes	( FixityDirection(..) )
 import PrelNames
 
+import Module
 import Name
 import NameSet
 import RdrName
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index bc1e1e5199c74cbf71ff79ce2ad0711842044bd0..c2c265044c1ba933b8ba6ff73ef7d6081de26a8f 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -72,7 +72,7 @@ import PprCore
 import CoreUtils
 import CoreLint		( lintCoreBindings )
 import HscTypes
-import Module           ( Module )
+import Module
 import DynFlags
 import StaticFlags	
 import Rules            ( RuleBase )
@@ -863,9 +863,6 @@ getHscEnv = read cr_hsc_env
 getRuleBase :: CoreM RuleBase
 getRuleBase = read cr_rule_base
 
-getModule :: CoreM Module
-getModule = read cr_module
-
 addSimplCount :: SimplCount -> CoreM ()
 addSimplCount count = write (CoreWriter { cw_simpl_count = count })
 
@@ -874,6 +871,9 @@ addSimplCount count = write (CoreWriter { cw_simpl_count = count })
 instance HasDynFlags CoreM where
     getDynFlags = fmap hsc_dflags getHscEnv
 
+instance HasModule CoreM where
+    getModule = read cr_module
+
 -- | The original name cache is the current mapping from 'Module' and
 -- 'OccName' to a compiler-wide unique 'Name'
 getOrigNameCache :: CoreM OrigNameCache
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index a63471011f492537481a1aad547a08b809f4d080..f0394c8762240dc917eb1d623f5261c4048db58d 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -32,6 +32,7 @@ import TysPrim
 import Id
 import Var
 import VarSet
+import Module
 import Name
 import NameSet
 import NameEnv
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 175ab9cc080f0e22643627853399d65818bed795..aa396732241d6aa728764726e6f4284ec5d94997 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -756,9 +756,7 @@ mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM
 mkStableIdFromString str sig_ty loc occ_wrapper = do
     uniq <- newUnique
     mod <- getModule
-    name <- mkWrapperName "stable" [packageIdString  (modulePackageId mod),
-                                    moduleNameString (moduleName      mod),
-                                    str]
+    name <- mkWrapperName "stable" str
     let occ = mkVarOccFS name :: OccName
         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
         id  = mkExportedLocalId gnm sig_ty :: Id
@@ -769,15 +767,18 @@ mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
 \end{code}
 
 \begin{code}
-mkWrapperName :: (MonadIO m, HasDynFlags m)
-              => String -> [String] -> m FastString
-mkWrapperName what components
+mkWrapperName :: (MonadIO m, HasDynFlags m, HasModule m)
+              => String -> String -> m FastString
+mkWrapperName what nameBase
     = do dflags <- getDynFlags
+         thisMod <- getModule
          let wrapperRef = nextWrapperNum dflags
+             pkg = packageIdString  (modulePackageId thisMod)
+             mod = moduleNameString (moduleName      thisMod)
          wrapperNum <- liftIO $ readIORef wrapperRef
          liftIO $ writeIORef wrapperRef (wrapperNum + 1)
-         let allComponents = what : show wrapperNum : components
-         return $ mkFastString $ zEncodeString $ intercalate ":" allComponents
+         let components = [what, show wrapperNum, pkg, mod, nameBase]
+         return $ mkFastString $ zEncodeString $ intercalate ":" components
 \end{code}
 
 %************************************************************************
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index ee337c4d51bf99fe812350faac3fe13bd8b91a50..d866893545ceb31f9cb73950bee7990637ebc2f3 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -480,9 +480,6 @@ dumpOptTcRn flag doc = whenDOptM flag (dumpTcRn doc)
 %************************************************************************
 
 \begin{code}
-getModule :: TcRn Module
-getModule = do { env <- getGblEnv; return (tcg_mod env) }
-
 setModule :: Module -> TcRn a -> TcRn a
 setModule mod thing_inside = updGblEnv (\env -> env { tcg_mod = mod }) thing_inside
 
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 967c327fd648f19662962de7283d2e29c6b436ed..e6d2013ff2f47dabe44e1a364fd6db77dc4f2de4 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -182,6 +182,9 @@ data Env gbl lcl
 instance ContainsDynFlags (Env gbl lcl) where
     extractDynFlags env = hsc_dflags (env_top env)
 
+instance ContainsModule gbl => ContainsModule (Env gbl lcl) where
+    extractModule env = extractModule (env_gbl env)
+
 -- TcGblEnv describes the top-level of the module at the
 -- point at which the typechecker is finished work.
 -- It is this structure that is handed on to the desugarer
@@ -319,6 +322,9 @@ data TcGblEnv
                                              -- as -XSafe (Safe Haskell)
     }
 
+instance ContainsModule TcGblEnv where
+    extractModule env = tcg_mod env
+
 data RecFieldEnv
   = RecFields (NameEnv [Name])  -- Maps a constructor name *in this module*
                                 -- to the fields for that constructor
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 469635ef2931bacb3a8e8aae2d57cb4b16715441..ffcf5c2991635b7ebd65d3fc929e46d4c4f83203 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -48,6 +48,7 @@ import MkCore		( rEC_SEL_ERROR_ID )
 import IdInfo
 import Var
 import VarSet
+import Module
 import Name
 import NameSet
 import NameEnv
diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs
index ee7e6163053d3998414f9e01d8ad48efa119ed4c..35d7973c04c67ac15be5397baf87fafec3ad35e7 100644
--- a/compiler/utils/IOEnv.hs
+++ b/compiler/utils/IOEnv.hs
@@ -32,6 +32,7 @@ module IOEnv (
 
 import DynFlags
 import Exception
+import Module
 import Panic
 
 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef, modifyIORef,
@@ -93,6 +94,10 @@ instance ContainsDynFlags env => HasDynFlags (IOEnv env) where
     getDynFlags = do env <- getEnv
                      return $ extractDynFlags env
 
+instance ContainsModule env => HasModule (IOEnv env) where
+    getModule = do env <- getEnv
+                   return $ extractModule env
+
 ----------------------------------------------------------------------
 -- Fundmantal combinators specific to the monad
 ----------------------------------------------------------------------