    {-
    Binary serialization for .hie files.
    -}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE BangPatterns #-}

    module GHC.Iface.Ext.Binary
       ( readHieFile
       , readHieFileWithVersion
       , HieHeader
       , writeHieFile
       , HieName(..)
       , toHieName
       , HieFileResult(..)
       , hieMagic
       , hieNameOcc
       , NameCacheUpdater(..)
       )
    where

    import GHC.Settings.Utils         ( maybeRead )
    import GHC.Settings.Config        ( cProjectVersion )
    import GHC.Prelude
    import GHC.Utils.Binary
    import GHC.Iface.Binary           ( getDictFastString )
    import GHC.Data.FastMutInt
    import GHC.Data.FastString        ( FastString )
    import GHC.Types.Name
    import GHC.Types.Name.Cache
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Builtin.Utils
    import GHC.Types.SrcLoc as SrcLoc
    import GHC.Types.Unique.Supply    ( takeUniqFromSupply )
    import GHC.Types.Unique
    import GHC.Types.Unique.FM
    import GHC.Iface.Env (NameCacheUpdater(..))

    import qualified Data.Array as A
    import Data.IORef
    import Data.ByteString            ( ByteString )
    import qualified Data.ByteString  as BS
    import qualified Data.ByteString.Char8 as BSC
    import Data.List                  ( mapAccumR )
    import Data.Word                  ( Word8, Word32 )
    import Control.Monad              ( replicateM, when )
    import System.Directory           ( createDirectoryIfMissing )
    import System.FilePath            ( takeDirectory )

    import GHC.Iface.Ext.Types

    data HieSymbolTable = HieSymbolTable
      { HieSymbolTable -> FastMutInt
    hie_symtab_next :: !FastMutInt
      , HieSymbolTable -> IORef (UniqFM Name (Int, HieName))
    hie_symtab_map  :: !(IORef (UniqFM Name (Int, HieName)))
      }

    data HieDictionary = HieDictionary
      { HieDictionary -> FastMutInt
    hie_dict_next :: !FastMutInt -- The next index to use
      , HieDictionary -> IORef (UniqFM FastString (Int, FastString))
    hie_dict_map  :: !(IORef (UniqFM FastString (Int,FastString))) -- indexed by FastString
      }

    initBinMemSize :: Int
    initBinMemSize :: Int
    initBinMemSize = Int
    1024Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    1024

    -- | The header for HIE files - Capital ASCII letters \"HIE\".
    hieMagic :: [Word8]
    hieMagic :: [Word8]
    hieMagic = [Word8
    72,Word8
    73,Word8
    69]

    hieMagicLen :: Int
    hieMagicLen :: Int
    hieMagicLen = [Word8] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Word8]
    hieMagic

    ghcVersion :: ByteString
    ghcVersion :: ByteString
    ghcVersion = [Char] -> ByteString
    BSC.pack [Char]
    cProjectVersion

    putBinLine :: BinHandle -> ByteString -> IO ()
    putBinLine :: BinHandle -> ByteString -> IO ()
    putBinLine BinHandle
    bh ByteString
    xs = do
      (Word8 -> IO ()) -> [Word8] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh) ([Word8] -> IO ()) -> [Word8] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    BS.unpack ByteString
    xs
      BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    10 -- newline char

    -- | Write a `HieFile` to the given `FilePath`, with a proper header and
    -- symbol tables for `Name`s and `FastString`s
    writeHieFile :: FilePath -> HieFile -> IO ()
    writeHieFile :: [Char] -> HieFile -> IO ()
    writeHieFile [Char]
    hie_file_path HieFile
    hiefile = do
      BinHandle
    bh0 <- Int -> IO BinHandle
    openBinMem Int
    initBinMemSize

      -- Write the header: hieHeader followed by the
      -- hieVersion and the GHC version used to generate this file
      (Word8 -> IO ()) -> [Word8] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh0) [Word8]
    hieMagic
      BinHandle -> ByteString -> IO ()
    putBinLine BinHandle
    bh0 (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ByteString
    BSC.pack ([Char] -> ByteString) -> [Char] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    hieVersion
      BinHandle -> ByteString -> IO ()
    putBinLine BinHandle
    bh0 (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString
    ghcVersion

      -- remember where the dictionary pointer will go
      Bin (Bin Any)
    dict_p_p <- BinHandle -> IO (Bin (Bin Any))
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh0
      BinHandle -> Bin (Bin Any) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh0 Bin (Bin Any)
    dict_p_p

      -- remember where the symbol table pointer will go
      Bin (Bin Any)
    symtab_p_p <- BinHandle -> IO (Bin (Bin Any))
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh0
      BinHandle -> Bin (Bin Any) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh0 Bin (Bin Any)
    symtab_p_p

      -- Make some initial state
      FastMutInt
    symtab_next <- Int -> IO FastMutInt
    newFastMutInt Int
    0
      IORef (UniqFM Name (Int, HieName))
    symtab_map <- UniqFM Name (Int, HieName)
    -> IO (IORef (UniqFM Name (Int, HieName)))
    forall a. a -> IO (IORef a)
    newIORef UniqFM Name (Int, HieName)
    forall key elt. UniqFM key elt
    emptyUFM :: IO (IORef (UniqFM Name (Int, HieName)))
      let hie_symtab :: HieSymbolTable
    hie_symtab = HieSymbolTable {
                          hie_symtab_next :: FastMutInt
    hie_symtab_next = FastMutInt
    symtab_next,
                          hie_symtab_map :: IORef (UniqFM Name (Int, HieName))
    hie_symtab_map  = IORef (UniqFM Name (Int, HieName))
    symtab_map }
      FastMutInt
    dict_next_ref <- Int -> IO FastMutInt
    newFastMutInt Int
    0
      IORef (UniqFM FastString (Int, FastString))
    dict_map_ref <- UniqFM FastString (Int, FastString)
    -> IO (IORef (UniqFM FastString (Int, FastString)))
    forall a. a -> IO (IORef a)
    newIORef UniqFM FastString (Int, FastString)
    forall key elt. UniqFM key elt
    emptyUFM
      let hie_dict :: HieDictionary
    hie_dict = HieDictionary {
                          hie_dict_next :: FastMutInt
    hie_dict_next = FastMutInt
    dict_next_ref,
                          hie_dict_map :: IORef (UniqFM FastString (Int, FastString))
    hie_dict_map  = IORef (UniqFM FastString (Int, FastString))
    dict_map_ref }

      -- put the main thing
      let bh :: BinHandle
    bh = BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh0 (UserData -> BinHandle) -> UserData -> BinHandle
    forall a b. (a -> b) -> a -> b
    $ (BinHandle -> Name -> IO ())
    -> (BinHandle -> Name -> IO ())
    -> (BinHandle -> FastString -> IO ())
    -> UserData
    newWriteState (HieSymbolTable -> BinHandle -> Name -> IO ()
    putName HieSymbolTable
    hie_symtab)
                                               (HieSymbolTable -> BinHandle -> Name -> IO ()
    putName HieSymbolTable
    hie_symtab)
                                               (HieDictionary -> BinHandle -> FastString -> IO ()
    putFastString HieDictionary
    hie_dict)
      BinHandle -> HieFile -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh HieFile
    hiefile

      -- write the symtab pointer at the front of the file
      Bin Any
    symtab_p <- BinHandle -> IO (Bin Any)
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
      BinHandle -> Bin (Bin Any) -> Bin Any -> IO ()
    forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin (Bin Any)
    symtab_p_p Bin Any
    symtab_p
      BinHandle -> Bin Any -> IO ()
    forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    symtab_p

      -- write the symbol table itself
      Int
    symtab_next' <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    symtab_next
      UniqFM Name (Int, HieName)
    symtab_map'  <- IORef (UniqFM Name (Int, HieName))
    -> IO (UniqFM Name (Int, HieName))
    forall a. IORef a -> IO a
    readIORef IORef (UniqFM Name (Int, HieName))
    symtab_map
      BinHandle -> Int -> UniqFM Name (Int, HieName) -> IO ()
    putSymbolTable BinHandle
    bh Int
    symtab_next' UniqFM Name (Int, HieName)
    symtab_map'

      -- write the dictionary pointer at the front of the file
      Bin Any
    dict_p <- BinHandle -> IO (Bin Any)
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
      BinHandle -> Bin (Bin Any) -> Bin Any -> IO ()
    forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin (Bin Any)
    dict_p_p Bin Any
    dict_p
      BinHandle -> Bin Any -> IO ()
    forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    dict_p

      -- write the dictionary itself
      Int
    dict_next <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    dict_next_ref
      UniqFM FastString (Int, FastString)
    dict_map  <- IORef (UniqFM FastString (Int, FastString))
    -> IO (UniqFM FastString (Int, FastString))
    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

      -- and send the result to the file
      Bool -> [Char] -> IO ()
    createDirectoryIfMissing Bool
    True ([Char] -> [Char]
    takeDirectory [Char]
    hie_file_path)
      BinHandle -> [Char] -> IO ()
    writeBinMem BinHandle
    bh [Char]
    hie_file_path
      () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    data HieFileResult
      = HieFileResult
      { HieFileResult -> Integer
    hie_file_result_version :: Integer
      , HieFileResult -> ByteString
    hie_file_result_ghc_version :: ByteString
      , HieFileResult -> HieFile
    hie_file_result :: HieFile
      }

    type HieHeader = (Integer, ByteString)

    -- | Read a `HieFile` from a `FilePath`. Can use
    -- an existing `NameCache`. Allows you to specify
    -- which versions of hieFile to attempt to read.
    -- `Left` case returns the failing header versions.
    readHieFileWithVersion :: (HieHeader -> Bool) -> NameCacheUpdater -> FilePath -> IO (Either HieHeader HieFileResult)
    readHieFileWithVersion :: (HieHeader -> Bool)
    -> NameCacheUpdater
    -> [Char]
    -> IO (Either HieHeader HieFileResult)
    readHieFileWithVersion HieHeader -> Bool
    readVersion NameCacheUpdater
    ncu [Char]
    file = do
      BinHandle
    bh0 <- [Char] -> IO BinHandle
    readBinMem [Char]
    file

      (Integer
    hieVersion, ByteString
    ghcVersion) <- [Char] -> BinHandle -> IO HieHeader
    readHieFileHeader [Char]
    file BinHandle
    bh0

      if HieHeader -> Bool
    readVersion (Integer
    hieVersion, ByteString
    ghcVersion)
      then do
        HieFile
    hieFile <- BinHandle -> NameCacheUpdater -> IO HieFile
    readHieFileContents BinHandle
    bh0 NameCacheUpdater
    ncu
        Either HieHeader HieFileResult
    -> IO (Either HieHeader HieFileResult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either HieHeader HieFileResult
     -> IO (Either HieHeader HieFileResult))
    -> Either HieHeader HieFileResult
    -> IO (Either HieHeader HieFileResult)
    forall a b. (a -> b) -> a -> b
    $ HieFileResult -> Either HieHeader HieFileResult
    forall a b. b -> Either a b
    Right (Integer -> ByteString -> HieFile -> HieFileResult
    HieFileResult Integer
    hieVersion ByteString
    ghcVersion HieFile
    hieFile)
      else Either HieHeader HieFileResult
    -> IO (Either HieHeader HieFileResult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either HieHeader HieFileResult
     -> IO (Either HieHeader HieFileResult))
    -> Either HieHeader HieFileResult
    -> IO (Either HieHeader HieFileResult)
    forall a b. (a -> b) -> a -> b
    $ HieHeader -> Either HieHeader HieFileResult
    forall a b. a -> Either a b
    Left (Integer
    hieVersion, ByteString
    ghcVersion)

    -- | Read a `HieFile` from a `FilePath`. Can use
    -- an existing `NameCache`.
    readHieFile :: NameCacheUpdater -> FilePath -> IO HieFileResult
    readHieFile :: NameCacheUpdater -> [Char] -> IO HieFileResult
    readHieFile NameCacheUpdater
    ncu [Char]
    file = do

      BinHandle
    bh0 <- [Char] -> IO BinHandle
    readBinMem [Char]
    file

      (Integer
    readHieVersion, ByteString
    ghcVersion) <- [Char] -> BinHandle -> IO HieHeader
    readHieFileHeader [Char]
    file BinHandle
    bh0

      -- Check if the versions match
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Integer
    readHieVersion Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    hieVersion) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        [Char] -> IO ()
    forall a. [Char] -> a
    panic ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unwords [[Char]
    "readHieFile: hie file versions don't match for file:"
                        , [Char]
    file
                        , [Char]
    "Expected"
                        , Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    hieVersion
                        , [Char]
    "but got", Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    readHieVersion
                        ]
      HieFile
    hieFile <- BinHandle -> NameCacheUpdater -> IO HieFile
    readHieFileContents BinHandle
    bh0 NameCacheUpdater
    ncu
      HieFileResult -> IO HieFileResult
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HieFileResult -> IO HieFileResult)
    -> HieFileResult -> IO HieFileResult
    forall a b. (a -> b) -> a -> b
    $ Integer -> ByteString -> HieFile -> HieFileResult
    HieFileResult Integer
    hieVersion ByteString
    ghcVersion HieFile
    hieFile

    readBinLine :: BinHandle -> IO ByteString
    readBinLine :: BinHandle -> IO ByteString
    readBinLine BinHandle
    bh = [Word8] -> ByteString
    BS.pack ([Word8] -> ByteString)
    -> ([Word8] -> [Word8]) -> [Word8] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> [Word8]
    forall a. [a] -> [a]
    reverse ([Word8] -> ByteString) -> IO [Word8] -> IO ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Word8] -> IO [Word8]
    loop []
      where
        loop :: [Word8] -> IO [Word8]
    loop [Word8]
    acc = do
          Word8
    char <- BinHandle -> IO Word8
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO Word8
          if Word8
    char Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    10 -- ASCII newline '\n'
          then [Word8] -> IO [Word8]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Word8]
    acc
          else [Word8] -> IO [Word8]
    loop (Word8
    char Word8 -> [Word8] -> [Word8]
    forall a. a -> [a] -> [a]
    : [Word8]
    acc)

    readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader
    readHieFileHeader :: [Char] -> BinHandle -> IO HieHeader
    readHieFileHeader [Char]
    file BinHandle
    bh0 = do
      -- Read the header
      [Word8]
    magic <- Int -> IO Word8 -> IO [Word8]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    hieMagicLen (BinHandle -> IO Word8
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh0)
      [Char]
    version <- ByteString -> [Char]
    BSC.unpack (ByteString -> [Char]) -> IO ByteString -> IO [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO ByteString
    readBinLine BinHandle
    bh0
      case [Char] -> Maybe Integer
    forall a. Read a => [Char] -> Maybe a
    maybeRead [Char]
    version of
        Maybe Integer
    Nothing ->
          [Char] -> IO HieHeader
    forall a. [Char] -> a
    panic ([Char] -> IO HieHeader) -> [Char] -> IO HieHeader
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unwords [[Char]
    "readHieFileHeader: hieVersion isn't an Integer:"
                          , [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    version
                          ]
        Just Integer
    readHieVersion -> do
          ByteString
    ghcVersion <- BinHandle -> IO ByteString
    readBinLine BinHandle
    bh0

          -- Check if the header is valid
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Word8]
    magic [Word8] -> [Word8] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Word8]
    hieMagic) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            [Char] -> IO ()
    forall a. [Char] -> a
    panic ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unwords [[Char]
    "readHieFileHeader: headers don't match for file:"
                            , [Char]
    file
                            , [Char]
    "Expected"
                            , [Word8] -> [Char]
    forall a. Show a => a -> [Char]
    show [Word8]
    hieMagic
                            , [Char]
    "but got", [Word8] -> [Char]
    forall a. Show a => a -> [Char]
    show [Word8]
    magic
                            ]
          HieHeader -> IO HieHeader
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer
    readHieVersion, ByteString
    ghcVersion)

    readHieFileContents :: BinHandle -> NameCacheUpdater -> IO HieFile
    readHieFileContents :: BinHandle -> NameCacheUpdater -> IO HieFile
    readHieFileContents BinHandle
    bh0 NameCacheUpdater
    ncu = do
      Dictionary
    dict <- BinHandle -> IO Dictionary
    get_dictionary BinHandle
    bh0
      -- read the symbol table so we are capable of reading the actual data
      BinHandle
    bh1 <- do
          let bh1 :: BinHandle
    bh1 = BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh0 (UserData -> BinHandle) -> UserData -> BinHandle
    forall a b. (a -> b) -> a -> b
    $ (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
    newReadState ([Char] -> BinHandle -> IO Name
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "getSymtabName")
                                                   (Dictionary -> BinHandle -> IO FastString
    getDictFastString Dictionary
    dict)
          SymbolTable
    symtab <- BinHandle -> IO SymbolTable
    get_symbol_table BinHandle
    bh1
          let bh1' :: BinHandle
    bh1' = BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh1
                   (UserData -> BinHandle) -> UserData -> BinHandle
    forall a b. (a -> b) -> a -> b
    $ (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
    newReadState (SymbolTable -> BinHandle -> IO Name
    getSymTabName SymbolTable
    symtab)
                                  (Dictionary -> BinHandle -> IO FastString
    getDictFastString Dictionary
    dict)
          BinHandle -> IO BinHandle
    forall (m :: * -> *) a. Monad m => a -> m a
    return BinHandle
    bh1'

      -- load the actual data
      BinHandle -> IO HieFile
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh1
      where
        get_dictionary :: BinHandle -> IO Dictionary
    get_dictionary BinHandle
    bin_handle = do
          Bin Any
    dict_p <- BinHandle -> IO (Bin Any)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bin_handle
          Bin Any
    data_p <- BinHandle -> IO (Bin Any)
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bin_handle
          BinHandle -> Bin Any -> IO ()
    forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bin_handle Bin Any
    dict_p
          Dictionary
    dict <- BinHandle -> IO Dictionary
    getDictionary BinHandle
    bin_handle
          BinHandle -> Bin Any -> IO ()
    forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bin_handle Bin Any
    data_p
          Dictionary -> IO Dictionary
    forall (m :: * -> *) a. Monad m => a -> m a
    return Dictionary
    dict

        get_symbol_table :: BinHandle -> IO SymbolTable
    get_symbol_table BinHandle
    bh1 = do
          Bin Any
    symtab_p <- BinHandle -> IO (Bin Any)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh1
          Bin Any
    data_p'  <- BinHandle -> IO (Bin Any)
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh1
          BinHandle -> Bin Any -> IO ()
    forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh1 Bin Any
    symtab_p
          SymbolTable
    symtab <- BinHandle -> NameCacheUpdater -> IO SymbolTable
    getSymbolTable BinHandle
    bh1 NameCacheUpdater
    ncu
          BinHandle -> Bin Any -> IO ()
    forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh1 Bin Any
    data_p'
          SymbolTable -> IO SymbolTable
    forall (m :: * -> *) a. Monad m => a -> m a
    return SymbolTable
    symtab

    putFastString :: HieDictionary -> BinHandle -> FastString -> IO ()
    putFastString :: HieDictionary -> BinHandle -> FastString -> IO ()
    putFastString HieDictionary { hie_dict_next :: HieDictionary -> FastMutInt
    hie_dict_next = FastMutInt
    j_r,
                                  hie_dict_map :: HieDictionary -> IORef (UniqFM FastString (Int, FastString))
    hie_dict_map  = IORef (UniqFM FastString (Int, FastString))
    out_r}  BinHandle
    bh FastString
    f
      = do
        UniqFM FastString (Int, FastString)
    out <- IORef (UniqFM FastString (Int, FastString))
    -> IO (UniqFM FastString (Int, FastString))
    forall a. IORef a -> IO a
    readIORef IORef (UniqFM FastString (Int, FastString))
    out_r
        let !unique :: Unique
    unique = FastString -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique FastString
    f
        case UniqFM FastString (Int, FastString)
    -> Unique -> Maybe (Int, FastString)
    forall key elt. UniqFM key elt -> Unique -> Maybe elt
    lookupUFM_Directly UniqFM FastString (Int, FastString)
    out Unique
    unique of
            Just (Int
    j, FastString
    _)  -> 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
    j :: Word32)
            Maybe (Int, FastString)
    Nothing -> do
               Int
    j <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    j_r
               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
    j :: Word32)
               FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    j_r (Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
               IORef (UniqFM FastString (Int, FastString))
    -> UniqFM FastString (Int, FastString) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (UniqFM FastString (Int, FastString))
    out_r (UniqFM FastString (Int, FastString) -> IO ())
    -> UniqFM FastString (Int, FastString) -> IO ()
    forall a b. (a -> b) -> a -> b
    $! UniqFM FastString (Int, FastString)
    -> Unique
    -> (Int, FastString)
    -> UniqFM FastString (Int, FastString)
    forall key elt. UniqFM key elt -> Unique -> elt -> UniqFM key elt
    addToUFM_Directly UniqFM FastString (Int, FastString)
    out Unique
    unique (Int
    j, FastString
    f)

    putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO ()
    putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int, HieName) -> IO ()
    putSymbolTable BinHandle
    bh Int
    next_off UniqFM Name (Int, HieName)
    symtab = do
      BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    next_off
      let names :: [HieName]
    names = Array Int HieName -> [HieName]
    forall i e. Array i e -> [e]
    A.elems ((Int, Int) -> [(Int, HieName)] -> Array Int HieName
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    A.array (Int
    0,Int
    next_offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (UniqFM Name (Int, HieName) -> [(Int, HieName)]
    forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM Name (Int, HieName)
    symtab))
      (HieName -> IO ()) -> [HieName] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BinHandle -> HieName -> IO ()
    putHieName BinHandle
    bh) [HieName]
    names

    getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
    getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
    getSymbolTable BinHandle
    bh NameCacheUpdater
    ncu = do
      Int
    sz <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
      [HieName]
    od_names <- Int -> IO HieName -> IO [HieName]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    sz (BinHandle -> IO HieName
    getHieName BinHandle
    bh)
      NameCacheUpdater -> forall c. (NameCache -> (NameCache, c)) -> IO c
    updateNameCache NameCacheUpdater
    ncu ((NameCache -> (NameCache, SymbolTable)) -> IO SymbolTable)
    -> (NameCache -> (NameCache, SymbolTable)) -> IO SymbolTable
    forall a b. (a -> b) -> a -> b
    $ \NameCache
    nc ->
        let arr :: SymbolTable
    arr = (Int, Int) -> [Name] -> SymbolTable
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    A.listArray (Int
    0,Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [Name]
    names
            (NameCache
    nc', [Name]
    names) = (NameCache -> HieName -> (NameCache, Name))
    -> NameCache -> [HieName] -> (NameCache, [Name])
    forall (t :: * -> *) a b c.
    Traversable t =>
    (a -> b -> (a, c)) -> a -> t b -> (a, t c)
    mapAccumR NameCache -> HieName -> (NameCache, Name)
    fromHieName NameCache
    nc [HieName]
    od_names
            in (NameCache
    nc',SymbolTable
    arr)

    getSymTabName :: SymbolTable -> BinHandle -> IO Name
    getSymTabName :: SymbolTable -> BinHandle -> IO Name
    getSymTabName SymbolTable
    st BinHandle
    bh = do
      Word32
    i :: Word32 <- BinHandle -> IO Word32
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
      Name -> IO Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> IO Name) -> Name -> IO Name
    forall a b. (a -> b) -> a -> b
    $ SymbolTable
    st SymbolTable -> Int -> Name
    forall i e. Ix i => Array i e -> i -> e
    A.! (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    i)

    putName :: HieSymbolTable -> BinHandle -> Name -> IO ()
    putName :: HieSymbolTable -> BinHandle -> Name -> IO ()
    putName (HieSymbolTable FastMutInt
    next IORef (UniqFM Name (Int, HieName))
    ref) BinHandle
    bh Name
    name = do
      UniqFM Name (Int, HieName)
    symmap <- IORef (UniqFM Name (Int, HieName))
    -> IO (UniqFM Name (Int, HieName))
    forall a. IORef a -> IO a
    readIORef IORef (UniqFM Name (Int, HieName))
    ref
      case UniqFM Name (Int, HieName) -> Name -> Maybe (Int, HieName)
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM Name (Int, HieName)
    symmap Name
    name of
        Just (Int
    off, ExternalName Module
    mod OccName
    occ (UnhelpfulSpan UnhelpfulSpanReason
    _))
          | SrcSpan -> Bool
    isGoodSrcSpan (Name -> SrcSpan
    nameSrcSpan Name
    name) -> do
          let hieName :: HieName
    hieName = Module -> OccName -> SrcSpan -> HieName
    ExternalName Module
    mod OccName
    occ (Name -> SrcSpan
    nameSrcSpan Name
    name)
          IORef (UniqFM Name (Int, HieName))
    -> UniqFM Name (Int, HieName) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (UniqFM Name (Int, HieName))
    ref (UniqFM Name (Int, HieName) -> IO ())
    -> UniqFM Name (Int, HieName) -> IO ()
    forall a b. (a -> b) -> a -> b
    $! UniqFM Name (Int, HieName)
    -> Name -> (Int, HieName) -> UniqFM Name (Int, HieName)
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM Name (Int, HieName)
    symmap Name
    name (Int
    off, HieName
    hieName)
          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)
        Just (Int
    off, LocalName OccName
    _occ SrcSpan
    span)
          | HieName -> Bool
    notLocal (Name -> HieName
    toHieName Name
    name) Bool -> Bool -> Bool
    || Name -> SrcSpan
    nameSrcSpan Name
    name SrcSpan -> SrcSpan -> Bool
    forall a. Eq a => a -> a -> Bool
    /= SrcSpan
    span -> do
          IORef (UniqFM Name (Int, HieName))
    -> UniqFM Name (Int, HieName) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (UniqFM Name (Int, HieName))
    ref (UniqFM Name (Int, HieName) -> IO ())
    -> UniqFM Name (Int, HieName) -> IO ()
    forall a b. (a -> b) -> a -> b
    $! UniqFM Name (Int, HieName)
    -> Name -> (Int, HieName) -> UniqFM Name (Int, HieName)
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM Name (Int, HieName)
    symmap Name
    name (Int
    off, Name -> HieName
    toHieName Name
    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)
        Just (Int
    off, HieName
    _) -> 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, HieName)
    Nothing -> do
            Int
    off <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    next
            FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    next (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
            IORef (UniqFM Name (Int, HieName))
    -> UniqFM Name (Int, HieName) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (UniqFM Name (Int, HieName))
    ref (UniqFM Name (Int, HieName) -> IO ())
    -> UniqFM Name (Int, HieName) -> IO ()
    forall a b. (a -> b) -> a -> b
    $! UniqFM Name (Int, HieName)
    -> Name -> (Int, HieName) -> UniqFM Name (Int, HieName)
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM Name (Int, HieName)
    symmap Name
    name (Int
    off, Name -> HieName
    toHieName Name
    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)

      where
        notLocal :: HieName -> Bool
        notLocal :: HieName -> Bool
    notLocal LocalName{} = Bool
    False
        notLocal HieName
    _ = Bool
    True

    -- ** Converting to and from `HieName`'s

    fromHieName :: NameCache -> HieName -> (NameCache, Name)
    fromHieName :: NameCache -> HieName -> (NameCache, Name)
    fromHieName NameCache
    nc (ExternalName Module
    mod OccName
    occ SrcSpan
    span) =
        let cache :: OrigNameCache
    cache = NameCache -> OrigNameCache
    nsNames NameCache
    nc
        in case OrigNameCache -> Module -> OccName -> Maybe Name
    lookupOrigNameCache OrigNameCache
    cache Module
    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 -> Module -> OccName -> SrcSpan -> Name
    mkExternalName Unique
    uniq Module
    mod OccName
    occ SrcSpan
    span
                   new_cache :: OrigNameCache
    new_cache  = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
    extendNameCache OrigNameCache
    cache Module
    mod OccName
    occ Name
    name
               in ( NameCache
    nc{ nsUniqs :: UniqSupply
    nsUniqs = UniqSupply
    us, nsNames :: OrigNameCache
    nsNames = OrigNameCache
    new_cache }, Name
    name )
    fromHieName NameCache
    nc (LocalName OccName
    occ SrcSpan
    span) =
        let (Unique
    uniq, UniqSupply
    us) = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply (NameCache -> UniqSupply
    nsUniqs NameCache
    nc)
            name :: Name
    name       = Unique -> OccName -> SrcSpan -> Name
    mkInternalName Unique
    uniq OccName
    occ SrcSpan
    span
        in ( NameCache
    nc{ nsUniqs :: UniqSupply
    nsUniqs = UniqSupply
    us }, Name
    name )
    fromHieName NameCache
    nc (KnownKeyName Unique
    u) = case Unique -> Maybe Name
    lookupKnownKeyName Unique
    u of
        Maybe Name
    Nothing -> [Char] -> SDoc -> (NameCache, Name)
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "fromHieName:unknown known-key unique"
                            ((Char, Int) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Unique -> (Char, Int)
    unpkUnique Unique
    u))
        Just Name
    n -> (NameCache
    nc, Name
    n)

    -- ** Reading and writing `HieName`'s

    putHieName :: BinHandle -> HieName -> IO ()
    putHieName :: BinHandle -> HieName -> IO ()
    putHieName BinHandle
    bh (ExternalName Module
    mod OccName
    occ SrcSpan
    span) = do
      BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    0
      BinHandle -> (Module, OccName, SrcSpan) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Module
    mod, OccName
    occ, SrcSpan
    span)
    putHieName BinHandle
    bh (LocalName OccName
    occName SrcSpan
    span) = do
      BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    1
      BinHandle -> (OccName, SrcSpan) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (OccName
    occName, SrcSpan
    span)
    putHieName BinHandle
    bh (KnownKeyName Unique
    uniq) = do
      BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    2
      BinHandle -> (Char, Int) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh ((Char, Int) -> IO ()) -> (Char, Int) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Unique -> (Char, Int)
    unpkUnique Unique
    uniq

    getHieName :: BinHandle -> IO HieName
    getHieName :: BinHandle -> IO HieName
    getHieName BinHandle
    bh = do
      Word8
    t <- BinHandle -> IO Word8
    getByte BinHandle
    bh
      case Word8
    t of
        Word8
    0 -> do
          (Module
    modu, OccName
    occ, SrcSpan
    span) <- BinHandle -> IO (Module, OccName, SrcSpan)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
          HieName -> IO HieName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HieName -> IO HieName) -> HieName -> IO HieName
    forall a b. (a -> b) -> a -> b
    $ Module -> OccName -> SrcSpan -> HieName
    ExternalName Module
    modu OccName
    occ SrcSpan
    span
        Word8
    1 -> do
          (OccName
    occ, SrcSpan
    span) <- BinHandle -> IO (OccName, SrcSpan)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
          HieName -> IO HieName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HieName -> IO HieName) -> HieName -> IO HieName
    forall a b. (a -> b) -> a -> b
    $ OccName -> SrcSpan -> HieName
    LocalName OccName
    occ SrcSpan
    span
        Word8
    2 -> do
          (Char
    c,Int
    i) <- BinHandle -> IO (Char, Int)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
          HieName -> IO HieName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HieName -> IO HieName) -> HieName -> IO HieName
    forall a b. (a -> b) -> a -> b
    $ Unique -> HieName
    KnownKeyName (Unique -> HieName) -> Unique -> HieName
    forall a b. (a -> b) -> a -> b
    $ Char -> Int -> Unique
    mkUnique Char
    c Int
    i
        Word8
    _ -> [Char] -> IO HieName
    forall a. [Char] -> a
    panic [Char]
    "GHC.Iface.Ext.Binary.getHieName: invalid tag"