Refactor NameCache

* Make NameCache the mutable one and replace NameCacheUpdater with it

* Remove NameCache related code duplicated into haddock

Bump haddock submodule

13 files changed, 186 insertions, 198 deletions

diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs
index 94ba48c019..4465d206dd 100644
--- a/compiler/GHC/Driver/Env/Types.hs
+++ b/compiler/GHC/Driver/Env/Types.hs
@@ -102,10 +102,9 @@ data HscEnv
                 -- This is mutable because packages will be demand-loaded during
                 -- a compilation run as required.
 
-        hsc_NC  :: {-# UNPACK #-} !(IORef NameCache),
-                -- ^ As with 'hsc_EPS', this is side-effected by compiling to
-                -- reflect sucking in interface files.  They cache the state of
-                -- external interface files, in effect.
+        hsc_NC  :: {-# UNPACK #-} !NameCache,
+                -- ^ Global Name cache so that each Name gets a single Unique.
+                -- Also track the origin of the Names.
 
         hsc_FC   :: {-# UNPACK #-} !(IORef FinderCache),
                 -- ^ The cached result of performing finding in the file system
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 0ef4f10719..f3ae968a6f 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -123,9 +123,8 @@ import GHC.Iface.Recomp
 import GHC.Iface.Tidy
 import GHC.Iface.Ext.Ast    ( mkHieFile )
 import GHC.Iface.Ext.Types  ( getAsts, hie_asts, hie_module )
-import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result, NameCacheUpdater(..))
+import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result)
 import GHC.Iface.Ext.Debug  ( diffFile, validateScopes )
-import GHC.Iface.Env        ( updNameCache )
 
 import GHC.Core
 import GHC.Core.Tidy           ( tidyExpr )
@@ -245,7 +244,7 @@ newHscEnv dflags = do
     -- allow `setSessionDynFlags` to be used to set unit db flags.
     eps_var <- newIORef initExternalPackageState
     us      <- mkSplitUniqSupply 'r'
-    nc_var  <- newIORef (initNameCache us knownKeyNames)
+    nc_var  <- initNameCache us knownKeyNames
     fc_var  <- newIORef emptyInstalledModuleEnv
     logger  <- initLogger
     tmpfs   <- initTmpFs
@@ -505,7 +504,7 @@ extract_renamed_stuff mod_summary tc_result = do
                     putMsg logger dflags $ text "Got invalid scopes"
                     mapM_ (putMsg logger dflags) xs
               -- Roundtrip testing
-              file' <- readHieFile (NCU $ updNameCache $ hsc_NC hs_env) out_file
+              file' <- readHieFile (hsc_NC hs_env) out_file
               case diffFile hieFile (hie_file_result file') of
                 [] ->
                   putMsg logger dflags $ text "Got no roundtrip errors"
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index cfd8e1a2ee..739152f4e7 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -28,7 +28,6 @@ module GHC.Iface.Binary (
         putSymbolTable,
         BinSymbolTable(..),
         BinDictionary(..)
-
     ) where
 
 #include "HsVersions.h"
@@ -37,16 +36,13 @@ import GHC.Prelude
 
 import GHC.Tc.Utils.Monad
 import GHC.Builtin.Utils   ( isKnownKeyName, lookupKnownKeyName )
-import GHC.Iface.Env
 import GHC.Unit
 import GHC.Unit.Module.ModIface
 import GHC.Types.Name
 import GHC.Platform.Profile
 import GHC.Types.Unique.FM
-import GHC.Types.Unique.Supply
 import GHC.Utils.Panic
 import GHC.Utils.Binary as Binary
-import GHC.Types.SrcLoc
 import GHC.Data.FastMutInt
 import GHC.Types.Unique
 import GHC.Utils.Outputable
@@ -83,12 +79,12 @@ data TraceBinIFace
 -- | Read an interface file.
 readBinIface
   :: Profile
-  -> NameCacheUpdater
+  -> NameCache
   -> CheckHiWay
   -> TraceBinIFace
   -> FilePath
   -> IO ModIface
-readBinIface profile ncu checkHiWay traceBinIFace hi_path = do
+readBinIface profile name_cache checkHiWay traceBinIFace hi_path = do
     let platform = profilePlatform profile
 
         wantedGot :: String -> a -> a -> (a -> SDoc) -> IO ()
@@ -131,7 +127,7 @@ readBinIface profile ncu checkHiWay traceBinIFace hi_path = do
 
     extFields_p <- get bh
 
-    mod_iface <- getWithUserData ncu bh
+    mod_iface <- getWithUserData name_cache bh
 
     seekBin bh extFields_p
     extFields <- get bh
@@ -142,8 +138,8 @@ readBinIface profile ncu checkHiWay traceBinIFace hi_path = do
 -- | This performs a get action after reading the dictionary and symbol
 -- table. It is necessary to run this before trying to deserialise any
 -- Names or FastStrings.
-getWithUserData :: Binary a => NameCacheUpdater -> BinHandle -> IO a
-getWithUserData ncu bh = do
+getWithUserData :: Binary a => NameCache -> BinHandle -> IO a
+getWithUserData name_cache bh = do
     -- Read the dictionary
     -- The next word in the file is a pointer to where the dictionary is
     -- (probably at the end of the file)
@@ -160,11 +156,11 @@ getWithUserData ncu bh = do
         symtab_p <- Binary.get bh     -- Get the symtab ptr
         data_p <- tellBin bh          -- Remember where we are now
         seekBin bh symtab_p
-        symtab <- getSymbolTable bh ncu
+        symtab <- getSymbolTable bh name_cache
         seekBin bh data_p             -- Back to where we were before
 
         -- It is only now that we know how to get a Name
-        return $ setUserData bh $ newReadState (getSymtabName ncu dict symtab)
+        return $ setUserData bh $ newReadState (getSymtabName name_cache dict symtab)
                                                (getDictFastString dict)
 
     -- Read the interface file
@@ -284,11 +280,11 @@ putSymbolTable bh next_off symtab = do
       -- indices that array uses to create order
     mapM_ (\n -> serialiseName bh n symtab) names
 
-getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
-getSymbolTable bh ncu = do
+getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable
+getSymbolTable bh name_cache = do
     sz <- get bh
     od_names <- sequence (replicate sz (get bh))
-    updateNameCache ncu $ \namecache ->
+    updateNameCache' name_cache $ \namecache ->
         runST $ flip State.evalStateT namecache $ do
             mut_arr <- lift $ newSTArray_ (0, sz-1)
             for_ (zip [0..] od_names) $ \(i, odn) -> do
@@ -303,20 +299,6 @@ getSymbolTable bh ncu = do
     newSTArray_ :: forall s. (Int, Int) -> ST s (STArray s Int Name)
     newSTArray_ = newArray_
 
-type OnDiskName = (Unit, ModuleName, OccName)
-
-fromOnDiskName :: NameCache -> OnDiskName -> (NameCache, Name)
-fromOnDiskName nc (pid, mod_name, occ) =
-    let mod   = mkModule pid mod_name
-        cache = nsNames nc
-    in case lookupOrigNameCache cache  mod occ of
-           Just name -> (nc, name)
-           Nothing   ->
-               let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
-                   name       = mkExternalName uniq mod occ noSrcSpan
-                   new_cache  = extendNameCache cache mod occ name
-               in ( nc{ nsUniqs = us, nsNames = new_cache }, name )
-
 serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO ()
 serialiseName bh name _ = do
     let mod = ASSERT2( isExternalName name, ppr name ) nameModule name
@@ -366,10 +348,10 @@ putName _dict BinSymbolTable{
             put_ bh (fromIntegral off :: Word32)
 
 -- See Note [Symbol table representation of names]
-getSymtabName :: NameCacheUpdater
+getSymtabName :: NameCache
               -> Dictionary -> SymbolTable
               -> BinHandle -> IO Name
-getSymtabName _ncu _dict symtab bh = do
+getSymtabName _name_cache _dict symtab bh = do
     i :: Word32 <- get bh
     case i .&. 0xC0000000 of
       0x00000000 -> return $! symtab ! fromIntegral i
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index 00ec3790d9..ad62a6232b 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -6,7 +6,7 @@ module GHC.Iface.Env (
         newGlobalBinder, newInteractiveBinder,
         externaliseName,
         lookupIfaceTop,
-        lookupOrig, lookupOrigIO, lookupOrigNameCache, extendNameCache,
+        lookupOrig, lookupOrigIO, lookupOrigNameCache,
         newIfaceName, newIfaceNames,
         extendIfaceIdEnv, extendIfaceTyVarEnv,
         tcIfaceLclId, tcIfaceTyVar, lookupIfaceVar,
@@ -18,8 +18,7 @@ module GHC.Iface.Env (
         trace_if, trace_hi_diffs, -- FIXME: temporary
 
         -- Name-cache stuff
-        allocateGlobalBinder, updNameCacheTc, updNameCache,
-        mkNameCacheUpdater, mkNameCacheUpdaterM, NameCacheUpdater(..),
+        allocateGlobalBinder,
    ) where
 
 #include "HsVersions.h"
@@ -51,7 +50,6 @@ import GHC.Utils.Outputable
 import GHC.Utils.Error
 
 import Data.List     ( partition )
-import Data.IORef
 import Control.Monad
 
 {-
@@ -74,7 +72,8 @@ newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
 -- moment when we know its Module and SrcLoc in their full glory
 
 newGlobalBinder mod occ loc
-  = do { name <- updNameCacheTc mod occ $ \name_cache ->
+  = do { hsc_env <- getTopEnv
+       ; name <- liftIO $ updateNameCache (hsc_NC hsc_env) mod occ $ \name_cache ->
                  allocateGlobalBinder name_cache mod occ loc
        ; traceIf (text "newGlobalBinder" <+>
                   (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))
@@ -85,13 +84,13 @@ newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
 -- from the interactive context
 newInteractiveBinder hsc_env occ loc
  = do { let mod = icInteractiveModule (hsc_IC hsc_env)
-       ; updNameCacheIO hsc_env mod occ $ \name_cache ->
+       ; updateNameCache (hsc_NC hsc_env) mod occ $ \name_cache ->
          allocateGlobalBinder name_cache mod occ loc }
 
 allocateGlobalBinder
-  :: NameCache
+  :: NameCacheState
   -> Module -> OccName -> SrcSpan
-  -> (NameCache, Name)
+  -> (NameCacheState, Name)
 -- See Note [The Name Cache] in GHC.Types.Name.Cache
 allocateGlobalBinder name_supply mod occ loc
   = case lookupOrigNameCache (nsNames name_supply) mod occ of
@@ -119,7 +118,7 @@ allocateGlobalBinder name_supply mod occ loc
                     uniq            = nameUnique name
                     name'           = mkExternalName uniq mod occ loc
                                       -- name' is like name, but with the right SrcSpan
-                    new_cache       = extendNameCache (nsNames name_supply) mod occ name'
+                    new_cache       = extendOrigNameCache (nsNames name_supply) mod occ name'
                     new_name_supply = name_supply {nsNames = new_cache}
 
         -- Miss in the cache!
@@ -128,49 +127,12 @@ allocateGlobalBinder name_supply mod occ loc
                   where
                     (uniq, us')     = takeUniqFromSupply (nsUniqs name_supply)
                     name            = mkExternalName uniq mod occ loc
-                    new_cache       = extendNameCache (nsNames name_supply) mod occ name
+                    new_cache       = extendOrigNameCache (nsNames name_supply) mod occ name
                     new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
 
 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
 ifaceExportNames exports = return exports
 
--- | A function that atomically updates the name cache given a modifier
--- function.  The second result of the modifier function will be the result
--- of the IO action.
-newtype NameCacheUpdater
-      = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c }
-
-mkNameCacheUpdater :: HscEnv -> NameCacheUpdater
-mkNameCacheUpdater hsc_env = NCU (updNameCache ncRef)
-  where
-    !ncRef = hsc_NC hsc_env
-
-mkNameCacheUpdaterM :: TcRnIf a b NameCacheUpdater
-mkNameCacheUpdaterM = mkNameCacheUpdater <$> getTopEnv
-
-updNameCacheTc :: Module -> OccName -> (NameCache -> (NameCache, c))
-               -> TcRnIf a b c
-updNameCacheTc mod occ upd_fn = do {
-    hsc_env <- getTopEnv
-  ; liftIO $ updNameCacheIO hsc_env mod occ upd_fn }
-
-
-updNameCacheIO ::  HscEnv -> Module -> OccName
-               -> (NameCache -> (NameCache, c))
-               -> IO c
-updNameCacheIO hsc_env mod occ upd_fn = do {
-
-    -- First ensure that mod and occ are evaluated
-    -- If not, chaos can ensue:
-    --      we read the name-cache
-    --      then pull on mod (say)
-    --      which does some stuff that modifies the name cache
-    -- This did happen, with tycon_mod in GHC.IfaceToCore.tcIfaceAlt (DataAlt..)
-
-    mod `seq` occ `seq` return ()
-  ; updNameCache (hsc_NC hsc_env) upd_fn }
-
-
 {-
 ************************************************************************
 *                                                                      *
@@ -183,16 +145,16 @@ updNameCacheIO hsc_env mod occ upd_fn = do {
 -- Consider alternatively using 'lookupIfaceTop' if you're in the 'IfL' monad
 -- and 'Module' is simply that of the 'ModIface' you are typechecking.
 lookupOrig :: Module -> OccName -> TcRnIf a b Name
-lookupOrig mod occ
-  = do  { traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
-
-        ; updNameCacheTc mod occ $ lookupNameCache mod occ }
+lookupOrig mod occ = do
+  hsc_env <- getTopEnv
+  traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
+  liftIO $ updateNameCache (hsc_NC hsc_env) mod occ $ lookupNameCache mod occ
 
 lookupOrigIO :: HscEnv -> Module -> OccName -> IO Name
 lookupOrigIO hsc_env mod occ
-  = updNameCacheIO hsc_env mod occ $ lookupNameCache mod occ
+  = updateNameCache (hsc_NC hsc_env) mod occ $ lookupNameCache mod occ
 
-lookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)
+lookupNameCache :: Module -> OccName -> NameCacheState -> (NameCacheState, Name)
 -- Lookup up the (Module,OccName) in the NameCache
 -- If you find it, return it; if not, allocate a fresh original name and extend
 -- the NameCache.
@@ -207,7 +169,7 @@ lookupNameCache mod occ name_cache =
           (uniq, us) ->
               let
                 name      = mkExternalName uniq mod occ noSrcSpan
-                new_cache = extendNameCache (nsNames name_cache) mod occ name
+                new_cache = extendOrigNameCache (nsNames name_cache) mod occ name
               in (name_cache{ nsUniqs = us, nsNames = new_cache }, name) }}
 
 externaliseName :: Module -> Name -> TcRnIf m n Name
@@ -218,9 +180,10 @@ externaliseName mod name
              loc = nameSrcSpan name
              uniq = nameUnique name
        ; occ `seq` return ()  -- c.f. seq in newGlobalBinder
-       ; updNameCacheTc mod occ $ \ ns ->
+       ; hsc_env <- getTopEnv
+       ; liftIO $ updateNameCache (hsc_NC hsc_env) mod occ $ \ ns ->
          let name' = mkExternalName uniq mod occ loc
-             ns'   = ns { nsNames = extendNameCache (nsNames ns) mod occ name' }
+             ns'   = ns { nsNames = extendOrigNameCache (nsNames ns) mod occ name' }
          in (ns', name') }
 
 -- | Set the 'Module' of a 'Name'.
@@ -313,22 +276,6 @@ newIfaceNames occs
         ; return [ mkInternalName uniq occ noSrcSpan
                  | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
 
-{-
-Names in a NameCache are always stored as a Global, and have the SrcLoc
-of their binding locations.
-
-Actually that's not quite right.  When we first encounter the original
-name, we might not be at its binding site (e.g. we are reading an
-interface file); so we give it 'noSrcLoc' then.  Later, when we find
-its binding site, we fix it up.
--}
-
-updNameCache :: IORef NameCache
-             -> (NameCache -> (NameCache, c))  -- The updating function
-             -> IO c
-updNameCache ncRef upd_fn
-  = atomicModifyIORef' ncRef upd_fn
-
 trace_if :: DynFlags -> SDoc -> IO ()
 {-# INLINE trace_if #-}
 trace_if dflags doc = when (dopt Opt_D_dump_if_trace dflags) $ putMsg dflags doc
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index b118cd8da7..3342ed2253 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -14,7 +14,6 @@ module GHC.Iface.Ext.Binary
    , HieFileResult(..)
    , hieMagic
    , hieNameOcc
-   , NameCacheUpdater(..)
    )
 where
 
@@ -34,7 +33,6 @@ import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Unique.Supply    ( takeUniqFromSupply )
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
-import GHC.Iface.Env (NameCacheUpdater(..))
 
 import qualified Data.Array as A
 import Data.IORef
@@ -153,23 +151,23 @@ type HieHeader = (Integer, ByteString)
 -- an existing `NameCache`. Allows you to specify
 -- which versions of hieFile to attempt to read.
 -- `Left` case returns the failing header versions.
-readHieFileWithVersion :: (HieHeader -> Bool) -> NameCacheUpdater -> FilePath -> IO (Either HieHeader HieFileResult)
-readHieFileWithVersion readVersion ncu file = do
+readHieFileWithVersion :: (HieHeader -> Bool) -> NameCache -> FilePath -> IO (Either HieHeader HieFileResult)
+readHieFileWithVersion readVersion name_cache file = do
   bh0 <- readBinMem file
 
   (hieVersion, ghcVersion) <- readHieFileHeader file bh0
 
   if readVersion (hieVersion, ghcVersion)
   then do
-    hieFile <- readHieFileContents bh0 ncu
+    hieFile <- readHieFileContents bh0 name_cache
     return $ Right (HieFileResult hieVersion ghcVersion hieFile)
   else return $ Left (hieVersion, ghcVersion)
 
 
 -- | Read a `HieFile` from a `FilePath`. Can use
 -- an existing `NameCache`.
-readHieFile :: NameCacheUpdater -> FilePath -> IO HieFileResult
-readHieFile ncu file = do
+readHieFile :: NameCache -> FilePath -> IO HieFileResult
+readHieFile name_cache file = do
 
   bh0 <- readBinMem file
 
@@ -183,7 +181,7 @@ readHieFile ncu file = do
                     , show hieVersion
                     , "but got", show readHieVersion
                     ]
-  hieFile <- readHieFileContents bh0 ncu
+  hieFile <- readHieFileContents bh0 name_cache
   return $ HieFileResult hieVersion ghcVersion hieFile
 
 readBinLine :: BinHandle -> IO ByteString
@@ -218,8 +216,8 @@ readHieFileHeader file bh0 = do
                         ]
       return (readHieVersion, ghcVersion)
 
-readHieFileContents :: BinHandle -> NameCacheUpdater -> IO HieFile
-readHieFileContents bh0 ncu = do
+readHieFileContents :: BinHandle -> NameCache -> IO HieFile
+readHieFileContents bh0 name_cache = do
   dict <- get_dictionary bh0
   -- read the symbol table so we are capable of reading the actual data
   bh1 <- do
@@ -246,7 +244,7 @@ readHieFileContents bh0 ncu = do
       symtab_p <- get bh1
       data_p'  <- tellBin bh1
       seekBin bh1 symtab_p
-      symtab <- getSymbolTable bh1 ncu
+      symtab <- getSymbolTable bh1 name_cache
       seekBin bh1 data_p'
       return symtab
 
@@ -270,11 +268,11 @@ putSymbolTable bh next_off symtab = do
   let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab))
   mapM_ (putHieName bh) names
 
-getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
-getSymbolTable bh ncu = do
+getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable
+getSymbolTable bh name_cache = do
   sz <- get bh
   od_names <- replicateM sz (getHieName bh)
-  updateNameCache ncu $ \nc ->
+  updateNameCache' name_cache $ \nc ->
     let arr = A.listArray (0,sz-1) names
         (nc', names) = mapAccumR fromHieName nc od_names
         in (nc',arr)
@@ -312,7 +310,7 @@ putName (HieSymbolTable next ref) bh name = do
 
 -- ** Converting to and from `HieName`'s
 
-fromHieName :: NameCache -> HieName -> (NameCache, Name)
+fromHieName :: NameCacheState -> HieName -> (NameCacheState, Name)
 fromHieName nc (ExternalName mod occ span) =
     let cache = nsNames nc
     in case lookupOrigNameCache cache mod occ of
@@ -320,7 +318,7 @@ fromHieName nc (ExternalName mod occ span) =
          Nothing ->
            let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
                name       = mkExternalName uniq mod occ span
-               new_cache  = extendNameCache cache mod occ name
+               new_cache  = extendOrigNameCache cache mod occ name
            in ( nc{ nsUniqs = us, nsNames = new_cache }, name )
 fromHieName nc (LocalName occ span) =
     let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 820dd19622..6e9ac0b548 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -82,6 +82,7 @@ import GHC.Core.FamInstEnv
 import GHC.Types.Id.Make      ( seqId )
 import GHC.Types.Annotations
 import GHC.Types.Name
+import GHC.Types.Name.Cache
 import GHC.Types.Name.Env
 import GHC.Types.Avail
 import GHC.Types.Fixity
@@ -461,7 +462,9 @@ loadInterface doc_str mod from
         -- READ THE MODULE IN
         ; read_result <- case (wantHiBootFile home_unit eps mod from) of
                            Failed err             -> return (Failed err)
-                           Succeeded hi_boot_file -> computeInterface doc_str hi_boot_file mod
+                           Succeeded hi_boot_file -> do
+                             hsc_env <- getTopEnv
+                             liftIO $ computeInterface hsc_env doc_str hi_boot_file mod
         ; case read_result of {
             Failed err -> do
                 { let fake_iface = emptyFullModIface mod
@@ -671,28 +674,27 @@ is_external_sig home_unit iface =
 -- apply to the requirement itself; e.g., @p[A=<A>]:A@ does not require
 -- A.hi to be up-to-date (and indeed, we MUST NOT attempt to read A.hi, unless
 -- we are actually typechecking p.)
-computeInterface ::
-       SDoc -> IsBootInterface -> Module
-    -> TcRnIf gbl lcl (MaybeErr SDoc (ModIface, FilePath))
-computeInterface doc_str hi_boot_file mod0 = do
+computeInterface
+  :: HscEnv
+  -> SDoc
+  -> IsBootInterface
+  -> Module
+  -> IO (MaybeErr SDoc (ModIface, FilePath))
+computeInterface hsc_env doc_str hi_boot_file mod0 = do
     MASSERT( not (isHoleModule mod0) )
-    hsc_env <- getTopEnv
     let home_unit = hsc_home_unit hsc_env
     case getModuleInstantiation mod0 of
         (imod, Just indef) | isHomeUnitIndefinite home_unit -> do
-            r <- liftIO $ findAndReadIface hsc_env doc_str imod mod0 hi_boot_file
+            r <- findAndReadIface hsc_env doc_str imod mod0 hi_boot_file
             case r of
                 Succeeded (iface0, path) -> do
-                    hsc_env <- getTopEnv
-                    r <- liftIO $
-                        rnModIface hsc_env (instUnitInsts (moduleUnit indef))
+                    r <- rnModIface hsc_env (instUnitInsts (moduleUnit indef))
                                    Nothing iface0
                     case r of
                         Right x -> return (Succeeded (x, path))
-                        Left errs -> liftIO . throwIO . mkSrcErr $ errs
+                        Left errs -> throwIO . mkSrcErr $ errs
                 Failed err -> return (Failed err)
-        (mod, _) -> liftIO $
-            findAndReadIface hsc_env doc_str mod mod0 hi_boot_file
+        (mod, _) -> findAndReadIface hsc_env doc_str mod mod0 hi_boot_file
 
 -- | Compute the signatures which must be compiled in order to
 -- load the interface for a 'Module'.  The output of this function
@@ -840,7 +842,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
   let home_unit  = hsc_home_unit hsc_env
   let unit_env   = hsc_unit_env hsc_env
   let profile    = targetProfile dflags
-  let name_cache = mkNameCacheUpdater hsc_env
+  let name_cache = hsc_NC hsc_env
   let unit_state = hsc_units hsc_env
 
   trace_if dflags (sep [hsep [text "Reading",
@@ -892,7 +894,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
                                       err
 
 -- | Check if we need to try the dynamic interface for -dynamic-too
-load_dynamic_too_maybe :: NameCacheUpdater -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
+load_dynamic_too_maybe :: NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
 load_dynamic_too_maybe name_cache unit_state dflags wanted_mod is_boot iface file_path
   -- Indefinite interfaces are ALWAYS non-dynamic.
   | not (moduleIsDefinite (mi_module iface)) = return ()
@@ -902,7 +904,7 @@ load_dynamic_too_maybe name_cache unit_state dflags wanted_mod is_boot iface fil
       DT_Dyn    -> load_dynamic_too name_cache unit_state dflags wanted_mod is_boot iface file_path
       DT_OK     -> load_dynamic_too name_cache unit_state (setDynamicNow dflags) wanted_mod is_boot iface file_path
 
-load_dynamic_too :: NameCacheUpdater -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
+load_dynamic_too :: NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
 load_dynamic_too name_cache unit_state dflags wanted_mod is_boot iface file_path = do
   let dynFilePath = addBootSuffix_maybe is_boot
                   $ replaceExtension file_path (hiSuf dflags)
@@ -917,7 +919,7 @@ load_dynamic_too name_cache unit_state dflags wanted_mod is_boot iface file_path
         do trace_if dflags (text "Failed to load dynamic interface file:" $$ err)
            setDynamicTooFailed dflags
 
-read_file :: NameCacheUpdater -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath))
+read_file :: NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath))
 read_file name_cache unit_state dflags wanted_mod file_path = do
   trace_if dflags (text "readIFace" <+> text file_path)
 
@@ -951,7 +953,7 @@ writeIface logger dflags hi_file_path new_iface
 -- Succeeded iface <=> successfully found and parsed
 readIface
   :: DynFlags
-  -> NameCacheUpdater
+  -> NameCache
   -> Module
   -> FilePath
   -> IO (MaybeErr SDoc ModIface)
@@ -1067,19 +1069,14 @@ For some background on this choice see trac #15269.
 -}
 
 -- | Read binary interface, and print it out
-showIface :: HscEnv -> FilePath -> IO ()
-showIface hsc_env filename = do
-   let dflags  = hsc_dflags hsc_env
-   let logger  = hsc_logger hsc_env
-       unit_state = hsc_units hsc_env
-       profile = targetProfile dflags
+showIface :: Logger -> DynFlags -> UnitState -> NameCache -> FilePath -> IO ()
+showIface logger dflags unit_state name_cache filename = do
+   let profile = targetProfile dflags
        printer = putLogMsg logger dflags NoReason SevOutput noSrcSpan . withPprStyle defaultDumpStyle
-       name_cache = mkNameCacheUpdater hsc_env
 
    -- skip the hi way check; we don't want to worry about profiled vs.
    -- non-profiled interfaces, for example.
-   iface <- initTcRnIf 's' hsc_env () () $
-       liftIO $ readBinIface profile name_cache IgnoreHiWay (TraceBinIFace printer) filename
+   iface <- readBinIface profile name_cache IgnoreHiWay (TraceBinIFace printer) filename
 
    let -- See Note [Name qualification with --show-iface]
        qualifyImportedNames mod _
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index ca35ec60fb..e211f221ab 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -167,7 +167,7 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
 
         loadIface = do
              let iface_path = msHiFilePath mod_summary
-             let ncu        = mkNameCacheUpdater hsc_env
+             let ncu        = hsc_NC hsc_env
              read_result <- readIface dflags ncu (ms_mod mod_summary) iface_path
              case read_result of
                  Failed err -> do
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 76ad3c2a79..44f1a9e282 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -23,6 +23,7 @@ import GHC.Driver.Ppr
 import GHC.Driver.Env
 
 import GHC.Tc.Types
+import GHC.Tc.Utils.Env
 
 import GHC.Core
 import GHC.Core.Unfold
@@ -44,9 +45,6 @@ import GHC.Core.Class
 import GHC.Iface.Tidy.StaticPtrTable
 import GHC.Iface.Env
 
-import GHC.Tc.Utils.Env
-import GHC.Tc.Utils.Monad
-
 import GHC.Utils.Outputable
 import GHC.Utils.Misc( filterOut )
 import GHC.Utils.Panic
@@ -82,7 +80,6 @@ import GHC.Data.Maybe
 import Control.Monad
 import Data.Function
 import Data.List        ( sortBy, mapAccumL )
-import Data.IORef       ( atomicModifyIORef' )
 
 {-
 Constructing the TypeEnv, Instances, Rules from which the
@@ -635,7 +632,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
        ; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders
        ; tidy_internal internal_ids unfold_env1 occ_env1 }
  where
-  nc_var = hsc_NC hsc_env
+  name_cache = hsc_NC hsc_env
 
   -- init_ext_ids is the initial list of Ids that should be
   -- externalised.  It serves as the starting point for finding a
@@ -697,7 +694,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
   search ((idocc,referrer) : rest) unfold_env occ_env
     | idocc `elemVarEnv` unfold_env = search rest unfold_env occ_env
     | otherwise = do
-      (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env idocc
+      (occ_env', name') <- tidyTopName mod name_cache (Just referrer) occ_env idocc
       let
           (new_ids, show_unfold) = addExternal omit_prags expose_all refined_id
 
@@ -717,7 +714,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
                 -> IO (UnfoldEnv, TidyOccEnv)
   tidy_internal []       unfold_env occ_env = return (unfold_env,occ_env)
   tidy_internal (id:ids) unfold_env occ_env = do
-      (occ_env', name') <- tidyTopName mod nc_var Nothing occ_env id
+      (occ_env', name') <- tidyTopName mod name_cache Nothing occ_env id
       let unfold_env' = extendVarEnv unfold_env id (name',False)
       tidy_internal ids unfold_env' occ_env'
 
@@ -1024,9 +1021,9 @@ was previously local, we have to give it a unique occurrence name if
 we intend to externalise it.
 -}
 
-tidyTopName :: Module -> IORef NameCache -> Maybe Id -> TidyOccEnv
+tidyTopName :: Module -> NameCache -> Maybe Id -> TidyOccEnv
             -> Id -> IO (TidyOccEnv, Name)
-tidyTopName mod nc_var maybe_ref occ_env id
+tidyTopName mod name_cache maybe_ref occ_env id
   | global && internal = return (occ_env, localiseName name)
 
   | global && external = return (occ_env, name)
@@ -1037,7 +1034,7 @@ tidyTopName mod nc_var maybe_ref occ_env id
   -- Now we get to the real reason that all this is in the IO Monad:
   -- we have to update the name cache in a nice atomic fashion
 
-  | local  && internal = do { new_local_name <- atomicModifyIORef' nc_var mk_new_local
+  | local  && internal = do { new_local_name <- updateNameCache' name_cache mk_new_local
                             ; return (occ_env', new_local_name) }
         -- Even local, internal names must get a unique occurrence, because
         -- if we do -split-objs we externalise the name later, in the code generator
@@ -1045,7 +1042,7 @@ tidyTopName mod nc_var maybe_ref occ_env id
         -- Similarly, we must make sure it has a system-wide Unique, because
         -- the byte-code generator builds a system-wide Name->BCO symbol table
 
-  | local  && external = do { new_external_name <- atomicModifyIORef' nc_var mk_new_external
+  | local  && external = do { new_external_name <- updateNameCache' name_cache mk_new_external
                             ; return (occ_env', new_external_name) }
 
   | otherwise = panic "tidyTopName"
@@ -1101,7 +1098,7 @@ tidyTopName mod nc_var maybe_ref occ_env id
 -}
 
 -- TopTidyEnv: when tidying we need to know
---   * nc_var: The NameCache, containing a unique supply and any pre-ordained Names.
+--   * name_cache: The NameCache, containing a unique supply and any pre-ordained Names.
 --        These may have arisen because the
 --        renamer read in an interface file mentioning M.$wf, say,
 --        and assigned it unique r77.  If, on this compilation, we've
diff --git a/compiler/GHC/Types/Name/Cache.hs b/compiler/GHC/Types/Name/Cache.hs
index b33e5c2ddf..e0d1e8f58f 100644
--- a/compiler/GHC/Types/Name/Cache.hs
+++ b/compiler/GHC/Types/Name/Cache.hs
@@ -3,16 +3,29 @@
 
 -- | The Name Cache
 module GHC.Types.Name.Cache
-    ( lookupOrigNameCache
-    , extendOrigNameCache
-    , extendNameCache
-    , initNameCache
-    , NameCache(..), OrigNameCache
-    ) where
+  ( NameCache (..)
+  , initNameCache
+  , updateNameCache'
+  , updateNameCache
+  , OnDiskName
+  , fromOnDiskName
+
+  -- * Immutable state
+  , NameCacheState (..)
+  , initNameCacheState
+
+  -- * OrigNameCache
+  , OrigNameCache
+  , lookupOrigNameCache
+  , extendOrigNameCache'
+  , extendOrigNameCache
+  )
+where
 
 import GHC.Prelude
 
 import GHC.Unit.Module
+import GHC.Types.SrcLoc
 import GHC.Types.Name
 import GHC.Types.Unique.Supply
 import GHC.Builtin.Types
@@ -22,6 +35,8 @@ import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
+import Data.IORef
+
 #include "HsVersions.h"
 
 {-
@@ -41,6 +56,12 @@ The functions newGlobalBinder, allocateGlobalBinder do the main work.
 When you make an External name, you should probably be calling one
 of them.
 
+Names in a NameCache are always stored as a Global, and have the SrcLoc of their
+binding locations.  Actually that's not quite right.  When we first encounter
+the original name, we might not be at its binding site (e.g. we are reading an
+interface file); so we give it 'noSrcLoc' then.  Later, when we find its binding
+site, we fix it up.
+
 
 Note [Built-in syntax and the OrigNameCache]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -73,6 +94,18 @@ are two reasons why we might look up an Orig RdrName for built-in syntax,
     go this route (#8954).
 
 -}
+-- | The NameCache makes sure that there is just one Unique assigned for
+-- each original name; i.e. (module-name, occ-name) pair and provides
+-- something of a lookup mechanism for those names.
+newtype NameCache = NameCache (IORef NameCacheState)
+
+-- | The NameCache makes sure that there is just one Unique assigned for
+-- each original name; i.e. (module-name, occ-name) pair and provides
+-- something of a lookup mechanism for those names.
+data NameCacheState = NameCacheState
+  { nsUniqs :: !UniqSupply    -- ^ Supply of uniques
+  , nsNames :: !OrigNameCache -- ^ Ensures that one original name gets one unique
+  }
 
 -- | Per-module cache of original 'OccName's given 'Name's
 type OrigNameCache   = ModuleEnv (OccEnv Name)
@@ -91,32 +124,65 @@ lookupOrigNameCache nc mod occ
         Nothing      -> Nothing
         Just occ_env -> lookupOccEnv occ_env occ
 
-extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
-extendOrigNameCache nc name
+extendOrigNameCache' :: OrigNameCache -> Name -> OrigNameCache
+extendOrigNameCache' nc name
   = ASSERT2( isExternalName name, ppr name )
-    extendNameCache nc (nameModule name) (nameOccName name) name
+    extendOrigNameCache nc (nameModule name) (nameOccName name) name
 
-extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
-extendNameCache nc mod occ name
+extendOrigNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
+extendOrigNameCache nc mod occ name
   = extendModuleEnvWith combine nc mod (unitOccEnv occ name)
   where
     combine _ occ_env = extendOccEnv occ_env occ name
 
--- | The NameCache makes sure that there is just one Unique assigned for
--- each original name; i.e. (module-name, occ-name) pair and provides
--- something of a lookup mechanism for those names.
-data NameCache
- = NameCache {  nsUniqs :: !UniqSupply,
-                -- ^ Supply of uniques
-                nsNames :: !OrigNameCache
-                -- ^ Ensures that one original name gets one unique
-   }
-
--- | Return a function to atomically update the name cache.
-initNameCache :: UniqSupply -> [Name] -> NameCache
-initNameCache us names
-  = NameCache { nsUniqs = us,
-                nsNames = initOrigNames names }
+initNameCacheState :: UniqSupply -> [Name] -> NameCacheState
+initNameCacheState us names = NameCacheState
+  { nsUniqs = us
+  , nsNames = initOrigNames names
+  }
+
+initNameCache :: UniqSupply -> [Name] -> IO NameCache
+initNameCache us names = NameCache <$> newIORef (initNameCacheState us names)
 
 initOrigNames :: [Name] -> OrigNameCache
-initOrigNames names = foldl' extendOrigNameCache emptyModuleEnv names
+initOrigNames names = foldl' extendOrigNameCache' emptyModuleEnv names
+
+-- | Update the name cache with the given function
+updateNameCache'
+  :: NameCache
+  -> (NameCacheState -> (NameCacheState, c))  -- The updating function
+  -> IO c
+updateNameCache' (NameCache ncRef) upd_fn
+  = atomicModifyIORef' ncRef upd_fn
+
+-- | Update the name cache with the given function
+--
+-- Additionally, it ensures that the given Module and OccName are evaluated.
+-- If not, chaos can ensue:
+--      we read the name-cache
+--      then pull on mod (say)
+--      which does some stuff that modifies the name cache
+-- This did happen, with tycon_mod in GHC.IfaceToCore.tcIfaceAlt (DataAlt..)
+updateNameCache
+  :: NameCache
+  -> Module
+  -> OccName
+  -> (NameCacheState -> (NameCacheState, c))
+  -> IO c
+updateNameCache name_cache !_mod !_occ upd_fn
+  = updateNameCache' name_cache upd_fn
+
+type OnDiskName = (Unit, ModuleName, OccName)
+
+fromOnDiskName :: NameCacheState -> OnDiskName -> (NameCacheState, Name)
+fromOnDiskName nc (pid, mod_name, occ) =
+    let mod   = mkModule pid mod_name
+        cache = nsNames nc
+    in case lookupOrigNameCache cache mod occ of
+           Just name -> (nc, name)
+           Nothing   ->
+               let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
+                   name       = mkExternalName uniq mod occ noSrcSpan
+                   new_cache  = extendOrigNameCache cache mod occ name
+               in ( nc{ nsUniqs = us, nsNames = new_cache }, name )
+
diff --git a/ghc/Main.hs b/ghc/Main.hs
index e09242b5ad..1ea72d0b1c 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -244,7 +244,10 @@ main' postLoadMode dflags0 args flagWarnings = do
        GHC.printException e
        liftIO $ exitWith (ExitFailure 1)) $ do
     case postLoadMode of
-       ShowInterface f        -> liftIO $ showIface hsc_env f
+       ShowInterface f        -> liftIO $ showIface (hsc_dflags hsc_env)
+                                                    (hsc_units  hsc_env)
+                                                    (hsc_NC     hsc_env)
+                                                    f
        DoMake                 -> doMake srcs
        DoMkDependHS           -> doMkDependHS (map fst srcs)
        StopBefore p           -> liftIO (oneShot hsc_env p srcs)
diff --git a/testsuite/tests/hiefile/should_run/HieQueries.hs b/testsuite/tests/hiefile/should_run/HieQueries.hs
index 2446be5963..68f6516d0e 100644
--- a/testsuite/tests/hiefile/should_run/HieQueries.hs
+++ b/testsuite/tests/hiefile/should_run/HieQueries.hs
@@ -44,7 +44,7 @@ data A = A deriving Show
 makeNc :: IO NameCache
 makeNc = do
   uniq_supply <- mkSplitUniqSupply 'z'
-  return $ initNameCache uniq_supply []
+  initNameCache uniq_supply []
 
 dynFlagsForPrinting :: String -> IO DynFlags
 dynFlagsForPrinting libdir = do
@@ -55,7 +55,7 @@ main = do
   libdir:_ <- getArgs
   df <- dynFlagsForPrinting libdir
   nc <- makeNc
-  hfr <- readHieFile (NCU (\f -> pure $ snd $ f nc)) "HieQueries.hie"
+  hfr <- readHieFile nc "HieQueries.hie"
   let hf = hie_file_result hfr
       refmap = generateReferencesMap $ getAsts $ hie_asts hf
   explainEv df hf refmap point
diff --git a/testsuite/tests/hiefile/should_run/PatTypes.hs b/testsuite/tests/hiefile/should_run/PatTypes.hs
index 39b9b59f78..0f5f733066 100644
--- a/testsuite/tests/hiefile/should_run/PatTypes.hs
+++ b/testsuite/tests/hiefile/should_run/PatTypes.hs
@@ -35,7 +35,7 @@ p4 = (26,5)
 makeNc :: IO NameCache
 makeNc = do
   uniq_supply <- mkSplitUniqSupply 'z'
-  return $ initNameCache uniq_supply []
+  initNameCache uniq_supply []
 
 dynFlagsForPrinting :: String -> IO DynFlags
 dynFlagsForPrinting libdir = do
@@ -50,7 +50,7 @@ main = do
   libdir:_ <- getArgs
   df <- dynFlagsForPrinting libdir
   nc <- makeNc
-  hfr <- readHieFile (NCU (\f -> pure $ snd $ f nc)) "PatTypes.hie"
+  hfr <- readHieFile nc "PatTypes.hie"
   let hf = hie_file_result hfr
   forM_ [p1,p2,p3,p4] $ \point -> do
     putStr $ "At " ++ show point ++ ", got type: "
diff --git a/utils/haddock b/utils/haddock
-Subproject 3eb51fa32aaefe80bf2b6731dae2a2b26aba9e7
+Subproject a20b326ff0a7e4ce913af90f5cf968e31289164