working this outwip/romes/no-this-unit-id-ghc

11 files changed, 461 insertions, 398 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 1c26e1aaa9..cbd66d4a6e 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -198,317 +198,319 @@ names with uniques.  These ones are the *non* wired-in ones.  The
 wired in ones are defined in GHC.Builtin.Types etc.
 -}
 
-basicKnownKeyNames :: [Name]  -- See Note [Known-key names]
+basicKnownKeyNames :: IO [Name]  -- See Note [Known-key names]
 basicKnownKeyNames
- = genericTyConNames
- ++ [   --  Classes.  *Must* include:
-        --      classes that are grabbed by key (e.g., eqClassKey)
-        --      classes in "Class.standardClassKeys" (quite a few)
-        eqClassName,                    -- mentioned, derivable
-        ordClassName,                   -- derivable
-        boundedClassName,               -- derivable
-        numClassName,                   -- mentioned, numeric
-        enumClassName,                  -- derivable
-        monadClassName,
-        functorClassName,
-        realClassName,                  -- numeric
-        integralClassName,              -- numeric
-        fractionalClassName,            -- numeric
-        floatingClassName,              -- numeric
-        realFracClassName,              -- numeric
-        realFloatClassName,             -- numeric
-        dataClassName,
-        isStringClassName,
-        applicativeClassName,
-        alternativeClassName,
-        foldableClassName,
-        traversableClassName,
-        semigroupClassName, sappendName,
-        monoidClassName, memptyName, mappendName, mconcatName,
-
-        -- The IO type
-        ioTyConName, ioDataConName,
-        runMainIOName,
-        runRWName,
-
-        -- Type representation types
-        trModuleTyConName, trModuleDataConName,
-        trNameTyConName, trNameSDataConName, trNameDDataConName,
-        trTyConTyConName, trTyConDataConName,
-
-        -- Typeable
-        typeableClassName,
-        typeRepTyConName,
-        someTypeRepTyConName,
-        someTypeRepDataConName,
-        kindRepTyConName,
-        kindRepTyConAppDataConName,
-        kindRepVarDataConName,
-        kindRepAppDataConName,
-        kindRepFunDataConName,
-        kindRepTYPEDataConName,
-        kindRepTypeLitSDataConName,
-        kindRepTypeLitDDataConName,
-        typeLitSortTyConName,
-        typeLitSymbolDataConName,
-        typeLitNatDataConName,
-        typeLitCharDataConName,
-        typeRepIdName,
-        mkTrTypeName,
-        mkTrConName,
-        mkTrAppName,
-        mkTrFunName,
-        typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,
-        trGhcPrimModuleName,
-
-        -- KindReps for common cases
-        starKindRepName,
-        starArrStarKindRepName,
-        starArrStarArrStarKindRepName,
-        constraintKindRepName,
-
-        -- WithDict
-        withDictClassName,
-
-        -- Dynamic
-        toDynName,
-
-        -- Numeric stuff
-        negateName, minusName, geName, eqName,
-        mkRationalBase2Name, mkRationalBase10Name,
-
-        -- Conversion functions
-        rationalTyConName,
-        ratioTyConName, ratioDataConName,
-        fromRationalName, fromIntegerName,
-        toIntegerName, toRationalName,
-        fromIntegralName, realToFracName,
-
-        -- Int# stuff
-        divIntName, modIntName,
-
-        -- String stuff
-        fromStringName,
-
-        -- Enum stuff
-        enumFromName, enumFromThenName,
-        enumFromThenToName, enumFromToName,
-
-        -- Applicative stuff
-        pureAName, apAName, thenAName,
-
-        -- Functor stuff
-        fmapName,
-
-        -- Monad stuff
-        thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,
-        returnMName, joinMName,
-
-        -- MonadFail
-        monadFailClassName, failMName,
-
-        -- MonadFix
-        monadFixClassName, mfixName,
-
-        -- Arrow stuff
-        arrAName, composeAName, firstAName,
-        appAName, choiceAName, loopAName,
-
-        -- Ix stuff
-        ixClassName,
-
-        -- Show stuff
-        showClassName,
-
-        -- Read stuff
-        readClassName,
-
-        -- Stable pointers
-        newStablePtrName,
-
-        -- GHC Extensions
-        considerAccessibleName,
-
-        -- Strings and lists
-        unpackCStringName, unpackCStringUtf8Name,
-        unpackCStringAppendName, unpackCStringAppendUtf8Name,
-        unpackCStringFoldrName, unpackCStringFoldrUtf8Name,
-        cstringLengthName,
-
-        -- Overloaded lists
-        isListClassName,
-        fromListName,
-        fromListNName,
-        toListName,
-
-        -- Non-empty lists
-        nonEmptyTyConName,
-
-        -- Overloaded record dot, record update
-        getFieldName, setFieldName,
-
-        -- List operations
-        concatName, filterName, mapName,
-        zipName, foldrName, buildName, augmentName, appendName,
-
-        -- FFI primitive types that are not wired-in.
-        stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
-        int8TyConName, int16TyConName, int32TyConName, int64TyConName,
-        word8TyConName, word16TyConName, word32TyConName, word64TyConName,
-
-        -- Others
-        otherwiseIdName, inlineIdName,
-        eqStringName, assertName,
-        assertErrorName, traceName,
-        printName,
-        dollarName,
-
-        -- ghc-bignum
-        integerFromNaturalName,
-        integerToNaturalClampName,
-        integerToNaturalThrowName,
-        integerToNaturalName,
-        integerToWordName,
-        integerToIntName,
-        integerToWord64Name,
-        integerToInt64Name,
-        integerFromWordName,
-        integerFromWord64Name,
-        integerFromInt64Name,
-        integerAddName,
-        integerMulName,
-        integerSubName,
-        integerNegateName,
-        integerAbsName,
-        integerPopCountName,
-        integerQuotName,
-        integerRemName,
-        integerDivName,
-        integerModName,
-        integerDivModName,
-        integerQuotRemName,
-        integerEncodeFloatName,
-        integerEncodeDoubleName,
-        integerGcdName,
-        integerLcmName,
-        integerAndName,
-        integerOrName,
-        integerXorName,
-        integerComplementName,
-        integerBitName,
-        integerTestBitName,
-        integerShiftLName,
-        integerShiftRName,
-
-        naturalToWordName,
-        naturalPopCountName,
-        naturalShiftRName,
-        naturalShiftLName,
-        naturalAddName,
-        naturalSubName,
-        naturalSubThrowName,
-        naturalSubUnsafeName,
-        naturalMulName,
-        naturalQuotRemName,
-        naturalQuotName,
-        naturalRemName,
-        naturalAndName,
-        naturalAndNotName,
-        naturalOrName,
-        naturalXorName,
-        naturalTestBitName,
-        naturalBitName,
-        naturalGcdName,
-        naturalLcmName,
-        naturalLog2Name,
-        naturalLogBaseWordName,
-        naturalLogBaseName,
-        naturalPowModName,
-        naturalSizeInBaseName,
-
-        bignatFromWordListName,
-        bignatEqName,
-
-        -- Float/Double
-        integerToFloatName,
-        integerToDoubleName,
-        naturalToFloatName,
-        naturalToDoubleName,
-        rationalToFloatName,
-        rationalToDoubleName,
-
-        -- Other classes
-        monadPlusClassName,
-
-        -- Type-level naturals
-        knownNatClassName, knownSymbolClassName, knownCharClassName,
-
-        -- Overloaded labels
-        fromLabelClassOpName,
-
-        -- Implicit Parameters
-        ipClassName,
-
-        -- Overloaded record fields
-        hasFieldClassName,
-
-        -- Call Stacks
-        callStackTyConName,
-        emptyCallStackName, pushCallStackName,
-
-        -- Source Locations
-        srcLocDataConName,
-
-        -- Annotation type checking
-        toAnnotationWrapperName
-
-        -- The SPEC type for SpecConstr
-        , specTyConName
-
-        -- The Either type
-        , eitherTyConName, leftDataConName, rightDataConName
-
-        -- The Void type
-        , voidTyConName
-
+ = sequence [
         -- Plugins
-        , pluginTyConName
+          pluginTyConName
         , frontendPluginTyConName
-
-        -- Generics
-        , genClassName, gen1ClassName
-        , datatypeClassName, constructorClassName, selectorClassName
-
-        -- Monad comprehensions
-        , guardMName
-        , liftMName
-        , mzipName
-
-        -- GHCi Sandbox
-        , ghciIoClassName, ghciStepIoMName
-
-        -- StaticPtr
-        , makeStaticName
-        , staticPtrTyConName
-        , staticPtrDataConName, staticPtrInfoDataConName
-        , fromStaticPtrName
-
-        -- Fingerprint
-        , fingerprintDataConName
-
-        -- Custom type errors
-        , errorMessageTypeErrorFamName
-        , typeErrorTextDataConName
-        , typeErrorAppendDataConName
-        , typeErrorVAppendDataConName
-        , typeErrorShowTypeDataConName
-
-        -- Unsafe coercion proofs
-        , unsafeEqualityProofName
-        , unsafeEqualityTyConName
-        , unsafeReflDataConName
-        , unsafeCoercePrimName
-    ]
+  ] >>= \ioknownnames ->
+    pure (ioknownnames ++
+    genericTyConNames
+  ++ [   --  Classes.  *Must* include:
+          --      classes that are grabbed by key (e.g., eqClassKey)
+          --      classes in "Class.standardClassKeys" (quite a few)
+          eqClassName,                    -- mentioned, derivable
+          ordClassName,                   -- derivable
+          boundedClassName,               -- derivable
+          numClassName,                   -- mentioned, numeric
+          enumClassName,                  -- derivable
+          monadClassName,
+          functorClassName,
+          realClassName,                  -- numeric
+          integralClassName,              -- numeric
+          fractionalClassName,            -- numeric
+          floatingClassName,              -- numeric
+          realFracClassName,              -- numeric
+          realFloatClassName,             -- numeric
+          dataClassName,
+          isStringClassName,
+          applicativeClassName,
+          alternativeClassName,
+          foldableClassName,
+          traversableClassName,
+          semigroupClassName, sappendName,
+          monoidClassName, memptyName, mappendName, mconcatName,
+
+          -- The IO type
+          ioTyConName, ioDataConName,
+          runMainIOName,
+          runRWName,
+
+          -- Type representation types
+          trModuleTyConName, trModuleDataConName,
+          trNameTyConName, trNameSDataConName, trNameDDataConName,
+          trTyConTyConName, trTyConDataConName,
+
+          -- Typeable
+          typeableClassName,
+          typeRepTyConName,
+          someTypeRepTyConName,
+          someTypeRepDataConName,
+          kindRepTyConName,
+          kindRepTyConAppDataConName,
+          kindRepVarDataConName,
+          kindRepAppDataConName,
+          kindRepFunDataConName,
+          kindRepTYPEDataConName,
+          kindRepTypeLitSDataConName,
+          kindRepTypeLitDDataConName,
+          typeLitSortTyConName,
+          typeLitSymbolDataConName,
+          typeLitNatDataConName,
+          typeLitCharDataConName,
+          typeRepIdName,
+          mkTrTypeName,
+          mkTrConName,
+          mkTrAppName,
+          mkTrFunName,
+          typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,
+          trGhcPrimModuleName,
+
+          -- KindReps for common cases
+          starKindRepName,
+          starArrStarKindRepName,
+          starArrStarArrStarKindRepName,
+          constraintKindRepName,
+
+          -- WithDict
+          withDictClassName,
+
+          -- Dynamic
+          toDynName,
+
+          -- Numeric stuff
+          negateName, minusName, geName, eqName,
+          mkRationalBase2Name, mkRationalBase10Name,
+
+          -- Conversion functions
+          rationalTyConName,
+          ratioTyConName, ratioDataConName,
+          fromRationalName, fromIntegerName,
+          toIntegerName, toRationalName,
+          fromIntegralName, realToFracName,
+
+          -- Int# stuff
+          divIntName, modIntName,
+
+          -- String stuff
+          fromStringName,
+
+          -- Enum stuff
+          enumFromName, enumFromThenName,
+          enumFromThenToName, enumFromToName,
+
+          -- Applicative stuff
+          pureAName, apAName, thenAName,
+
+          -- Functor stuff
+          fmapName,
+
+          -- Monad stuff
+          thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,
+          returnMName, joinMName,
+
+          -- MonadFail
+          monadFailClassName, failMName,
+
+          -- MonadFix
+          monadFixClassName, mfixName,
+
+          -- Arrow stuff
+          arrAName, composeAName, firstAName,
+          appAName, choiceAName, loopAName,
+
+          -- Ix stuff
+          ixClassName,
+
+          -- Show stuff
+          showClassName,
+
+          -- Read stuff
+          readClassName,
+
+          -- Stable pointers
+          newStablePtrName,
+
+          -- GHC Extensions
+          considerAccessibleName,
+
+          -- Strings and lists
+          unpackCStringName, unpackCStringUtf8Name,
+          unpackCStringAppendName, unpackCStringAppendUtf8Name,
+          unpackCStringFoldrName, unpackCStringFoldrUtf8Name,
+          cstringLengthName,
+
+          -- Overloaded lists
+          isListClassName,
+          fromListName,
+          fromListNName,
+          toListName,
+
+          -- Non-empty lists
+          nonEmptyTyConName,
+
+          -- Overloaded record dot, record update
+          getFieldName, setFieldName,
+
+          -- List operations
+          concatName, filterName, mapName,
+          zipName, foldrName, buildName, augmentName, appendName,
+
+          -- FFI primitive types that are not wired-in.
+          stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
+          int8TyConName, int16TyConName, int32TyConName, int64TyConName,
+          word8TyConName, word16TyConName, word32TyConName, word64TyConName,
+
+          -- Others
+          otherwiseIdName, inlineIdName,
+          eqStringName, assertName,
+          assertErrorName, traceName,
+          printName,
+          dollarName,
+
+          -- ghc-bignum
+          integerFromNaturalName,
+          integerToNaturalClampName,
+          integerToNaturalThrowName,
+          integerToNaturalName,
+          integerToWordName,
+          integerToIntName,
+          integerToWord64Name,
+          integerToInt64Name,
+          integerFromWordName,
+          integerFromWord64Name,
+          integerFromInt64Name,
+          integerAddName,
+          integerMulName,
+          integerSubName,
+          integerNegateName,
+          integerAbsName,
+          integerPopCountName,
+          integerQuotName,
+          integerRemName,
+          integerDivName,
+          integerModName,
+          integerDivModName,
+          integerQuotRemName,
+          integerEncodeFloatName,
+          integerEncodeDoubleName,
+          integerGcdName,
+          integerLcmName,
+          integerAndName,
+          integerOrName,
+          integerXorName,
+          integerComplementName,
+          integerBitName,
+          integerTestBitName,
+          integerShiftLName,
+          integerShiftRName,
+
+          naturalToWordName,
+          naturalPopCountName,
+          naturalShiftRName,
+          naturalShiftLName,
+          naturalAddName,
+          naturalSubName,
+          naturalSubThrowName,
+          naturalSubUnsafeName,
+          naturalMulName,
+          naturalQuotRemName,
+          naturalQuotName,
+          naturalRemName,
+          naturalAndName,
+          naturalAndNotName,
+          naturalOrName,
+          naturalXorName,
+          naturalTestBitName,
+          naturalBitName,
+          naturalGcdName,
+          naturalLcmName,
+          naturalLog2Name,
+          naturalLogBaseWordName,
+          naturalLogBaseName,
+          naturalPowModName,
+          naturalSizeInBaseName,
+
+          bignatFromWordListName,
+          bignatEqName,
+
+          -- Float/Double
+          integerToFloatName,
+          integerToDoubleName,
+          naturalToFloatName,
+          naturalToDoubleName,
+          rationalToFloatName,
+          rationalToDoubleName,
+
+          -- Other classes
+          monadPlusClassName,
+
+          -- Type-level naturals
+          knownNatClassName, knownSymbolClassName, knownCharClassName,
+
+          -- Overloaded labels
+          fromLabelClassOpName,
+
+          -- Implicit Parameters
+          ipClassName,
+
+          -- Overloaded record fields
+          hasFieldClassName,
+
+          -- Call Stacks
+          callStackTyConName,
+          emptyCallStackName, pushCallStackName,
+
+          -- Source Locations
+          srcLocDataConName,
+
+          -- Annotation type checking
+          toAnnotationWrapperName
+
+          -- The SPEC type for SpecConstr
+          , specTyConName
+
+          -- The Either type
+          , eitherTyConName, leftDataConName, rightDataConName
+
+          -- The Void type
+          , voidTyConName
+
+          -- Generics
+          , genClassName, gen1ClassName
+          , datatypeClassName, constructorClassName, selectorClassName
+
+          -- Monad comprehensions
+          , guardMName
+          , liftMName
+          , mzipName
+
+          -- GHCi Sandbox
+          , ghciIoClassName, ghciStepIoMName
+
+          -- StaticPtr
+          , makeStaticName
+          , staticPtrTyConName
+          , staticPtrDataConName, staticPtrInfoDataConName
+          , fromStaticPtrName
+
+          -- Fingerprint
+          , fingerprintDataConName
+
+          -- Custom type errors
+          , errorMessageTypeErrorFamName
+          , typeErrorTextDataConName
+          , typeErrorAppendDataConName
+          , typeErrorVAppendDataConName
+          , typeErrorShowTypeDataConName
+
+          -- Unsafe coercion proofs
+          , unsafeEqualityProofName
+          , unsafeEqualityTyConName
+          , unsafeReflDataConName
+          , unsafeCoercePrimName
+      ])
 
 genericTyConNames :: [Name]
 genericTyConNames = [
@@ -1631,12 +1633,12 @@ srcLocDataConName
   = dcQual gHC_STACK_TYPES  (fsLit "SrcLoc")    srcLocDataConKey
 
 -- plugins
-pLUGINS :: Module
-pLUGINS = mkThisGhcModule (fsLit "GHC.Driver.Plugins")
-pluginTyConName :: Name
-pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey
-frontendPluginTyConName :: Name
-frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPluginTyConKey
+pLUGINS :: IO Module
+pLUGINS = pure $ mkThisGhcModule (fsLit "GHC.Driver.Plugins")
+pluginTyConName :: IO Name
+pluginTyConName = pLUGINS >>= \plugin_mod -> pure (tcQual plugin_mod (fsLit "Plugin") pluginTyConKey)
+frontendPluginTyConName :: IO Name
+frontendPluginTyConName = pLUGINS >>= \plugin_mod -> pure (tcQual plugin_mod (fsLit "FrontendPlugin") frontendPluginTyConKey)
 
 -- Static pointers
 makeStaticName :: Name
diff --git a/compiler/GHC/Builtin/Utils.hs b/compiler/GHC/Builtin/Utils.hs
index a815c5e5bb..eb51d47178 100644
--- a/compiler/GHC/Builtin/Utils.hs
+++ b/compiler/GHC/Builtin/Utils.hs
@@ -113,7 +113,7 @@ Note [About wired-in things]
 -- | This list is used to ensure that when you say "Prelude.map" in your source
 -- code, or in an interface file, you get a Name with the correct known key (See
 -- Note [Known-key names] in "GHC.Builtin.Names")
-knownKeyNames :: [Name]
+knownKeyNames :: IO [Name]
 knownKeyNames
   | debugIsOn
   , Just badNamesStr <- knownKeyNamesOkay all_names
@@ -123,7 +123,7 @@ knownKeyNames
        -- "<<details unavailable>>" error. (This seems to happen only in the
        -- stage 2 compiler, for reasons I [Richard] have no clue of.)
   | otherwise
-  = all_names
+  = (++) all_names <$> basicKnownKeyNames 
   where
     all_names =
       concat [ concatMap wired_tycon_kk_names primTyCons
@@ -132,7 +132,6 @@ knownKeyNames
              , map idName wiredInIds
              , map idName allThePrimOpIds
              , map (idName . primOpWrapperId) allThePrimOps
-             , basicKnownKeyNames
              , templateHaskellNames
              ]
     -- All of the names associated with a wired-in TyCon.
@@ -189,22 +188,22 @@ knownKeyNamesOkay all_names
 
 -- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
 -- known-key thing.
-lookupKnownKeyName :: Unique -> Maybe Name
+lookupKnownKeyName :: Unique -> IO (Maybe Name)
 lookupKnownKeyName u =
-    knownUniqueName u <|> lookupUFM_Directly knownKeysMap u
+    (knownUniqueName u <|>) . flip lookupUFM_Directly u <$> knownKeysMap 
 
 -- | Is a 'Name' known-key?
-isKnownKeyName :: Name -> Bool
+isKnownKeyName :: Name -> IO Bool
 isKnownKeyName n =
-    isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap
+    (isJust (knownUniqueName $ nameUnique n) ||) . elemUFM n <$> knownKeysMap
 
 -- | Maps 'Unique's to known-key names.
 --
 -- The type is @UniqFM Name Name@ to denote that the 'Unique's used
 -- in the domain are 'Unique's associated with 'Name's (as opposed
 -- to some other namespace of 'Unique's).
-knownKeysMap :: UniqFM Name Name
-knownKeysMap = listToIdentityUFM knownKeyNames
+knownKeysMap :: IO (UniqFM Name Name)
+knownKeysMap = listToIdentityUFM <$> knownKeyNames
 
 -- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
 -- GHCi's ':info' command.
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 97a47c8df6..a879e4b011 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -305,7 +305,8 @@ newHscEnv top_dir dflags = newHscEnvWithHUG top_dir dflags (homeUnitId_ dflags)
 
 newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv
 newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do
-    nc_var  <- initNameCache 'r' knownKeyNames
+    knownKeyNames' <- 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 a1611fe263..649cf5972a 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BinaryLiterals, ScopedTypeVariables #-}
+{-# LANGUAGE BinaryLiterals, ScopedTypeVariables, LambdaCase #-}
 
 --
 --  (c) The University of Glasgow 2002-2006
@@ -336,18 +336,17 @@ putName _dict BinSymbolTable{
                bin_symtab_map = symtab_map_ref,
                bin_symtab_next = symtab_next }
         bh name
-  | isKnownKeyName name
-  , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
   = -- assert (u < 2^(22 :: Int))
-    put_ bh (0x80000000
-             .|. (fromIntegral (ord c) `shiftL` 22)
-             .|. (fromIntegral u :: Word32))
-
-  | otherwise
-  = do symtab_map <- readIORef symtab_map_ref
-       case lookupUFM symtab_map name of
-         Just (off,_) -> put_ bh (fromIntegral off :: Word32)
-         Nothing -> do
+  isKnownKeyName name >>= \case
+    True -> let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
+            in put_ bh (0x80000000
+                  .|. (fromIntegral (ord c) `shiftL` 22)
+                  .|. (fromIntegral u :: Word32))
+    False -> do
+      symtab_map <- readIORef symtab_map_ref
+      case lookupUFM symtab_map name of
+        Just (off,_) -> put_ bh (fromIntegral off :: Word32)
+        Nothing -> do
             off <- readFastMutInt symtab_next
             -- massert (off < 2^(30 :: Int))
             writeFastMutInt symtab_next (off+1)
@@ -370,10 +369,10 @@ getSymtabName _name_cache _dict symtab bh = do
           ix  = fromIntegral i .&. 0x003FFFFF
           u   = mkUnique tag ix
         in
-          return $! case lookupKnownKeyName u of
-                      Nothing -> pprPanic "getSymtabName:unknown known-key unique"
-                                          (ppr i $$ ppr u $$ char tag $$ ppr ix)
-                      Just n  -> n
+          lookupKnownKeyName u >>= \case
+            Nothing -> pprPanic "getSymtabName:unknown known-key unique"
+                                (ppr i $$ ppr u $$ char tag $$ ppr ix)
+            Just n  -> return $! n
 
       _ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
 
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 6474fbeb8e..25b97b94d1 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -3,6 +3,7 @@ Binary serialization for .hie files.
 -}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
 
 module GHC.Iface.Ext.Binary
    ( readHieFile
@@ -291,15 +292,18 @@ putName (HieSymbolTable next ref) bh name = do
       let hieName = ExternalName mod occ (nameSrcSpan name)
       writeIORef ref $! addToUFM symmap name (off, hieName)
       put_ bh (fromIntegral off :: Word32)
-    Just (off, LocalName _occ span)
-      | notLocal (toHieName name) || nameSrcSpan name /= span -> do
-      writeIORef ref $! addToUFM symmap name (off, toHieName name)
-      put_ bh (fromIntegral off :: Word32)
+    Just (off, LocalName _occ span) -> do
+      hieName <- toHieName name
+      if notLocal (hieName) || nameSrcSpan name /= span then do
+        writeIORef ref $! addToUFM symmap name (off, hieName)
+        put_ bh (fromIntegral off :: Word32)
+      else put_ bh (fromIntegral off :: Word32) -- ROMES:TODO can we not duplicate this here as below?
     Just (off, _) -> put_ bh (fromIntegral off :: Word32)
     Nothing -> do
+        hieName <- toHieName name
         off <- readFastMutInt next
         writeFastMutInt next (off+1)
-        writeIORef ref $! addToUFM symmap name (off, toHieName name)
+        writeIORef ref $! addToUFM symmap name (off, hieName)
         put_ bh (fromIntegral off :: Word32)
 
   where
@@ -328,7 +332,7 @@ fromHieName nc hie_name = do
       -- don't update the NameCache for local names
       pure $ mkInternalName uniq occ span
 
-    KnownKeyName u -> case lookupKnownKeyName u of
+    KnownKeyName u -> lookupKnownKeyName u >>= \case
       Nothing -> pprPanic "fromHieName:unknown known-key unique"
                           (ppr u)
       Just n -> pure n
diff --git a/compiler/GHC/Iface/Ext/Debug.hs b/compiler/GHC/Iface/Ext/Debug.hs
index ef63a3f4dc..8844781636 100644
--- a/compiler/GHC/Iface/Ext/Debug.hs
+++ b/compiler/GHC/Iface/Ext/Debug.hs
@@ -22,6 +22,8 @@ import qualified Data.Set as S
 import Data.Function    ( on )
 import Data.List        ( sortOn )
 
+import System.IO.Unsafe ( unsafePerformIO )
+
 type Diff a = a -> a -> [SDoc]
 
 diffFile :: Diff HieFile
@@ -64,10 +66,10 @@ diffAst diffType (Node info1 span1 xs1) (Node info2 span2 xs2) =
 type DiffIdent = Either ModuleName HieName
 
 normalizeIdents :: Ord a => NodeIdentifiers a -> [(DiffIdent,IdentifierDetails a)]
-normalizeIdents = sortOn go . map (first toHieName) . M.toList
+normalizeIdents = sortOn go . map (first (unsafePerformIO . toHieName)) . M.toList
   where
     first f (a,b) = (fmap f a, b)
-    go (a,b) = (hieNameOcc <$> a,identInfo b,identType b)
+    go (a,b) = (unsafePerformIO . hieNameOcc <$> a,identInfo b,identType b)
 
 diffList :: Diff a -> Diff [a]
 diffList f xs ys
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index b8a398465c..07ff410b09 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DeriveTraversable          #-}
 {-# LANGUAGE FlexibleInstances          #-}
@@ -42,6 +43,8 @@ import Data.Coerce                ( coerce  )
 import Data.Function              ( on )
 import qualified Data.Semigroup as S
 
+import System.IO.Unsafe ( unsafePerformIO )
+
 type Span = RealSrcSpan
 
 -- | Current version of @.hie@ files
@@ -581,10 +584,10 @@ newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [Name] }
   deriving Outputable
 
 instance Eq EvBindDeps where
-  (==) = coerce ((==) `on` map toHieName)
+  (==) = coerce ((==) `on` map (unsafePerformIO . toHieName))
 
 instance Ord EvBindDeps where
-  compare = coerce (compare `on` map toHieName)
+  compare = coerce (compare `on` map (unsafePerformIO . toHieName))
 
 instance Binary EvBindDeps where
   put_ bh (EvBindDeps xs) = put_ bh xs
@@ -767,19 +770,25 @@ instance Outputable HieName where
   ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
   ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
 
-hieNameOcc :: HieName -> OccName
-hieNameOcc (ExternalName _ occ _) = occ
-hieNameOcc (LocalName occ _) = occ
+-- Why do we need IO? See Note [Looking up known key names]
+hieNameOcc :: HieName -> IO OccName
+hieNameOcc (ExternalName _ occ _) = pure occ
+hieNameOcc (LocalName occ _) = pure occ
 hieNameOcc (KnownKeyName u) =
-  case lookupKnownKeyName u of
-    Just n -> nameOccName n
+  lookupKnownKeyName u >>= \case
+    Just n -> pure (nameOccName n)
     Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
                         (ppr u)
 
-toHieName :: Name -> HieName
-toHieName name
-  | isKnownKeyName name = KnownKeyName (nameUnique name)
-  | isExternalName name = ExternalName (nameModule name)
-                                       (nameOccName name)
-                                       (removeBufSpan $ nameSrcSpan name)
-  | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name)
+-- Why do we need IO? See Note [Looking up known key names]
+toHieName :: Name -> IO HieName
+toHieName name =
+  isKnownKeyName name >>= \case
+    True -> pure (KnownKeyName (nameUnique name))
+    False
+      | isExternalName name ->
+        pure $ ExternalName (nameModule name)
+                            (nameOccName name)
+                            (removeBufSpan $ nameSrcSpan name)
+      | otherwise ->
+        pure $ LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name)
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index b59071d5f6..53f4a100d4 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -138,15 +138,17 @@ loadPlugins hsc_env
       where
         options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
                             , opt_mod_nm == mod_nm ]
-    loadPlugin = loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName hsc_env
+    loadPlugin p = pluginTyConName >>= \pluginTyConName' -> loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName' hsc_env p
 
 
 loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded)
 loadFrontendPlugin hsc_env mod_name = do
     checkExternalInterpreter hsc_env
     (plugin, _iface, links, pkgs)
-      <- loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTyConName
-           hsc_env mod_name
+      <- frontendPluginTyConName >>=
+        \frontendPluginTCN -> 
+          loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTCN
+            hsc_env mod_name
     return (plugin, links, pkgs)
 
 -- #14335
@@ -168,7 +170,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
                           [ text "The module", ppr mod_name
                           , text "did not export the plugin name"
                           , ppr plugin_rdr_name ]) ;
-            Just (name, mod_iface) ->
+            Just (name, mod_iface) -> pprTrace "ROMES: Current unit" (ppr . ue_current_unit . hsc_unit_env $ hsc_env) $
 
      do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name
         ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs
index d4ee8abef2..cc0929c4bc 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs
+++ b/compiler/GHC/Tc/Errors/Hole.hs
@@ -597,6 +597,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
      ; traceTc "hole_lvl is:" $ ppr hole_lvl
      ; traceTc "simples are: " $ ppr simples
      ; traceTc "locals are: " $ ppr lclBinds
+     ; builtIns' <- liftIO builtIns
      ; let (lcl, gbl) = partition gre_lcl (globalRdrEnvElts rdr_env)
            -- We remove binding shadowings here, but only for the local level.
            -- this is so we e.g. suggest the global fmap from the Functor class
@@ -605,7 +606,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
            locals = removeBindingShadowing $
                       map IdHFCand lclBinds ++ map GreHFCand lcl
            globals = map GreHFCand gbl
-           syntax = map NameHFCand builtIns
+           syntax = map NameHFCand builtIns'
            -- If the hole is a rigid type-variable, then we only check the
            -- locals, since only they can match the type (in a meaningful way).
            only_locals = any isImmutableTyVar $ getTyVar_maybe hole_ty
@@ -663,8 +664,8 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
     hole_lvl = ctLocLevel ct_loc
 
     -- BuiltInSyntax names like (:) and []
-    builtIns :: [Name]
-    builtIns = filter isBuiltInSyntax knownKeyNames
+    builtIns :: IO [Name]
+    builtIns = filter isBuiltInSyntax <$> knownKeyNames
 
     -- We make a refinement type by adding a new type variable in front
     -- of the type of t h hole, going from e.g. [Integer] -> Integer
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index a72f53b366..b60f57da1d 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -108,6 +108,7 @@ import GHC.Utils.Exception
 import System.Directory
 import System.FilePath as FilePath
 import Control.Monad
+import Data.IORef
 import Data.Graph (stronglyConnComp, SCC(..))
 import Data.Char ( toUpper )
 import Data.List ( intersperse, partition, sortBy, isSuffixOf )
@@ -410,7 +411,7 @@ type ModuleNameProvidersMap =
     Map ModuleName (Map Module ModuleOrigin)
 
 data UnitState = UnitState {
-  -- | A mapping of 'Unit' to 'UnitInfo'.  This list is adjusted
+  -- | A mapping of 'UnitId' to 'UnitInfo'.  This list is adjusted
   -- so that only valid units are here.  'UnitInfo' reflects
   -- what was stored *on disk*, except for the 'trusted' flag, which
   -- is adjusted at runtime.  (In particular, some units in this map
@@ -430,6 +431,7 @@ data UnitState = UnitState {
   -- And also to resolve package qualifiers with the PackageImports extension.
   packageNameMap            :: UniqFM PackageName UnitId,
 
+  -- TODO: Remove these two completely?
   -- | A mapping from database unit keys to wired in unit ids.
   wireMap :: Map UnitId UnitId,
 
@@ -1096,8 +1098,9 @@ findWiredInUnits logger prec_map pkgs vis_map = do
   -- their canonical names (eg. base-1.0 ==> base), as described
   -- in Note [Wired-in units] in GHC.Unit.Types
   let
-        matches :: UnitInfo -> UnitId -> Bool
-        pc `matches` pid = unitPackageName pc == PackageName (unitIdFS pid)
+        -- Match a package name against a UnitInfo
+        matches :: UnitInfo -> FastString -> Bool
+        pc `matches` pname = unitPackageName pc == PackageName pname
 
         -- find which package corresponds to each wired-in package
         -- delete any other packages with the same name
@@ -1116,10 +1119,10 @@ findWiredInUnits logger prec_map pkgs vis_map = do
         -- this works even when there is no exposed wired in package
         -- available.
         --
-        findWiredInUnit :: [UnitInfo] -> UnitId -> IO (Maybe (UnitId, UnitInfo))
-        findWiredInUnit pkgs wired_pkg = firstJustsM [try all_exposed_ps, try all_ps, notfound]
+        findWiredInUnitByName :: [UnitInfo] -> FastString -> IO (Maybe (FastString, UnitInfo))
+        findWiredInUnitByName pkgs wired_pkg_name = firstJustsM [try all_exposed_ps, try all_ps, notfound] -- ROMES:TODO: In fact, here we ?
           where
-                all_ps = [ p | p <- pkgs, p `matches` wired_pkg ]
+                all_ps = [ p | p <- pkgs, p `matches` wired_pkg_name ]
                 all_exposed_ps = [ p | p <- all_ps, Map.member (mkUnit p) vis_map ]
 
                 try ps = case sortByPreference prec_map ps of
@@ -1129,26 +1132,27 @@ findWiredInUnits logger prec_map pkgs vis_map = do
                 notfound = do
                           debugTraceMsg logger 2 $
                             text "wired-in package "
-                                 <> ftext (unitIdFS wired_pkg)
+                                 <> ftext wired_pkg_name
                                  <> text " not found."
                           return Nothing
-                pick :: UnitInfo -> IO (UnitId, UnitInfo)
+
+                pick :: UnitInfo -> IO (FastString, UnitInfo)
                 pick pkg = do
                         debugTraceMsg logger 2 $
                             text "wired-in package "
-                                 <> ftext (unitIdFS wired_pkg)
+                                 <> ftext wired_pkg_name
                                  <> text " mapped to "
                                  <> ppr (unitId pkg)
-                        return (wired_pkg, pkg)
+                        return (wired_pkg_name, pkg)
 
 
-  mb_wired_in_pkgs <- mapM (findWiredInUnit pkgs) wiredInUnitIds
+  mb_wired_in_pkgs <- mapM (findWiredInUnitByName pkgs) wiredInUnitNames
   let
         wired_in_pkgs = catMaybes mb_wired_in_pkgs
 
         wiredInMap :: Map UnitId UnitId
         wiredInMap = Map.fromList
-          [ (unitId realUnitInfo, wiredInUnitId)
+          [ (unitId realUnitInfo, UnitId wiredInUnitId)
           | (wiredInUnitId, realUnitInfo) <- wired_in_pkgs
           , not (unitIsIndefinite realUnitInfo)
           ]
@@ -1608,6 +1612,7 @@ mkUnitState logger cfg = do
   -- package arguments we need to key against the old versions.
   --
   (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map2
+
   let pkg_db = mkUnitInfoMap pkgs2
 
   -- Update the visibility map, so we treat wired packages as visible.
@@ -1696,6 +1701,8 @@ mkUnitState logger cfg = do
          , requirementContext           = req_ctx
          , allowVirtualUnits            = unitConfigAllowVirtual cfg
          }
+
+  writeIORef workingThisOut (unwireMap state)
   return (state, raw_dbs)
 
 selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 7439ab7dde..ee59365da6 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -24,6 +24,8 @@ module GHC.Unit.Types
    , pprInstantiatedModule
    , moduleFreeHoles
 
+   , workingThisOut
+
      -- * Units
    , IsUnitId
    , GenUnit (..)
@@ -79,7 +81,7 @@ module GHC.Unit.Types
    , interactiveUnit
 
    , isInteractiveModule
-   , wiredInUnitIds
+   , wiredInUnitNames
 
      -- * Boot modules
    , IsBootInterface (..)
@@ -105,12 +107,23 @@ import Data.Data
 import Data.List (sortBy )
 import Data.Function
 import Data.Bifunctor
+import Data.IORef
+import Data.Map (Map)
+import qualified Data.Map as Map
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS.Char8
 
+import System.IO.Unsafe
+
 import Language.Haskell.Syntax.Module.Name
 import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (IsBootInterface(..))
 
+-- Ref for an "unwireMap" which maps wired-in ids to actual units, created by
+-- identifying wired-in packages in the list of package-id flags
+workingThisOut :: IORef (Map UnitId UnitId)
+workingThisOut = unsafePerformIO (newIORef (Map.singleton (UnitId $ fsLit "ouch-version") (UnitId $ fsLit "ouch")))
+{-# NOINLINE workingThisOut #-}
+
 ---------------------------------------------------------------------
 -- MODULES
 ---------------------------------------------------------------------
@@ -587,19 +600,35 @@ Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here.
 
 -}
 
+bignumUnitName, primUnitName, baseUnitName, rtsUnitName,
+  thUnitName, mainUnitName, thisGhcUnitName, interactiveUnitName :: FastString
+
 bignumUnitId, primUnitId, baseUnitId, rtsUnitId,
   thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId  :: UnitId
 
 bignumUnit, primUnit, baseUnit, rtsUnit,
   thUnit, mainUnit, thisGhcUnit, interactiveUnit  :: Unit
 
-primUnitId        = UnitId (fsLit "ghc-prim")
-bignumUnitId      = UnitId (fsLit "ghc-bignum")
-baseUnitId        = UnitId (fsLit "base")
-rtsUnitId         = UnitId (fsLit "rts")
-thisGhcUnitId     = UnitId (fsLit "ghc")
-interactiveUnitId = UnitId (fsLit "interactive")
-thUnitId          = UnitId (fsLit "template-haskell")
+primUnitName        = fsLit "ghc-prim"
+bignumUnitName      = fsLit "ghc-bignum"
+baseUnitName        = fsLit "base"
+rtsUnitName         = fsLit "rts"
+thisGhcUnitName     = fsLit "ghc"
+interactiveUnitName = fsLit "interactive"
+thUnitName          = fsLit "template-haskell"
+
+primUnitId        = UnitId primUnitName
+bignumUnitId      = UnitId bignumUnitName
+baseUnitId        = UnitId baseUnitName
+rtsUnitId         = UnitId rtsUnitName
+thisGhcUnitId     = UnitId thisGhcUnitName
+interactiveUnitId = UnitId interactiveUnitName
+thUnitId          = mkWiredInUnitId thUnitName
+{-# INLINE bignumUnitId #-}
+{-# INLINE baseUnitId #-}
+{-# INLINE rtsUnitId #-}
+{-# INLINE thisGhcUnitId #-}
+{-# INLINE thUnitId #-}
 
 thUnit            = RealUnit (Definite thUnitId)
 primUnit          = RealUnit (Definite primUnitId)
@@ -612,20 +641,28 @@ interactiveUnit   = RealUnit (Definite interactiveUnitId)
 -- | This is the package Id for the current program.  It is the default
 -- package Id if you don't specify a package name.  We don't add this prefix
 -- to symbol names, since there can be only one main package per program.
-mainUnitId = UnitId (fsLit "main")
+mainUnitName = fsLit "main"
+mainUnitId = UnitId mainUnitName
 mainUnit = RealUnit (Definite mainUnitId)
 
+-- Make the actual unit id the result of looking up the wired-in unit package name in the wire map
+mkWiredInUnitId :: FastString -> UnitId
+mkWiredInUnitId x = case Map.lookup (UnitId x) $ unsafePerformIO (readIORef workingThisOut) of
+                      Nothing -> pprTrace "Romes:Couldn't find UnitId" (ppr (UnitId x,unsafePerformIO (readIORef workingThisOut))) (UnitId $ fsLit "rts") -- this is a fallback, in which situations do we need a fallback? perhaps when booting the compiler with the rts?
+                      Just y -> pprTrace "Romes:Found in wire map" (ppr x <+> text "->" <> ppr y) y
+
+
 isInteractiveModule :: Module -> Bool
 isInteractiveModule mod = moduleUnit mod == interactiveUnit
 
-wiredInUnitIds :: [UnitId]
-wiredInUnitIds =
-   [ primUnitId
-   , bignumUnitId
-   , baseUnitId
-   , rtsUnitId
-   , thUnitId
-   , thisGhcUnitId
+wiredInUnitNames :: [FastString]
+wiredInUnitNames =
+   [ primUnitName
+   , bignumUnitName
+   , baseUnitName
+   , rtsUnitName
+   , thUnitName
+   , thisGhcUnitName
    ]
 
 ---------------------------------------------------------------------