    {-# LANGUAGE BinaryLiterals, CPP, ScopedTypeVariables, BangPatterns #-}

    --
    --  (c) The University of Glasgow 2002-2006
    --

    {-# OPTIONS_GHC -O2 #-}
    -- We always optimise this, otherwise performance of a non-optimised
    -- compiler is severely affected

    -- | Binary interface file support.
    module GHC.Iface.Binary (
            -- * Public API for interface file serialisation
            writeBinIface,
            readBinIface,
            readBinIface_,
            getSymtabName,
            getDictFastString,
            CheckHiWay(..),
            TraceBinIFace(..),
            getWithUserData,
            putWithUserData,

            -- * Internal serialisation functions
            getSymbolTable,
            putName,
            putDictionary,
            putFastString,
            putSymbolTable,
            BinSymbolTable(..),
            BinDictionary(..)

        ) where

    #include "HsVersions.h"

    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.Driver.Session
    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
    import GHC.Types.Name.Cache
    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.Unsafe
    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
    --

    data CheckHiWay = CheckHiWay | IgnoreHiWay
        deriving CheckHiWay -> CheckHiWay -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: CheckHiWay -> CheckHiWay -> Bool
    $c/= :: CheckHiWay -> CheckHiWay -> Bool
    == :: CheckHiWay -> CheckHiWay -> Bool
    $c== :: CheckHiWay -> CheckHiWay -> Bool
    Eq

    data TraceBinIFace
       = TraceBinIFace (SDoc -> IO ())
       | QuietBinIFace

    -- | Read an interface file
    readBinIface :: CheckHiWay -> TraceBinIFace -> FilePath
                 -> TcRnIf a b ModIface
    readBinIface :: forall a b.
    CheckHiWay -> TraceBinIFace -> String -> TcRnIf a b ModIface
    readBinIface CheckHiWay
    checkHiWay TraceBinIFace
    traceBinIFaceReading String
    hi_path = do
        NameCacheUpdater
    ncu <- forall a b. TcRnIf a b NameCacheUpdater
    mkNameCacheUpdater
        DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let profile :: Profile
    profile = DynFlags -> Profile
    targetProfile DynFlags
    dflags
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ Profile
    -> CheckHiWay
    -> TraceBinIFace
    -> String
    -> NameCacheUpdater
    -> IO ModIface
    readBinIface_ Profile
    profile CheckHiWay
    checkHiWay TraceBinIFace
    traceBinIFaceReading String
    hi_path NameCacheUpdater
    ncu

    -- | Read an interface file in 'IO'.
    readBinIface_ :: Profile -> CheckHiWay -> TraceBinIFace -> FilePath
                  -> NameCacheUpdater
                  -> IO ModIface
    readBinIface_ :: Profile
    -> CheckHiWay
    -> TraceBinIFace
    -> String
    -> NameCacheUpdater
    -> IO ModIface
    readBinIface_ Profile
    profile CheckHiWay
    checkHiWay TraceBinIFace
    traceBinIFace String
    hi_path NameCacheUpdater
    ncu = do
        let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

            wantedGot :: String -> a -> a -> (a -> SDoc) -> IO ()
            wantedGot :: forall a. String -> a -> a -> (a -> SDoc) -> IO ()
    wantedGot String
    what a
    wanted a
    got a -> SDoc
    ppr' =
                case TraceBinIFace
    traceBinIFace of
                   TraceBinIFace
    QuietBinIFace         -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                   TraceBinIFace SDoc -> IO ()
    printer -> SDoc -> IO ()
    printer forall a b. (a -> b) -> a -> b
    $
                         String -> SDoc
    text String
    what SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ": " SDoc -> SDoc -> SDoc
    <>
                         [SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "Wanted " SDoc -> SDoc -> SDoc
    <> a -> SDoc
    ppr' a
    wanted SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ",",
                               String -> SDoc
    text String
    "got    " SDoc -> SDoc -> SDoc
    <> a -> SDoc
    ppr' a
    got]

            errorOnMismatch :: (Eq a, Show a) => String -> a -> a -> IO ()
            errorOnMismatch :: forall a. (Eq a, Show a) => String -> a -> a -> IO ()
    errorOnMismatch String
    what a
    wanted a
    got =
                -- This will be caught by readIface which will emit an error
                -- msg containing the iface module name.
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (a
    wanted forall a. Eq a => a -> a -> Bool
    /= a
    got) forall a b. (a -> b) -> a -> b
    $ forall a. GhcException -> IO a
    throwGhcExceptionIO forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    ProgramError
                             (String
    what forall a. [a] -> [a] -> [a]
    ++ String
    " (wanted " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show a
    wanted
                                   forall a. [a] -> [a] -> [a]
    ++ String
    ", got "    forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show a
    got forall a. [a] -> [a] -> [a]
    ++ String
    ")")
        BinHandle
    bh <- String -> IO BinHandle
    Binary.readBinMem String
    hi_path

        -- Read the magic number to check that this really is a GHC .hi file
        -- (This magic number does not change when we change
        --  GHC interface file format)
        FixedLengthEncoding Word32
    magic <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        forall a. String -> a -> a -> (a -> SDoc) -> IO ()
    wantedGot String
    "Magic" (Platform -> FixedLengthEncoding Word32
    binaryInterfaceMagic Platform
    platform) FixedLengthEncoding Word32
    magic (forall a. Outputable a => a -> SDoc
    ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. FixedLengthEncoding a -> a
    unFixedLength)
        forall a. (Eq a, Show a) => String -> a -> a -> IO ()
    errorOnMismatch String
    "magic number mismatch: old/corrupt interface file?"
            (forall a. FixedLengthEncoding a -> a
    unFixedLength forall a b. (a -> b) -> a -> b
    $ Platform -> FixedLengthEncoding Word32
    binaryInterfaceMagic Platform
    platform) (forall a. FixedLengthEncoding a -> a
    unFixedLength FixedLengthEncoding Word32
    magic)

        -- Check the interface file version and profile tag.
        String
    check_ver  <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        let our_ver :: String
    our_ver = forall a. Show a => a -> String
    show Integer
    hiVersion
        forall a. String -> a -> a -> (a -> SDoc) -> IO ()
    wantedGot String
    "Version" String
    our_ver String
    check_ver String -> SDoc
    text
        forall a. (Eq a, Show a) => String -> a -> a -> IO ()
    errorOnMismatch String
    "mismatched interface file versions" String
    our_ver String
    check_ver

        String
    check_tag <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        let tag :: String
    tag = Profile -> String
    profileBuildTag Profile
    profile
        forall a. String -> a -> a -> (a -> SDoc) -> IO ()
    wantedGot String
    "Way" String
    tag String
    check_tag forall a. Outputable a => a -> SDoc
    ppr
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CheckHiWay
    checkHiWay forall a. Eq a => a -> a -> Bool
    == CheckHiWay
    CheckHiWay) forall a b. (a -> b) -> a -> b
    $
            forall a. (Eq a, Show a) => String -> a -> a -> IO ()
    errorOnMismatch String
    "mismatched interface file profile tag" String
    tag String
    check_tag

        Bin Any
    extFields_p <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

        ModIface
    mod_iface <- forall a. Binary a => NameCacheUpdater -> BinHandle -> IO a
    getWithUserData NameCacheUpdater
    ncu BinHandle
    bh

        forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    extFields_p
        ExtensibleFields
    extFields <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

        forall (m :: * -> *) a. Monad m => a -> m a
    return ModIface
    mod_iface{mi_ext_fields :: ExtensibleFields
    mi_ext_fields = ExtensibleFields
    extFields}

    -- | 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 :: forall a. Binary a => NameCacheUpdater -> BinHandle -> IO a
    getWithUserData NameCacheUpdater
    ncu BinHandle
    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)
        Bin Any
    dict_p <- forall a. Binary a => BinHandle -> IO a
    Binary.get BinHandle
    bh
        Bin Any
    data_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh          -- Remember where we are now
        forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    dict_p
        Dictionary
    dict   <- BinHandle -> IO Dictionary
    getDictionary BinHandle
    bh
        forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    data_p             -- Back to where we were before

        -- Initialise the user-data field of bh
        BinHandle
    bh <- do
            BinHandle
    bh <- forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh forall a b. (a -> b) -> a -> b
    $ (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
    newReadState (forall a. HasCallStack => String -> a
    error String
    "getSymtabName")
                                                         (Dictionary -> BinHandle -> IO FastString
    getDictFastString Dictionary
    dict)
            Bin Any
    symtab_p <- forall a. Binary a => BinHandle -> IO a
    Binary.get BinHandle
    bh     -- Get the symtab ptr
            Bin Any
    data_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh          -- Remember where we are now
            forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    symtab_p
            SymbolTable
    symtab <- BinHandle -> NameCacheUpdater -> IO SymbolTable
    getSymbolTable BinHandle
    bh NameCacheUpdater
    ncu
            forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    data_p             -- Back to where we were before

            -- It is only now that we know how to get a Name
            forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh forall a b. (a -> b) -> a -> b
    $ (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
    newReadState (NameCacheUpdater
    -> Dictionary -> SymbolTable -> BinHandle -> IO Name
    getSymtabName NameCacheUpdater
    ncu Dictionary
    dict SymbolTable
    symtab)
                                                   (Dictionary -> BinHandle -> IO FastString
    getDictFastString Dictionary
    dict)

        -- Read the interface file
        forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

    -- | Write an interface file
    writeBinIface :: Profile -> TraceBinIFace -> FilePath -> ModIface -> IO ()
    writeBinIface :: Profile -> TraceBinIFace -> String -> ModIface -> IO ()
    writeBinIface Profile
    profile TraceBinIFace
    traceBinIface String
    hi_path ModIface
    mod_iface = do
        BinHandle
    bh <- Int -> IO BinHandle
    openBinMem Int
    initBinMemSize
        let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Platform -> FixedLengthEncoding Word32
    binaryInterfaceMagic Platform
    platform)

        -- The version and profile tag go next
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (forall a. Show a => a -> String
    show Integer
    hiVersion)
        let tag :: String
    tag = Profile -> String
    profileBuildTag Profile
    profile
        forall a. Binary a => BinHandle -> a -> IO ()
    put_  BinHandle
    bh String
    tag

        Bin (Bin Any)
    extFields_p_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Bin (Bin Any)
    extFields_p_p

        forall a. Binary a => TraceBinIFace -> BinHandle -> a -> IO ()
    putWithUserData TraceBinIFace
    traceBinIface BinHandle
    bh ModIface
    mod_iface

        Bin Any
    extFields_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
        forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin (Bin Any)
    extFields_p_p Bin Any
    extFields_p
        forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    extFields_p
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (forall (phase :: ModIfacePhase).
    ModIface_ phase -> ExtensibleFields
    mi_ext_fields ModIface
    mod_iface)

        -- And send the result to the file
        BinHandle -> String -> IO ()
    writeBinMem BinHandle
    bh String
    hi_path

    -- | Put a piece of data with an initialised `UserData` field. This
    -- is necessary if you want to serialise Names or FastStrings.
    -- It also writes a symbol table and the dictionary.
    -- This segment should be read using `getWithUserData`.
    putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO ()
    putWithUserData :: forall a. Binary a => TraceBinIFace -> BinHandle -> a -> IO ()
    putWithUserData TraceBinIFace
    traceBinIface BinHandle
    bh a
    payload = do
        -- Remember where the dictionary pointer will go
        Bin (Bin Any)
    dict_p_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
        -- Placeholder for ptr to dictionary
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Bin (Bin Any)
    dict_p_p

        -- Remember where the symbol table pointer will go
        Bin (Bin Any)
    symtab_p_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Bin (Bin Any)
    symtab_p_p
        -- Make some initial state
        FastMutInt
    symtab_next <- Int -> IO FastMutInt
    newFastMutInt Int
    0
        IORef (UniqFM Name (Int, Name))
    symtab_map <- forall a. a -> IO (IORef a)
    newIORef forall key elt. UniqFM key elt
    emptyUFM
        let bin_symtab :: BinSymbolTable
    bin_symtab = BinSymbolTable {
                             bin_symtab_next :: FastMutInt
    bin_symtab_next = FastMutInt
    symtab_next,
                             bin_symtab_map :: IORef (UniqFM Name (Int, Name))
    bin_symtab_map  = IORef (UniqFM Name (Int, Name))
    symtab_map }
        FastMutInt
    dict_next_ref <- Int -> IO FastMutInt
    newFastMutInt Int
    0
        IORef (UniqFM FastString (Int, FastString))
    dict_map_ref <- forall a. a -> IO (IORef a)
    newIORef forall key elt. UniqFM key elt
    emptyUFM
        let bin_dict :: BinDictionary
    bin_dict = BinDictionary {
                           bin_dict_next :: FastMutInt
    bin_dict_next = FastMutInt
    dict_next_ref,
                           bin_dict_map :: IORef (UniqFM FastString (Int, FastString))
    bin_dict_map  = IORef (UniqFM FastString (Int, FastString))
    dict_map_ref }

        -- Put the main thing,
        BinHandle
    bh <- forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh forall a b. (a -> b) -> a -> b
    $ (BinHandle -> Name -> IO ())
    -> (BinHandle -> Name -> IO ())
    -> (BinHandle -> FastString -> IO ())
    -> UserData
    newWriteState (BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()
    putName BinDictionary
    bin_dict BinSymbolTable
    bin_symtab)
                                                      (BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()
    putName BinDictionary
    bin_dict BinSymbolTable
    bin_symtab)
                                                      (BinDictionary -> BinHandle -> FastString -> IO ()
    putFastString BinDictionary
    bin_dict)
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    payload

        -- Write the symtab pointer at the front of the file
        Bin Any
    symtab_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh        -- This is where the symtab will start
        forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin (Bin Any)
    symtab_p_p Bin Any
    symtab_p  -- Fill in the placeholder
        forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    symtab_p           -- Seek back to the end of the file

        -- Write the symbol table itself
        Int
    symtab_next <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    symtab_next
        UniqFM Name (Int, Name)
    symtab_map  <- forall a. IORef a -> IO a
    readIORef IORef (UniqFM Name (Int, Name))
    symtab_map
        BinHandle -> Int -> UniqFM Name (Int, Name) -> IO ()
    putSymbolTable BinHandle
    bh Int
    symtab_next UniqFM Name (Int, Name)
    symtab_map
        case TraceBinIFace
    traceBinIface of
          TraceBinIFace
    QuietBinIFace         -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          TraceBinIFace SDoc -> IO ()
    printer ->
             SDoc -> IO ()
    printer (String -> SDoc
    text String
    "writeBinIface:" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    symtab_next
                                            SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "Names")

        -- NB. write the dictionary after the symbol table, because
        -- writing the symbol table may create more dictionary entries.

        -- Write the dictionary pointer at the front of the file
        Bin Any
    dict_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh          -- This is where the dictionary will start
        forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin (Bin Any)
    dict_p_p Bin Any
    dict_p      -- Fill in the placeholder
        forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    dict_p             -- Seek back to the end of the file

        -- Write the dictionary itself
        Int
    dict_next <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    dict_next_ref
        UniqFM FastString (Int, FastString)
    dict_map  <- forall a. IORef a -> IO a
    readIORef IORef (UniqFM FastString (Int, FastString))
    dict_map_ref
        BinHandle -> Int -> UniqFM FastString (Int, FastString) -> IO ()
    putDictionary BinHandle
    bh Int
    dict_next UniqFM FastString (Int, FastString)
    dict_map
        case TraceBinIFace
    traceBinIface of
          TraceBinIFace
    QuietBinIFace         -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          TraceBinIFace SDoc -> IO ()
    printer ->
             SDoc -> IO ()
    printer (String -> SDoc
    text String
    "writeBinIface:" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    dict_next
                                            SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "dict entries")

    -- | Initial ram buffer to allocate for writing interface files
    initBinMemSize :: Int
    initBinMemSize :: Int
    initBinMemSize = Int
    1024 forall a. Num a => a -> a -> a
    * Int
    1024

    binaryInterfaceMagic :: Platform -> FixedLengthEncoding Word32
    binaryInterfaceMagic :: Platform -> FixedLengthEncoding Word32
    binaryInterfaceMagic Platform
    platform
     | Platform -> Bool
    target32Bit Platform
    platform = forall a. a -> FixedLengthEncoding a
    FixedLengthEncoding Word32
    0x1face
     | Bool
    otherwise            = forall a. a -> FixedLengthEncoding a
    FixedLengthEncoding Word32
    0x1face64

    -- -----------------------------------------------------------------------------
    -- The symbol table
    --

    putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO ()
    putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int, Name) -> IO ()
    putSymbolTable BinHandle
    bh Int
    next_off UniqFM Name (Int, Name)
    symtab = do
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    next_off
        let names :: [Name]
    names = forall i e. Array i e -> [e]
    elems (forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (Int
    0,Int
    next_offforall a. Num a => a -> a -> a
    -Int
    1) (forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM Name (Int, Name)
    symtab))
          -- It's OK to use nonDetEltsUFM here because the elements have
          -- indices that array uses to create order
        forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\Name
    n -> forall key. BinHandle -> Name -> UniqFM key (Int, Name) -> IO ()
    serialiseName BinHandle
    bh Name
    n UniqFM Name (Int, Name)
    symtab) [Name]
    names

    getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
    getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
    getSymbolTable BinHandle
    bh NameCacheUpdater
    ncu = do
        Int
    sz <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        [OnDiskName]
    od_names <- forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence (forall a. Int -> a -> [a]
    replicate Int
    sz (forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh))
        NameCacheUpdater -> forall c. (NameCache -> (NameCache, c)) -> IO c
    updateNameCache NameCacheUpdater
    ncu forall a b. (a -> b) -> a -> b
    $ \NameCache
    namecache ->
            forall a. (forall s. ST s a) -> a
    runST forall a b. (a -> b) -> a -> b
    $ forall a b c. (a -> b -> c) -> b -> a -> c
    flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    State.evalStateT NameCache
    namecache forall a b. (a -> b) -> a -> b
    $ do
                STArray s Int Name
    mut_arr <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ forall s. (Int, Int) -> ST s (STArray s Int Name)
    newSTArray_ (Int
    0, Int
    szforall a. Num a => a -> a -> a
    -Int
    1)
                forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ (forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [OnDiskName]
    od_names) forall a b. (a -> b) -> a -> b
    $ \(Int
    i, OnDiskName
    odn) -> do
                    (NameCache
    nc, !Name
    n) <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    State.gets forall a b. (a -> b) -> a -> b
    $ \NameCache
    nc -> NameCache -> OnDiskName -> (NameCache, Name)
    fromOnDiskName NameCache
    nc OnDiskName
    odn
                    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STArray s Int Name
    mut_arr Int
    i Name
    n
                    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    State.put NameCache
    nc
                SymbolTable
    arr <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
    (Ix i, MArray a e m, IArray b e) =>
    a i e -> m (b i e)
    unsafeFreeze STArray s Int Name
    mut_arr
                NameCache
    namecache' <- forall (m :: * -> *) s. Monad m => StateT s m s
    State.get
                forall (m :: * -> *) a. Monad m => a -> m a
    return (NameCache
    namecache', SymbolTable
    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_ :: forall s. (Int, Int) -> ST s (STArray s Int Name)
    newSTArray_ = forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_

    type OnDiskName = (Unit, ModuleName, OccName)

    fromOnDiskName :: NameCache -> OnDiskName -> (NameCache, Name)
    fromOnDiskName :: NameCache -> OnDiskName -> (NameCache, Name)
    fromOnDiskName NameCache
    nc (GenUnit UnitId
    pid, ModuleName
    mod_name, OccName
    occ) =
        let mod :: GenModule (GenUnit UnitId)
    mod   = forall u. u -> ModuleName -> GenModule u
    mkModule GenUnit UnitId
    pid ModuleName
    mod_name
            cache :: OrigNameCache
    cache = NameCache -> OrigNameCache
    nsNames NameCache
    nc
        in case OrigNameCache
    -> GenModule (GenUnit UnitId) -> OccName -> Maybe Name
    lookupOrigNameCache OrigNameCache
    cache  GenModule (GenUnit UnitId)
    mod OccName
    occ of
               Just Name
    name -> (NameCache
    nc, Name
    name)
               Maybe Name
    Nothing   ->
                   let (Unique
    uniq, UniqSupply
    us) = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply (NameCache -> UniqSupply
    nsUniqs NameCache
    nc)
                       name :: Name
    name       = Unique -> GenModule (GenUnit UnitId) -> OccName -> SrcSpan -> Name
    mkExternalName Unique
    uniq GenModule (GenUnit UnitId)
    mod OccName
    occ SrcSpan
    noSrcSpan
                       new_cache :: OrigNameCache
    new_cache  = OrigNameCache
    -> GenModule (GenUnit UnitId) -> OccName -> Name -> OrigNameCache
    extendNameCache OrigNameCache
    cache GenModule (GenUnit UnitId)
    mod OccName
    occ Name
    name
                   in ( NameCache
    nc{ nsUniqs :: UniqSupply
    nsUniqs = UniqSupply
    us, nsNames :: OrigNameCache
    nsNames = OrigNameCache
    new_cache }, Name
    name )

    serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO ()
    serialiseName :: forall key. BinHandle -> Name -> UniqFM key (Int, Name) -> IO ()
    serialiseName BinHandle
    bh Name
    name UniqFM key (Int, Name)
    _ = do
        let mod :: GenModule (GenUnit UnitId)
    mod = ASSERT2( isExternalName name, ppr name ) nameModule name
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (forall unit. GenModule unit -> unit
    moduleUnit GenModule (GenUnit UnitId)
    mod, forall unit. GenModule unit -> ModuleName
    moduleName GenModule (GenUnit UnitId)
    mod, Name -> OccName
    nameOccName Name
    name)

    -- Note [Symbol table representation of names]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- An occurrence of a name in an interface file is serialized as a single 32-bit
    -- word. The format of this word is:
    --  00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
    --   A normal name. x is an index into the symbol table
    --  10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy
    --   A known-key name. x is the Unique's Char, y is the int part. We assume that
    --   all known-key uniques fit in this space. This is asserted by
    --   GHC.Builtin.Utils.knownKeyNamesOkay.
    --
    -- During serialization we check for known-key things using isKnownKeyName.
    -- During deserialization we use lookupKnownKeyName to get from the unique back
    -- to its corresponding Name.

    -- See Note [Symbol table representation of names]
    putName :: BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()
    putName :: BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()
    putName BinDictionary
    _dict BinSymbolTable{
                   bin_symtab_map :: BinSymbolTable -> IORef (UniqFM Name (Int, Name))
    bin_symtab_map = IORef (UniqFM Name (Int, Name))
    symtab_map_ref,
                   bin_symtab_next :: BinSymbolTable -> FastMutInt
    bin_symtab_next = FastMutInt
    symtab_next }
            BinHandle
    bh Name
    name
      | Name -> Bool
    isKnownKeyName Name
    name
      , let (Char
    c, Int
    u) = Unique -> (Char, Int)
    unpkUnique (Name -> Unique
    nameUnique Name
    name) -- INVARIANT: (ord c) fits in 8 bits
      = -- ASSERT(u < 2^(22 :: Int))
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Word32
    0x80000000
                 forall a. Bits a => a -> a -> a
    .|. (forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c) forall a. Bits a => a -> Int -> a
    `shiftL` Int
    22)
                 forall a. Bits a => a -> a -> a
    .|. (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    u :: Word32))

      | Bool
    otherwise
      = do UniqFM Name (Int, Name)
    symtab_map <- forall a. IORef a -> IO a
    readIORef IORef (UniqFM Name (Int, Name))
    symtab_map_ref
           case forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM Name (Int, Name)
    symtab_map Name
    name of
             Just (Int
    off,Name
    _) -> forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off :: Word32)
             Maybe (Int, Name)
    Nothing -> do
                Int
    off <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    symtab_next
                -- MASSERT(off < 2^(30 :: Int))
                FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    symtab_next (Int
    offforall a. Num a => a -> a -> a
    +Int
    1)
                forall a. IORef a -> a -> IO ()
    writeIORef IORef (UniqFM Name (Int, Name))
    symtab_map_ref
                    forall a b. (a -> b) -> a -> b
    $! forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM Name (Int, Name)
    symtab_map Name
    name (Int
    off,Name
    name)
                forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    off :: Word32)

    -- See Note [Symbol table representation of names]
    getSymtabName :: NameCacheUpdater
                  -> Dictionary -> SymbolTable
                  -> BinHandle -> IO Name
    getSymtabName :: NameCacheUpdater
    -> Dictionary -> SymbolTable -> BinHandle -> IO Name
    getSymtabName NameCacheUpdater
    _ncu Dictionary
    _dict SymbolTable
    symtab BinHandle
    bh = do
        Word32
    i :: Word32 <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        case Word32
    i forall a. Bits a => a -> a -> a
    .&. Word32
    0xC0000000 of
          Word32
    0x00000000 -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $! SymbolTable
    symtab forall i e. Ix i => Array i e -> i -> e
    ! forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    i

          Word32
    0x80000000 ->
            let
              tag :: Char
    tag = Int -> Char
    chr (forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word32
    i forall a. Bits a => a -> a -> a
    .&. Word32
    0x3FC00000) forall a. Bits a => a -> Int -> a
    `shiftR` Int
    22))
              ix :: Int
    ix  = forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    i forall a. Bits a => a -> a -> a
    .&. Int
    0x003FFFFF
              u :: Unique
    u   = Char -> Int -> Unique
    mkUnique Char
    tag Int
    ix
            in
              forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $! case Unique -> Maybe Name
    lookupKnownKeyName Unique
    u of
                          Maybe Name
    Nothing -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getSymtabName:unknown known-key unique"
                                              (forall a. Outputable a => a -> SDoc
    ppr Word32
    i SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr (Unique -> (Char, Int)
    unpkUnique Unique
    u))
                          Just Name
    n  -> Name
    n

          Word32
    _ -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getSymtabName:unknown name tag" (forall a. Outputable a => a -> SDoc
    ppr Word32
    i)

    data BinSymbolTable = BinSymbolTable {
            BinSymbolTable -> FastMutInt
    bin_symtab_next :: !FastMutInt, -- The next index to use
            BinSymbolTable -> IORef (UniqFM Name (Int, Name))
    bin_symtab_map  :: !(IORef (UniqFM Name (Int,Name)))
                                    -- indexed by Name
      }

    putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
    putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
    putFastString BinDictionary
    dict BinHandle
    bh FastString
    fs = BinDictionary -> FastString -> IO Word32
    allocateFastString BinDictionary
    dict FastString
    fs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh

    allocateFastString :: BinDictionary -> FastString -> IO Word32
    allocateFastString :: BinDictionary -> FastString -> IO Word32
    allocateFastString BinDictionary { bin_dict_next :: BinDictionary -> FastMutInt
    bin_dict_next = FastMutInt
    j_r,
                                       bin_dict_map :: BinDictionary -> IORef (UniqFM FastString (Int, FastString))
    bin_dict_map  = IORef (UniqFM FastString (Int, FastString))
    out_r} FastString
    f = do
        UniqFM FastString (Int, FastString)
    out <- forall a. IORef a -> IO a
    readIORef IORef (UniqFM FastString (Int, FastString))
    out_r
        let !uniq :: Unique
    uniq = forall a. Uniquable a => a -> Unique
    getUnique FastString
    f
        case forall key elt. UniqFM key elt -> Unique -> Maybe elt
    lookupUFM_Directly UniqFM FastString (Int, FastString)
    out Unique
    uniq of
            Just (Int
    j, FastString
    _)  -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    j :: Word32)
            Maybe (Int, FastString)
    Nothing -> do
               Int
    j <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    j_r
               FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    j_r (Int
    j forall a. Num a => a -> a -> a
    + Int
    1)
               forall a. IORef a -> a -> IO ()
    writeIORef IORef (UniqFM FastString (Int, FastString))
    out_r forall a b. (a -> b) -> a -> b
    $! forall key elt. UniqFM key elt -> Unique -> elt -> UniqFM key elt
    addToUFM_Directly UniqFM FastString (Int, FastString)
    out Unique
    uniq (Int
    j, FastString
    f)
               forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    j :: Word32)

    getDictFastString :: Dictionary -> BinHandle -> IO FastString
    getDictFastString :: Dictionary -> BinHandle -> IO FastString
    getDictFastString Dictionary
    dict BinHandle
    bh = do
        Word32
    j <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $! (Dictionary
    dict forall i e. Ix i => Array i e -> i -> e
    ! forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    j :: Word32))

    data BinDictionary = BinDictionary {
            BinDictionary -> FastMutInt
    bin_dict_next :: !FastMutInt, -- The next index to use
            BinDictionary -> IORef (UniqFM FastString (Int, FastString))
    bin_dict_map  :: !(IORef (UniqFM FastString (Int,FastString)))
                                    -- indexed by FastString
      }