    {-# LANGUAGE BinaryLiterals, ScopedTypeVariables #-}

    --
    --  (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,
            readBinIfaceHeader,
            getSymtabName,
            CheckHiWay(..),
            TraceBinIFace(..),
            getWithUserData,
            putWithUserData,

            -- * Internal serialisation functions
            getSymbolTable,
            putName,
            putSymbolTable,
            BinSymbolTable(..),
        ) where

    import GHC.Prelude

    import GHC.Tc.Utils.Monad
    import GHC.Builtin.Utils   ( isKnownKeyName, lookupKnownKeyName )
    import GHC.Unit
    import GHC.Unit.Module.ModIface
    import GHC.Types.Name
    import GHC.Platform.Profile
    import GHC.Types.Unique.FM
    import GHC.Utils.Panic
    import GHC.Utils.Binary as Binary
    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.Settings.Constants
    import GHC.Utils.Fingerprint

    import Data.Array
    import Data.Array.IO
    import Data.Array.Unsafe
    import Data.Char
    import Data.Word
    import Data.IORef
    import Control.Monad

    -- ---------------------------------------------------------------------------
    -- Reading and writing binary interface files
    --

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

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

    -- | Read an interface file header, checking the magic number, version, and
    -- way. Returns the hash of the source file and a BinHandle which points at the
    -- start of the rest of the interface file data.
    readBinIfaceHeader
      :: Profile
      -> NameCache
      -> CheckHiWay
      -> TraceBinIFace
      -> FilePath
      -> IO (Fingerprint, BinHandle)
    readBinIfaceHeader :: Profile
    -> NameCache
    -> CheckHiWay
    -> TraceBinIFace
    -> String
    -> IO (Fingerprint, BinHandle)
    readBinIfaceHeader Profile
    profile NameCache
    _name_cache CheckHiWay
    checkHiWay TraceBinIFace
    traceBinIFace String
    hi_path = 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         -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                   TraceBinIFace SDoc -> IO ()
    printer -> SDoc -> IO ()
    printer (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                         String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    what SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ": " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
                         [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Wanted " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> a -> SDoc
    ppr' a
    wanted SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ",",
                               String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "got    " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> 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.
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (a
    wanted a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    got) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ GhcException -> IO ()
    forall a. GhcException -> IO a
    throwGhcExceptionIO (GhcException -> IO ()) -> GhcException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    ProgramError
                             (String
    what String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (wanted " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    wanted
                                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", got "    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    got String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")")
        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)
        magic <- get bh
        wantedGot "Magic" (binaryInterfaceMagic platform) magic (ppr . unFixedLength)
        errorOnMismatch "magic number mismatch: old/corrupt interface file?"
            (unFixedLength $ binaryInterfaceMagic platform) (unFixedLength magic)

        -- Check the interface file version and profile tag.
        check_ver  <- get bh
        let our_ver = Integer -> String
    forall a. Show a => a -> String
    show Integer
    hiVersion
        wantedGot "Version" our_ver check_ver text
        errorOnMismatch "mismatched interface file versions" our_ver check_ver

        check_tag <- get bh
        let tag = Profile -> String
    profileBuildTag Profile
    profile
        wantedGot "Way" tag check_tag text
        when (checkHiWay == CheckHiWay) $
            errorOnMismatch "mismatched interface file profile tag" tag check_tag

        src_hash <- get bh
        pure (src_hash, bh)

    -- | Read an interface file.
    readBinIface
      :: Profile
      -> NameCache
      -> CheckHiWay
      -> TraceBinIFace
      -> FilePath
      -> IO ModIface
    readBinIface :: Profile
    -> NameCache
    -> CheckHiWay
    -> TraceBinIFace
    -> String
    -> IO ModIface
    readBinIface Profile
    profile NameCache
    name_cache CheckHiWay
    checkHiWay TraceBinIFace
    traceBinIface String
    hi_path = do
        (src_hash, bh) <- Profile
    -> NameCache
    -> CheckHiWay
    -> TraceBinIFace
    -> String
    -> IO (Fingerprint, BinHandle)
    readBinIfaceHeader Profile
    profile NameCache
    name_cache CheckHiWay
    checkHiWay TraceBinIFace
    traceBinIface String
    hi_path

        extFields_p <- get bh

        mod_iface <- getWithUserData name_cache bh

        seekBin bh extFields_p
        extFields <- get bh

        return mod_iface
          { mi_ext_fields = extFields
          , mi_src_hash = src_hash
          }

    -- | 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 => NameCache -> BinHandle -> IO a
    getWithUserData :: forall a. Binary a => NameCache -> BinHandle -> IO a
    getWithUserData NameCache
    name_cache BinHandle
    bh = do
      bh <- NameCache -> BinHandle -> IO BinHandle
    getTables NameCache
    name_cache BinHandle
    bh
      get bh

    -- | Setup a BinHandle to read something written using putWithTables
    --
    -- Reading names has the side effect of adding them into the given NameCache.
    getTables :: NameCache -> BinHandle -> IO BinHandle
    getTables :: NameCache -> BinHandle -> IO BinHandle
    getTables NameCache
    name_cache 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)
        dict <- BinHandle -> IO Dictionary -> IO Dictionary
    forall a. BinHandle -> IO a -> IO a
    Binary.forwardGet BinHandle
    bh (BinHandle -> IO Dictionary
    getDictionary BinHandle
    bh)

        -- Initialise the user-data field of bh
        let bh_fs = BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh (UserData -> BinHandle) -> UserData -> BinHandle
    forall a b. (a -> b) -> a -> b
    $ (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
    newReadState (String -> BinHandle -> IO Name
    forall a. HasCallStack => String -> a
    error String
    "getSymtabName")
                                                  (Dictionary -> BinHandle -> IO FastString
    getDictFastString Dictionary
    dict)

        symtab <- Binary.forwardGet bh_fs (getSymbolTable bh_fs name_cache)

        -- It is only now that we know how to get a Name
        return $ setUserData bh $ newReadState (getSymtabName name_cache dict symtab)
                                               (getDictFastString dict)

    -- | 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
        bh <- Int -> IO BinHandle
    openBinMem Int
    initBinMemSize
        let platform = Profile -> Platform
    profilePlatform Profile
    profile
        put_ bh (binaryInterfaceMagic platform)

        -- The version, profile tag, and source hash go next
        put_ bh (show hiVersion)
        let tag = Profile -> String
    profileBuildTag Profile
    profile
        put_  bh tag
        put_  bh (mi_src_hash mod_iface)

        extFields_p_p <- tellBin bh
        put_ bh extFields_p_p

        putWithUserData traceBinIface bh mod_iface

        extFields_p <- tellBin bh
        putAt bh extFields_p_p extFields_p
        seekBin bh extFields_p
        put_ bh (mi_ext_fields mod_iface)

        -- And send the result to the file
        writeBinMem bh 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
      (name_count, fs_count, _b) <- BinHandle -> (BinHandle -> IO (Bin a)) -> IO (Int, Int, Bin a)
    forall b. BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b)
    putWithTables BinHandle
    bh (\BinHandle
    bh' -> BinHandle -> a -> IO (Bin a)
    forall a. Binary a => BinHandle -> a -> IO (Bin a)
    put BinHandle
    bh' a
    payload)

      case traceBinIface of
        TraceBinIFace
    QuietBinIFace         -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        TraceBinIFace SDoc -> IO ()
    printer -> do
           SDoc -> IO ()
    printer (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "writeBinIface:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    name_count
                                          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Names")
           SDoc -> IO ()
    printer (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "writeBinIface:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    fs_count
                                          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "dict entries")

    -- | Write name/symbol tables
    --
    -- 1. setup the given BinHandle with Name/FastString table handling
    -- 2. write the following
    --    - FastString table pointer
    --    - Name table pointer
    --    - payload
    --    - Name table
    --    - FastString table
    --
    -- It returns (number of names, number of FastStrings, payload write result)
    --
    putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int,Int,b)
    putWithTables :: forall b. BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b)
    putWithTables BinHandle
    bh BinHandle -> IO b
    put_payload = do
        -- initialize state for the name table and the FastString table.
        symtab_next <- Int -> IO FastMutInt
    newFastMutInt Int
    0
        symtab_map <- newIORef emptyUFM
        let 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
                          }

        (bh_fs, bin_dict, put_dict) <- initFSTable bh

        (fs_count,(name_count,r)) <- forwardPut bh (const put_dict) $ do

          -- NB. write the dictionary after the symbol table, because
          -- writing the symbol table may create more dictionary entries.
          let put_symtab = do
                name_count <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    symtab_next
                symtab_map  <- readIORef symtab_map
                putSymbolTable bh_fs name_count symtab_map
                pure name_count

          forwardPut bh_fs (const put_symtab) $ do

            -- BinHandle with FastString and Name writing support
            let ud_fs = BinHandle -> UserData
    getUserData BinHandle
    bh_fs
            let ud_name = UserData
    ud_fs
                            { ud_put_nonbinding_name = putName bin_dict bin_symtab
                            , ud_put_binding_name    = putName bin_dict bin_symtab
                            }
            let bh_name = BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh UserData
    ud_name

            put_payload bh_name

        return (name_count, fs_count, r)

    -- | Initial ram buffer to allocate for writing interface files
    initBinMemSize :: Int
    initBinMemSize :: Int
    initBinMemSize = Int
    1024 Int -> Int -> Int
    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 = Word32 -> FixedLengthEncoding Word32
    forall a. a -> FixedLengthEncoding a
    FixedLengthEncoding Word32
    0x1face
     | Bool
    otherwise            = Word32 -> FixedLengthEncoding Word32
    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
    name_count UniqFM Name (Int, Name)
    symtab = do
        BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    name_count
        let names :: [Name]
    names = SymbolTable -> [Name]
    forall i e. Array i e -> [e]
    elems ((Int, Int) -> [(Int, Name)] -> SymbolTable
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (Int
    0,Int
    name_countInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (UniqFM Name (Int, Name) -> [(Int, Name)]
    forall {k} (key :: k) 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
        (Name -> IO ()) -> [Name] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\Name
    n -> BinHandle -> Name -> UniqFM Name (Int, Name) -> IO ()
    forall {k} (key :: k).
    BinHandle -> Name -> UniqFM key (Int, Name) -> IO ()
    serialiseName BinHandle
    bh Name
    n UniqFM Name (Int, Name)
    symtab) [Name]
    names

    getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable
    getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable
    getSymbolTable BinHandle
    bh NameCache
    name_cache = do
        sz <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO Int
        -- create an array of Names for the symbols and add them to the NameCache
        updateNameCache' name_cache $ \OrigNameCache
    cache0 -> do
            mut_arr <- (Int, Int) -> IO (IOArray Int Name)
    forall i. Ix i => (i, i) -> IO (IOArray i Name)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ (Int
    0, Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) :: IO (IOArray Int Name)
            cache <- foldGet' (fromIntegral sz) bh cache0 $ \Word
    i (Unit
    uid, ModuleName
    mod_name, OccName
    occ) OrigNameCache
    cache -> do
              let mod :: GenModule Unit
    mod = Unit -> ModuleName -> GenModule Unit
    forall u. u -> ModuleName -> GenModule u
    mkModule Unit
    uid ModuleName
    mod_name
              case OrigNameCache -> GenModule Unit -> OccName -> Maybe Name
    lookupOrigNameCache OrigNameCache
    cache GenModule Unit
    mod OccName
    occ of
                Just Name
    name -> do
                  IOArray Int Name -> Int -> Name -> IO ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray IOArray Int Name
    mut_arr (Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    i) Name
    name
                  OrigNameCache -> IO OrigNameCache
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrigNameCache
    cache
                Maybe Name
    Nothing   -> do
                  uniq <- NameCache -> IO Unique
    takeUniqFromNameCache NameCache
    name_cache
                  let name      = Unique -> GenModule Unit -> OccName -> SrcSpan -> Name
    mkExternalName Unique
    uniq GenModule Unit
    mod OccName
    occ SrcSpan
    noSrcSpan
                      new_cache = OrigNameCache -> GenModule Unit -> OccName -> Name -> OrigNameCache
    extendOrigNameCache OrigNameCache
    cache GenModule Unit
    mod OccName
    occ Name
    name
                  writeArray mut_arr (fromIntegral i) name
                  return new_cache
            arr <- unsafeFreeze mut_arr
            return (cache, arr)

    serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO ()
    serialiseName :: forall {k} (key :: k).
    BinHandle -> Name -> UniqFM key (Int, Name) -> IO ()
    serialiseName BinHandle
    bh Name
    name UniqFM key (Int, Name)
    _ = do
        let mod :: GenModule Unit
    mod = Bool -> SDoc -> GenModule Unit -> GenModule Unit
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Name -> Bool
    isExternalName Name
    name) (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name) (HasDebugCallStack => Name -> GenModule Unit
    Name -> GenModule Unit
    nameModule Name
    name)
        BinHandle -> (Unit, ModuleName, OccName) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (GenModule Unit -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit GenModule Unit
    mod, GenModule Unit -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName GenModule Unit
    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 :: FSTable -> BinSymbolTable -> BinHandle -> Name -> IO ()
    putName :: FSTable -> BinSymbolTable -> BinHandle -> Name -> IO ()
    putName FSTable
    _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, Word64
    u) = Unique -> (Char, Word64)
    unpkUnique (Name -> Unique
    nameUnique Name
    name) -- INVARIANT: (ord c) fits in 8 bits
      = -- assert (u < 2^(22 :: Int))
        BinHandle -> Word32 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Word32
    0x80000000
                 Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|. (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c) Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    22)
                 Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|. (Word64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    u :: Word32))

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

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

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

          Word32
    _ -> String -> SDoc -> IO Name
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getSymtabName:unknown name tag" (Word32 -> SDoc
    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
      }