Remove UniqSupply from NameCache

As suggested by @alexbiehl, this patch replaces the always updated
UniqSupply in NameCache with a fixed Char and use it with `uniqFromMask`
to generate uniques.

This required some refactoring because getting a new unique from the
NameCache can't be done in pure code anymore, in particular not in an
atomic update function for `atomicModifyIORef`. So we use an MVar
instead to store the OrigNameCache field.

For some reason, T12545 increases (+1%) on i386 while it decreases on
other CI runners.

T9630 ghc/peak increases only with the dwarf build on CI (+16%).

Metric Decrease:
    T12425
    T12545
    T9198
    T12234

Metric Increase:
    T12545
    T9630

Update haddock submodule

9 files changed, 115 insertions, 152 deletions

diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index e77ce02c65..92d8034127 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -190,7 +190,6 @@ import GHC.Types.Error
 import GHC.Types.Fixity.Env
 import GHC.Types.CostCentre
 import GHC.Types.IPE
-import GHC.Types.Unique.Supply
 import GHC.Types.SourceFile
 import GHC.Types.SrcLoc
 import GHC.Types.Name
@@ -244,8 +243,7 @@ newHscEnv dflags = do
     -- we don't store the unit databases and the unit state to still
     -- allow `setSessionDynFlags` to be used to set unit db flags.
     eps_var <- newIORef initExternalPackageState
-    us      <- mkSplitUniqSupply 'r'
-    nc_var  <- initNameCache us knownKeyNames
+    nc_var  <- initNameCache 'r' knownKeyNames
     fc_var  <- initFinderCache
     logger  <- initLogger
     tmpfs   <- initTmpFs
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index 739152f4e7..95abdf0530 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -47,23 +47,20 @@ import GHC.Data.FastMutInt
 import GHC.Types.Unique
 import GHC.Utils.Outputable
 import GHC.Types.Name.Cache
+import GHC.Types.SrcLoc
 import GHC.Platform
 import GHC.Data.FastString
 import GHC.Settings.Constants
 import GHC.Utils.Misc
 
 import Data.Array
-import Data.Array.ST
+import Data.Array.IO
 import Data.Array.Unsafe
 import Data.Bits
 import Data.Char
 import Data.Word
 import Data.IORef
-import Data.Foldable
 import Control.Monad
-import Control.Monad.ST
-import Control.Monad.Trans.Class
-import qualified Control.Monad.Trans.State.Strict as State
 
 -- ---------------------------------------------------------------------------
 -- Reading and writing binary interface files
@@ -280,24 +277,31 @@ putSymbolTable bh next_off symtab = do
       -- indices that array uses to create order
     mapM_ (\n -> serialiseName bh n symtab) names
 
+
 getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable
 getSymbolTable bh name_cache = do
-    sz <- get bh
+    sz <- get bh :: IO Int
     od_names <- sequence (replicate sz (get bh))
-    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
-                (nc, !n) <- State.gets $ \nc -> fromOnDiskName nc odn
-                lift $ writeArray mut_arr i n
-                State.put nc
-            arr <- lift $ unsafeFreeze mut_arr
-            namecache' <- State.get
-            return (namecache', arr)
-  where
-    -- This binding is required because the type of newArray_ cannot be inferred
-    newSTArray_ :: forall s. (Int, Int) -> ST s (STArray s Int Name)
-    newSTArray_ = newArray_
+
+    -- create an array of Names for the symbols and add them to the NameCache
+    updateNameCache' name_cache $ \cache0 -> do
+        mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int Name)
+        let go cache ((uid, mod_name, occ),i) = do
+              let mod = mkModule uid mod_name
+              case lookupOrigNameCache cache mod occ of
+                Just name -> do
+                  writeArray mut_arr i name
+                  return cache
+                Nothing   -> do
+                  uniq <- takeUniqFromNameCache name_cache
+                  let name      = mkExternalName uniq mod occ noSrcSpan
+                      new_cache = extendOrigNameCache cache mod occ name
+                  writeArray mut_arr i name
+                  return new_cache
+
+        cache <- foldM go cache0 (zip od_names [0..])
+        arr <- unsafeFreeze mut_arr
+        return (cache, arr)
 
 serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO ()
 serialiseName bh name _ = do
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index 2290b5f8bf..f36eb1d4ae 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -74,8 +74,7 @@ newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
 
 newGlobalBinder mod occ loc
   = do { hsc_env <- getTopEnv
-       ; name <- liftIO $ updateNameCache (hsc_NC hsc_env) mod occ $ \name_cache ->
-                 allocateGlobalBinder name_cache mod occ loc
+       ; name <- liftIO $ allocateGlobalBinder (hsc_NC hsc_env) mod occ loc
        ; traceIf (text "newGlobalBinder" <+>
                   (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))
        ; return name }
@@ -83,18 +82,18 @@ newGlobalBinder mod occ loc
 newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
 -- Works in the IO monad, and gets the Module
 -- from the interactive context
-newInteractiveBinder hsc_env occ loc
- = do { let mod = icInteractiveModule (hsc_IC hsc_env)
-       ; updateNameCache (hsc_NC hsc_env) mod occ $ \name_cache ->
-         allocateGlobalBinder name_cache mod occ loc }
+newInteractiveBinder hsc_env occ loc = do
+  let mod = icInteractiveModule (hsc_IC hsc_env)
+  allocateGlobalBinder (hsc_NC hsc_env) mod occ loc
 
 allocateGlobalBinder
-  :: NameCacheState
+  :: NameCache
   -> Module -> OccName -> SrcSpan
-  -> (NameCacheState, Name)
+  -> IO 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
+allocateGlobalBinder nc mod occ loc
+  = updateNameCache nc mod occ $ \cache0 -> do
+      case lookupOrigNameCache cache0 mod occ of
         -- A hit in the cache!  We are at the binding site of the name.
         -- This is the moment when we know the SrcLoc
         -- of the Name, so we set this field in the Name we return.
@@ -112,24 +111,22 @@ allocateGlobalBinder name_supply mod occ loc
         --            and their Module is correct.
 
         Just name | isWiredInName name
-                  -> (name_supply, name)
+                  -> pure (cache0, name)
                   | otherwise
-                  -> (new_name_supply, name')
+                  -> pure (new_cache, name')
                   where
-                    uniq            = nameUnique name
-                    name'           = mkExternalName uniq mod occ loc
-                                      -- name' is like name, but with the right SrcSpan
-                    new_cache       = extendOrigNameCache (nsNames name_supply) mod occ name'
-                    new_name_supply = name_supply {nsNames = new_cache}
+                    uniq      = nameUnique name
+                    name'     = mkExternalName uniq mod occ loc
+                                -- name' is like name, but with the right SrcSpan
+                    new_cache = extendOrigNameCache cache0 mod occ name'
 
         -- Miss in the cache!
         -- Build a completely new Name, and put it in the cache
-        _ -> (new_name_supply, name)
-                  where
-                    (uniq, us')     = takeUniqFromSupply (nsUniqs name_supply)
-                    name            = mkExternalName uniq mod occ loc
-                    new_cache       = extendOrigNameCache (nsNames name_supply) mod occ name
-                    new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
+        _ -> do
+              uniq <- takeUniqFromNameCache nc
+              let name      = mkExternalName uniq mod occ loc
+              let new_cache = extendOrigNameCache cache0 mod occ name
+              pure (new_cache, name)
 
 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
 ifaceExportNames exports = return exports
@@ -149,29 +146,27 @@ lookupOrig :: Module -> OccName -> TcRnIf a b Name
 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
+  liftIO $ lookupNameCache (hsc_NC hsc_env) mod occ
 
 lookupOrigIO :: HscEnv -> Module -> OccName -> IO Name
 lookupOrigIO hsc_env mod occ
-  = updateNameCache (hsc_NC hsc_env) mod occ $ lookupNameCache mod occ
+  = lookupNameCache (hsc_NC hsc_env) mod occ
 
-lookupNameCache :: Module -> OccName -> NameCacheState -> (NameCacheState, Name)
+lookupNameCache :: NameCache -> Module -> OccName -> IO 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.
 -- Reason: this may the first occurrence of (say) Foo.bar we have encountered.
 -- If we need to explore its value we will load Foo.hi; but meanwhile all we
 -- need is a Name for it.
-lookupNameCache mod occ name_cache =
-  case lookupOrigNameCache (nsNames name_cache) mod occ of {
-    Just name -> (name_cache, name);
-    Nothing   ->
-        case takeUniqFromSupply (nsUniqs name_cache) of {
-          (uniq, us) ->
-              let
-                name      = mkExternalName uniq mod occ noSrcSpan
-                new_cache = extendOrigNameCache (nsNames name_cache) mod occ name
-              in (name_cache{ nsUniqs = us, nsNames = new_cache }, name) }}
+lookupNameCache nc mod occ = updateNameCache nc mod occ $ \cache0 ->
+  case lookupOrigNameCache cache0 mod occ of
+    Just name -> pure (cache0, name)
+    Nothing   -> do
+      uniq <- takeUniqFromNameCache nc
+      let name      = mkExternalName uniq mod occ noSrcSpan
+      let new_cache = extendOrigNameCache cache0 mod occ name
+      pure (new_cache, name)
 
 externaliseName :: Module -> Name -> TcRnIf m n Name
 -- Take an Internal Name and make it an External one,
@@ -182,10 +177,10 @@ externaliseName mod name
              uniq = nameUnique name
        ; occ `seq` return ()  -- c.f. seq in newGlobalBinder
        ; hsc_env <- getTopEnv
-       ; liftIO $ updateNameCache (hsc_NC hsc_env) mod occ $ \ ns ->
-         let name' = mkExternalName uniq mod occ loc
-             ns'   = ns { nsNames = extendOrigNameCache (nsNames ns) mod occ name' }
-         in (ns', name') }
+       ; liftIO $ updateNameCache (hsc_NC hsc_env) mod occ $ \cache -> do
+         let name'  = mkExternalName uniq mod occ loc
+             cache' = extendOrigNameCache cache mod occ name'
+         pure (cache', name') }
 
 -- | Set the 'Module' of a 'Name'.
 setNameModule :: Maybe Module -> Name -> TcRnIf m n Name
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 3342ed2253..2d3a009153 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -30,7 +30,6 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Builtin.Utils
 import GHC.Types.SrcLoc as SrcLoc
-import GHC.Types.Unique.Supply    ( takeUniqFromSupply )
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 
@@ -39,7 +38,6 @@ import Data.IORef
 import Data.ByteString            ( ByteString )
 import qualified Data.ByteString  as BS
 import qualified Data.ByteString.Char8 as BSC
-import Data.List                  ( mapAccumR )
 import Data.Word                  ( Word8, Word32 )
 import Control.Monad              ( replicateM, when )
 import System.Directory           ( createDirectoryIfMissing )
@@ -272,10 +270,8 @@ getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable
 getSymbolTable bh name_cache = do
   sz <- get bh
   od_names <- replicateM sz (getHieName bh)
-  updateNameCache' name_cache $ \nc ->
-    let arr = A.listArray (0,sz-1) names
-        (nc', names) = mapAccumR fromHieName nc od_names
-        in (nc',arr)
+  names <- mapM (fromHieName name_cache) od_names
+  pure $ A.listArray (0,sz-1) names
 
 getSymTabName :: SymbolTable -> BinHandle -> IO Name
 getSymTabName st bh = do
@@ -310,24 +306,28 @@ putName (HieSymbolTable next ref) bh name = do
 
 -- ** Converting to and from `HieName`'s
 
-fromHieName :: NameCacheState -> HieName -> (NameCacheState, Name)
-fromHieName nc (ExternalName mod occ span) =
-    let 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 span
-               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)
-        name       = mkInternalName uniq occ span
-    in ( nc{ nsUniqs = us }, name )
-fromHieName nc (KnownKeyName u) = case lookupKnownKeyName u of
-    Nothing -> pprPanic "fromHieName:unknown known-key unique"
-                        (ppr (unpkUnique u))
-    Just n -> (nc, n)
+fromHieName :: NameCache -> HieName -> IO Name
+fromHieName nc hie_name = do
+
+  case hie_name of
+    ExternalName mod occ span -> updateNameCache nc mod occ $ \cache -> do
+      case lookupOrigNameCache cache mod occ of
+        Just name -> pure (cache, name)
+        Nothing   -> do
+          uniq <- takeUniqFromNameCache nc
+          let name       = mkExternalName uniq mod occ span
+              new_cache  = extendOrigNameCache cache mod occ name
+          pure (new_cache, name)
+
+    LocalName occ span -> do
+      uniq <- takeUniqFromNameCache nc
+      -- don't update the NameCache for local names
+      pure $ mkInternalName uniq occ span
+
+    KnownKeyName u -> case lookupKnownKeyName u of
+      Nothing -> pprPanic "fromHieName:unknown known-key unique"
+                          (ppr (unpkUnique u))
+      Just n -> pure n
 
 -- ** Reading and writing `HieName`'s
 
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 44f1a9e282..fa6db60736 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -66,7 +66,6 @@ import GHC.Types.Name.Set
 import GHC.Types.Name.Cache
 import GHC.Types.Name.Ppr
 import GHC.Types.Avail
-import GHC.Types.Unique.Supply
 import GHC.Types.Tickish
 import GHC.Types.TypeEnv
 
@@ -1034,16 +1033,23 @@ tidyTopName mod name_cache 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 <- updateNameCache' name_cache mk_new_local
-                            ; return (occ_env', new_local_name) }
+  | local  && internal = do uniq <- takeUniqFromNameCache name_cache
+                            let new_local_name = mkInternalName uniq occ' loc
+                            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
         --
         -- 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 <- updateNameCache' name_cache mk_new_external
-                            ; return (occ_env', new_external_name) }
+  | local  && external = do new_external_name <- allocateGlobalBinder name_cache mod occ' loc
+                            return (occ_env', new_external_name)
+        -- If we want to externalise a currently-local name, check
+        -- whether we have already assigned a unique for it.
+        -- If so, use it; if not, extend the table.
+        -- All this is done by allocateGlobalBinder.
+        -- This is needed when *re*-compiling a module in GHCi; we must
+        -- use the same name for externally-visible things as we did before.
 
   | otherwise = panic "tidyTopName"
   where
@@ -1077,17 +1083,6 @@ tidyTopName mod name_cache maybe_ref occ_env id
 
     (occ_env', occ') = tidyOccName occ_env new_occ
 
-    mk_new_local nc = (nc { nsUniqs = us }, mkInternalName uniq occ' loc)
-                    where
-                      (uniq, us) = takeUniqFromSupply (nsUniqs nc)
-
-    mk_new_external nc = allocateGlobalBinder nc mod occ' loc
-        -- If we want to externalise a currently-local name, check
-        -- whether we have already assigned a unique for it.
-        -- If so, use it; if not, extend the table.
-        -- All this is done by allcoateGlobalBinder.
-        -- This is needed when *re*-compiling a module in GHCi; we must
-        -- use the same name for externally-visible things as we did before.
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Types/Name/Cache.hs b/compiler/GHC/Types/Name/Cache.hs
index e0d1e8f58f..4a8ffb50d7 100644
--- a/compiler/GHC/Types/Name/Cache.hs
+++ b/compiler/GHC/Types/Name/Cache.hs
@@ -5,14 +5,9 @@
 module GHC.Types.Name.Cache
   ( NameCache (..)
   , initNameCache
+  , takeUniqFromNameCache
   , updateNameCache'
   , updateNameCache
-  , OnDiskName
-  , fromOnDiskName
-
-  -- * Immutable state
-  , NameCacheState (..)
-  , initNameCacheState
 
   -- * OrigNameCache
   , OrigNameCache
@@ -25,7 +20,6 @@ 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
@@ -35,7 +29,8 @@ import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
-import Data.IORef
+import Control.Concurrent.MVar
+import Control.Monad
 
 #include "HsVersions.h"
 
@@ -97,19 +92,17 @@ are two reasons why we might look up an Orig RdrName for built-in syntax,
 -- | 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
+data NameCache = NameCache
+  { nsUniqChar :: {-# UNPACK #-} !Char
+  , nsNames    :: {-# UNPACK #-} !(MVar OrigNameCache)
   }
 
 -- | Per-module cache of original 'OccName's given 'Name's
 type OrigNameCache   = ModuleEnv (OccEnv Name)
 
+takeUniqFromNameCache :: NameCache -> IO Unique
+takeUniqFromNameCache (NameCache c _) = uniqFromMask c
+
 lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
 lookupOrigNameCache nc mod occ
   | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE
@@ -135,14 +128,8 @@ extendOrigNameCache nc mod occ name
   where
     combine _ occ_env = extendOccEnv occ_env occ name
 
-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)
+initNameCache :: Char -> [Name] -> IO NameCache
+initNameCache c names = NameCache c <$> newMVar (initOrigNames names)
 
 initOrigNames :: [Name] -> OrigNameCache
 initOrigNames names = foldl' extendOrigNameCache' emptyModuleEnv names
@@ -150,10 +137,13 @@ initOrigNames names = foldl' extendOrigNameCache' emptyModuleEnv names
 -- | Update the name cache with the given function
 updateNameCache'
   :: NameCache
-  -> (NameCacheState -> (NameCacheState, c))  -- The updating function
+  -> (OrigNameCache -> IO (OrigNameCache, c))  -- The updating function
   -> IO c
-updateNameCache' (NameCache ncRef) upd_fn
-  = atomicModifyIORef' ncRef upd_fn
+updateNameCache' (NameCache _c nc) upd_fn = modifyMVar' nc upd_fn
+
+-- this should be in `base`
+modifyMVar' :: MVar a -> (a -> IO (a,b)) -> IO b
+modifyMVar' m f = modifyMVar m $ f >=> \c -> fst c `seq` pure c
 
 -- | Update the name cache with the given function
 --
@@ -167,22 +157,7 @@ updateNameCache
   :: NameCache
   -> Module
   -> OccName
-  -> (NameCacheState -> (NameCacheState, c))
+  -> (OrigNameCache -> IO (OrigNameCache, 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/testsuite/tests/hiefile/should_run/HieQueries.hs b/testsuite/tests/hiefile/should_run/HieQueries.hs
index 68f6516d0e..d48dd02cd0 100644
--- a/testsuite/tests/hiefile/should_run/HieQueries.hs
+++ b/testsuite/tests/hiefile/should_run/HieQueries.hs
@@ -42,9 +42,7 @@ point' = (37,9)
 data A = A deriving Show
 
 makeNc :: IO NameCache
-makeNc = do
-  uniq_supply <- mkSplitUniqSupply 'z'
-  initNameCache uniq_supply []
+makeNc = initNameCache 'z' []
 
 dynFlagsForPrinting :: String -> IO DynFlags
 dynFlagsForPrinting libdir = do
diff --git a/testsuite/tests/hiefile/should_run/PatTypes.hs b/testsuite/tests/hiefile/should_run/PatTypes.hs
index 0f5f733066..67a89d1c49 100644
--- a/testsuite/tests/hiefile/should_run/PatTypes.hs
+++ b/testsuite/tests/hiefile/should_run/PatTypes.hs
@@ -33,9 +33,7 @@ p3 = (24,11)
 p4 = (26,5)
 
 makeNc :: IO NameCache
-makeNc = do
-  uniq_supply <- mkSplitUniqSupply 'z'
-  initNameCache uniq_supply []
+makeNc = initNameCache 'z' []
 
 dynFlagsForPrinting :: String -> IO DynFlags
 dynFlagsForPrinting libdir = do
diff --git a/utils/haddock b/utils/haddock
-Subproject a20b326ff0a7e4ce913af90f5cf968e31289164
+Subproject adca17adc9f53bb8ab451d0a11911c04145c8fb