{-
Binary serialization for .hie files.
-}

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

import GHC.Prelude

import GHC.Builtin.Utils
import GHC.Settings.Utils         ( maybeRead )
import GHC.Settings.Config        ( cProjectVersion )
import GHC.Utils.Binary
import GHC.Data.FastMutInt
import GHC.Data.FastString        ( FastString )
import GHC.Iface.Ext.Types
import GHC.Iface.Binary           ( putAllTables )
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Unique
import GHC.Types.Unique.FM
import qualified GHC.Utils.Binary as Binary
import GHC.Utils.Outputable
import GHC.Utils.Panic

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

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

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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
hieMagic

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

putBinLine :: WriteBinHandle -> ByteString -> IO ()
putBinLine :: WriteBinHandle -> ByteString -> IO ()
putBinLine WriteBinHandle
bh ByteString
xs = do
  (Word8 -> IO ()) -> [Word8] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh) ([Word8] -> IO ()) -> [Word8] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
xs
  WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
  bh0 <- Int -> IO WriteBinHandle
openBinMem Int
initBinMemSize

  -- Write the header: hieHeader followed by the
  -- hieVersion and the GHC version used to generate this file
  mapM_ (putByte bh0) hieMagic
  putBinLine bh0 $ BSC.pack $ show hieVersion
  putBinLine bh0 $ ghcVersion

  (fs_tbl, fs_w) <- initFastStringWriterTable
  (name_tbl, name_w) <- initWriteNameTable

  let bh = WriteBinHandle -> WriterUserData -> WriteBinHandle
setWriterUserData WriteBinHandle
bh0 (WriterUserData -> WriteBinHandle)
-> WriterUserData -> WriteBinHandle
forall a b. (a -> b) -> a -> b
$ [SomeBinaryWriter] -> WriterUserData
mkWriterUserData
        [ forall a. Typeable a => BinaryWriter a -> SomeBinaryWriter
mkSomeBinaryWriter @Name BinaryWriter Name
name_w
        , forall a. Typeable a => BinaryWriter a -> SomeBinaryWriter
mkSomeBinaryWriter @BindingName (BinaryWriter Name -> BinaryWriter BindingName
simpleBindingNameWriter BinaryWriter Name
name_w)
        , forall a. Typeable a => BinaryWriter a -> SomeBinaryWriter
mkSomeBinaryWriter @FastString BinaryWriter FastString
fs_w
        ]

  -- Discard number of written elements
  -- Order matters! See Note [Order of deduplication tables during iface binary serialisation]
  _ <- putAllTables bh [fs_tbl, name_tbl] $ do
    put_ bh hiefile

  -- and send the result to the file
  createDirectoryIfMissing True (takeDirectory hie_file_path)
  writeBinMem bh hie_file_path
  return ()

initWriteNameTable :: IO (WriterTable, BinaryWriter Name)
initWriteNameTable :: IO (WriterTable, BinaryWriter Name)
initWriteNameTable = do
  symtab_next <- Int -> IO FastMutInt
newFastMutInt Int
0
  symtab_map <- newIORef emptyUFM
  let bin_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
          }

  let put_symtab WriteBinHandle
bh = do
        name_count <- FastMutInt -> IO Int
readFastMutInt FastMutInt
symtab_next
        symtab_map <- readIORef symtab_map
        putSymbolTable bh name_count symtab_map
        pure name_count

  return
    ( WriterTable
        { putTable = put_symtab
        }
    , mkWriter $ putName bin_symtab
    )

initReadNameTable :: NameCache -> IO (ReaderTable Name)
initReadNameTable :: NameCache -> IO (ReaderTable Name)
initReadNameTable NameCache
cache = do
  ReaderTable Name -> IO (ReaderTable Name)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReaderTable Name -> IO (ReaderTable Name))
-> ReaderTable Name -> IO (ReaderTable Name)
forall a b. (a -> b) -> a -> b
$
    ReaderTable
      { getTable :: ReadBinHandle -> IO (SymbolTable Name)
getTable = \ReadBinHandle
bh -> ReadBinHandle -> NameCache -> IO (SymbolTable Name)
getSymbolTable ReadBinHandle
bh NameCache
cache
      , mkReaderFromTable :: SymbolTable Name -> BinaryReader Name
mkReaderFromTable = \SymbolTable Name
tbl -> (ReadBinHandle -> IO Name) -> BinaryReader Name
forall s. (ReadBinHandle -> IO s) -> BinaryReader s
mkReader (SymbolTable Name -> ReadBinHandle -> IO Name
getSymTabName SymbolTable Name
tbl)
      }

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) -> NameCache -> FilePath -> IO (Either HieHeader HieFileResult)
readHieFileWithVersion :: (HieHeader -> Bool)
-> NameCache -> [Char] -> IO (Either HieHeader HieFileResult)
readHieFileWithVersion HieHeader -> Bool
readVersion NameCache
name_cache [Char]
file = do
  bh0 <- [Char] -> IO ReadBinHandle
readBinMem [Char]
file

  (hieVersion, ghcVersion) <- readHieFileHeader file bh0

  if readVersion (hieVersion, ghcVersion)
  then do
    hieFile <- readHieFileContents bh0 name_cache
    return $ Right (HieFileResult hieVersion ghcVersion hieFile)
  else return $ Left (hieVersion, ghcVersion)


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

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

  (readHieVersion, ghcVersion) <- readHieFileHeader file bh0

  -- Check if the versions match
  when (readHieVersion /= hieVersion) $
    panic $ unwords ["readHieFile: hie file versions don't match for file:"
                    , file
                    , "Expected"
                    , show hieVersion
                    , "but got", show readHieVersion
                    ]
  hieFile <- readHieFileContents bh0 name_cache
  return $ HieFileResult hieVersion ghcVersion hieFile

readBinLine :: ReadBinHandle -> IO ByteString
readBinLine :: ReadBinHandle -> IO ByteString
readBinLine ReadBinHandle
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
      char <- ReadBinHandle -> IO Word8
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh :: IO Word8
      if char == 10 -- ASCII newline '\n'
      then return acc
      else loop (char : acc)

readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader
readHieFileHeader :: [Char] -> ReadBinHandle -> IO HieHeader
readHieFileHeader [Char]
file ReadBinHandle
bh0 = do
  -- Read the header
  magic <- Int -> IO Word8 -> IO [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
hieMagicLen (ReadBinHandle -> IO Word8
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh0)
  version <- BSC.unpack <$> readBinLine bh0
  case maybeRead version of
    Maybe Integer
Nothing ->
      [Char] -> IO HieHeader
forall a. HasCallStack => [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
      ghcVersion <- ReadBinHandle -> IO ByteString
readBinLine ReadBinHandle
bh0

      -- Check if the header is valid
      when (magic /= hieMagic) $
        panic $ unwords ["readHieFileHeader: headers don't match for file:"
                        , file
                        , "Expected"
                        , show hieMagic
                        , "but got", show magic
                        ]
      return (readHieVersion, ghcVersion)

readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile
readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile
readHieFileContents ReadBinHandle
bh0 NameCache
name_cache = do
  fsReaderTable <- IO (ReaderTable FastString)
initFastStringReaderTable
  nameReaderTable <- initReadNameTable name_cache

  -- read the symbol table so we are capable of reading the actual data
  bh1 <-
    foldM (\ReadBinHandle
bh ReadBinHandle -> IO ReadBinHandle
tblReader -> ReadBinHandle -> IO ReadBinHandle
tblReader ReadBinHandle
bh) bh0
      -- The order of these deserialisation matters!
      --
      -- See Note [Order of deduplication tables during iface binary serialisation] for details.
      [ get_dictionary fsReaderTable
      , get_dictionary nameReaderTable
      ]

  -- load the actual data
  get bh1
  where
    get_dictionary :: ReaderTable a -> ReadBinHandle -> IO ReadBinHandle
get_dictionary ReaderTable a
tbl ReadBinHandle
bin_handle = do
      fsTable <- ReadBinHandle -> IO (SymbolTable a) -> IO (SymbolTable a)
forall a. ReadBinHandle -> IO a -> IO a
Binary.forwardGetRel ReadBinHandle
bin_handle (ReaderTable a -> ReadBinHandle -> IO (SymbolTable a)
forall a. ReaderTable a -> ReadBinHandle -> IO (SymbolTable a)
getTable ReaderTable a
tbl ReadBinHandle
bin_handle)
      let
        fsReader = ReaderTable a -> SymbolTable a -> BinaryReader a
forall a. ReaderTable a -> SymbolTable a -> BinaryReader a
mkReaderFromTable ReaderTable a
tbl SymbolTable a
fsTable
        bhFs = BinaryReader a -> ReadBinHandle -> ReadBinHandle
forall a.
Typeable a =>
BinaryReader a -> ReadBinHandle -> ReadBinHandle
addReaderToUserData BinaryReader a
fsReader ReadBinHandle
bin_handle
      pure bhFs


putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO ()
putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int, HieName) -> IO ()
putSymbolTable WriteBinHandle
bh Int
next_off UniqFM Name (Int, HieName)
symtab = do
  WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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 {k} (key :: k) 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_ (WriteBinHandle -> HieName -> IO ()
putHieName WriteBinHandle
bh) [HieName]
names

getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name)
getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name)
getSymbolTable ReadBinHandle
bh NameCache
name_cache = do
  sz <- ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
  mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name)
  forM_ [0..(sz-1)] $ \Int
i -> do
    od_name <- ReadBinHandle -> IO HieName
getHieName ReadBinHandle
bh
    name <- fromHieName name_cache od_name
    A.writeArray mut_arr i name
  A.unsafeFreeze mut_arr

getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name
getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name
getSymTabName SymbolTable Name
st ReadBinHandle
bh = do
  i :: Word32 <- ReadBinHandle -> IO Word32
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
  return $ st A.! (fromIntegral i)

putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO ()
putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO ()
putName (HieSymbolTable FastMutInt
next IORef (UniqFM Name (Int, HieName))
ref) WriteBinHandle
bh Name
name = do
  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 lookupUFM symmap 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)
      WriteBinHandle -> Word32 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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)
      WriteBinHandle -> Word32 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off :: Word32)
    Just (Int
off, HieName
_) -> WriteBinHandle -> Word32 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off :: Word32)
    Maybe (Int, HieName)
Nothing -> do
        off <- FastMutInt -> IO Int
readFastMutInt FastMutInt
next
        writeFastMutInt next (off+1)
        writeIORef ref $! addToUFM symmap name (off, toHieName name)
        put_ bh (fromIntegral 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 -> IO Name
fromHieName :: NameCache -> HieName -> IO Name
fromHieName NameCache
nc HieName
hie_name = do

  case HieName
hie_name of
    ExternalName Module
mod OccName
occ SrcSpan
span -> NameCache
-> Module
-> OccName
-> (OrigNameCache -> IO (OrigNameCache, Name))
-> IO Name
forall c.
NameCache
-> Module
-> OccName
-> (OrigNameCache -> IO (OrigNameCache, c))
-> IO c
updateNameCache NameCache
nc Module
mod OccName
occ ((OrigNameCache -> IO (OrigNameCache, Name)) -> IO Name)
-> (OrigNameCache -> IO (OrigNameCache, Name)) -> IO Name
forall a b. (a -> b) -> a -> b
$ \OrigNameCache
cache -> do
      case OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache OrigNameCache
cache Module
mod OccName
occ of
        Just Name
name -> (OrigNameCache, Name) -> IO (OrigNameCache, Name)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrigNameCache
cache, Name
name)
        Maybe Name
Nothing   -> do
          uniq <- NameCache -> IO Unique
takeUniqFromNameCache NameCache
nc
          let name       = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
uniq Module
mod OccName
occ SrcSpan
span
              new_cache  = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendOrigNameCache OrigNameCache
cache Module
mod OccName
occ Name
name
          pure (new_cache, name)

    LocalName OccName
occ SrcSpan
span -> do
      uniq <- NameCache -> IO Unique
takeUniqFromNameCache NameCache
nc
      -- don't update the NameCache for local names
      pure $ mkInternalName uniq occ span

    KnownKeyName Unique
u -> case Unique -> Maybe Name
lookupKnownKeyName Unique
u of
      Maybe Name
Nothing -> [Char] -> SDoc -> IO Name
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"fromHieName:unknown known-key unique"
                          (Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unique
u)
      Just Name
n -> Name -> IO Name
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n

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

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

getHieName :: ReadBinHandle -> IO HieName
getHieName :: ReadBinHandle -> IO HieName
getHieName ReadBinHandle
bh = do
  t <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
  case t of
    Word8
0 -> do
      (modu, occ, span) <- ReadBinHandle -> IO (Module, OccName, BinSrcSpan)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
      return $ ExternalName modu occ $ unBinSrcSpan span
    Word8
1 -> do
      (occ, span) <- ReadBinHandle -> IO (OccName, BinSrcSpan)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
      return $ LocalName occ $ unBinSrcSpan span
    Word8
2 -> do
      (c,i) <- ReadBinHandle -> IO (Char, Word64)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
      return $ KnownKeyName $ mkUnique c i
    Word8
_ -> [Char] -> IO HieName
forall a. HasCallStack => [Char] -> a
panic [Char]
"GHC.Iface.Ext.Binary.getHieName: invalid tag"