{-
Binary serialization for .hie files.
-}
{-# LANGUAGE ScopedTypeVariables #-}
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.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 (Int, HieName))
hie_symtab_map  :: !(IORef (UniqFM (Int, HieName)))
  }

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

initBinMemSize :: Int
initBinMemSize :: Int
initBinMemSize = Int
1024Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*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
External instance of the constraint type Foldable []
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 ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
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 ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
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]
External instance of the constraint type Show Integer
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 ()
External instance of the constraint type forall k (a :: k). Binary (Bin a)
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 ()
External instance of the constraint type forall k (a :: k). Binary (Bin a)
put_ BinHandle
bh0 Bin (Bin Any)
symtab_p_p

  -- Make some initial state
  FastMutInt
symtab_next <- IO FastMutInt
newFastMutInt
  FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
symtab_next Int
0
  IORef (UniqFM (Int, HieName))
symtab_map <- UniqFM (Int, HieName) -> IO (IORef (UniqFM (Int, HieName)))
forall a. a -> IO (IORef a)
newIORef UniqFM (Int, HieName)
forall elt. UniqFM elt
emptyUFM
  let hie_symtab :: HieSymbolTable
hie_symtab = HieSymbolTable :: FastMutInt -> IORef (UniqFM (Int, HieName)) -> HieSymbolTable
HieSymbolTable {
                      hie_symtab_next :: FastMutInt
hie_symtab_next = FastMutInt
symtab_next,
                      hie_symtab_map :: IORef (UniqFM (Int, HieName))
hie_symtab_map  = IORef (UniqFM (Int, HieName))
symtab_map }
  FastMutInt
dict_next_ref <- IO FastMutInt
newFastMutInt
  FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
dict_next_ref Int
0
  IORef (UniqFM (Int, FastString))
dict_map_ref <- UniqFM (Int, FastString) -> IO (IORef (UniqFM (Int, FastString)))
forall a. a -> IO (IORef a)
newIORef UniqFM (Int, FastString)
forall elt. UniqFM elt
emptyUFM
  let hie_dict :: HieDictionary
hie_dict = HieDictionary :: FastMutInt -> IORef (UniqFM (Int, FastString)) -> HieDictionary
HieDictionary {
                      hie_dict_next :: FastMutInt
hie_dict_next = FastMutInt
dict_next_ref,
                      hie_dict_map :: IORef (UniqFM (Int, FastString))
hie_dict_map  = IORef (UniqFM (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 ()
External instance of the constraint type Binary HieFile
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 ()
External instance of the constraint type forall k (a :: k). Binary (Bin a)
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 (Int, HieName)
symtab_map'  <- IORef (UniqFM (Int, HieName)) -> IO (UniqFM (Int, HieName))
forall a. IORef a -> IO a
readIORef IORef (UniqFM (Int, HieName))
symtab_map
  BinHandle -> Int -> UniqFM (Int, HieName) -> IO ()
putSymbolTable BinHandle
bh Int
symtab_next' UniqFM (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 ()
External instance of the constraint type forall k (a :: k). Binary (Bin a)
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 (Int, FastString)
dict_map  <- IORef (UniqFM (Int, FastString)) -> IO (UniqFM (Int, FastString))
forall a. IORef a -> IO a
readIORef IORef (UniqFM (Int, FastString))
dict_map_ref
  BinHandle -> Int -> UniqFM (Int, FastString) -> IO ()
putDictionary BinHandle
bh Int
dict_next UniqFM (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
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
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 ()
External instance of the constraint type Applicative IO
when (Integer
readHieVersion Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
/= 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]
External instance of the constraint type Show Integer
show Integer
hieVersion
                    , [Char]
"but got", Integer -> [Char]
forall a. Show a => a -> [Char]
External instance of the constraint type Show Integer
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
External instance of the constraint type Monad IO
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
External instance of the constraint type Functor IO
<$> [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
External instance of the constraint type Binary Word8
get BinHandle
bh :: IO Word8
      if Word8
char Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Word8
== Word8
10 -- ASCII newline '\n'
      then [Word8] -> IO [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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]
External instance of the constraint type Applicative IO
replicateM Int
hieMagicLen (BinHandle -> IO Word8
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary Word8
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
External instance of the constraint type Functor IO
<$> BinHandle -> IO ByteString
readBinLine BinHandle
bh0
  case [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
External instance of the constraint type Read Integer
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]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show 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 ()
External instance of the constraint type Applicative IO
when ([Word8]
magic [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Word8
/= [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]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Word8
show [Word8]
hieMagic
                        , [Char]
"but got", [Word8] -> [Char]
forall a. Show a => a -> [Char]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Word8
show [Word8]
magic
                        ]
      HieHeader -> IO HieHeader
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
return BinHandle
bh1'

  -- load the actual data
  HieFile
hiefile <- BinHandle -> IO HieFile
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary HieFile
get BinHandle
bh1
  HieFile -> IO HieFile
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return HieFile
hiefile
  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
External instance of the constraint type forall k (a :: k). Binary (Bin 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
External instance of the constraint type Monad IO
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
External instance of the constraint type forall k (a :: k). Binary (Bin 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
External instance of the constraint type Monad IO
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 (Int, FastString))
hie_dict_map  = IORef (UniqFM (Int, FastString))
out_r}  BinHandle
bh FastString
f
  = do
    UniqFM (Int, FastString)
out <- IORef (UniqFM (Int, FastString)) -> IO (UniqFM (Int, FastString))
forall a. IORef a -> IO a
readIORef IORef (UniqFM (Int, FastString))
out_r
    let unique :: Unique
unique = FastString -> Unique
forall a. Uniquable a => a -> Unique
External instance of the constraint type Uniquable FastString
getUnique FastString
f
    case UniqFM (Int, FastString) -> Unique -> Maybe (Int, FastString)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable Unique
lookupUFM UniqFM (Int, FastString)
out Unique
unique of
        Just (Int
j, FastString
_)  -> BinHandle -> Word32 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary Word32
put_ BinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word32
External instance of the constraint type Integral Int
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 ()
External instance of the constraint type Binary Word32
put_ BinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word32
External instance of the constraint type Integral Int
fromIntegral Int
j :: Word32)
           FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
j_r (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1)
           IORef (UniqFM (Int, FastString))
-> UniqFM (Int, FastString) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (UniqFM (Int, FastString))
out_r (UniqFM (Int, FastString) -> IO ())
-> UniqFM (Int, FastString) -> IO ()
forall a b. (a -> b) -> a -> b
$! UniqFM (Int, FastString)
-> Unique -> (Int, FastString) -> UniqFM (Int, FastString)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
External instance of the constraint type Uniquable Unique
addToUFM UniqFM (Int, FastString)
out Unique
unique (Int
j, FastString
f)

putSymbolTable :: BinHandle -> Int -> UniqFM (Int,HieName) -> IO ()
putSymbolTable :: BinHandle -> Int -> UniqFM (Int, HieName) -> IO ()
putSymbolTable BinHandle
bh Int
next_off UniqFM (Int, HieName)
symtab = do
  BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary Int
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
External instance of the constraint type Ix Int
A.array (Int
0,Int
next_offInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1) (UniqFM (Int, HieName) -> [(Int, HieName)]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM UniqFM (Int, HieName)
symtab))
  (HieName -> IO ()) -> [HieName] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
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
External instance of the constraint type Binary Int
get BinHandle
bh
  [HieName]
od_names <- Int -> IO HieName -> IO [HieName]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
External instance of the constraint type Applicative IO
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
External instance of the constraint type Ix Int
A.listArray (Int
0,Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-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)
External instance of the constraint type Traversable []
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
External instance of the constraint type Binary Word32
get BinHandle
bh
  Name -> IO Name
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Ix Int
A.! (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Word32
fromIntegral Word32
i)

putName :: HieSymbolTable -> BinHandle -> Name -> IO ()
putName :: HieSymbolTable -> BinHandle -> Name -> IO ()
putName (HieSymbolTable FastMutInt
next IORef (UniqFM (Int, HieName))
ref) BinHandle
bh Name
name = do
  UniqFM (Int, HieName)
symmap <- IORef (UniqFM (Int, HieName)) -> IO (UniqFM (Int, HieName))
forall a. IORef a -> IO a
readIORef IORef (UniqFM (Int, HieName))
ref
  case UniqFM (Int, HieName) -> Name -> Maybe (Int, HieName)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable Name
lookupUFM UniqFM (Int, HieName)
symmap Name
name of
    Just (Int
off, ExternalName Module
mod OccName
occ (UnhelpfulSpan FastString
_))
      | 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 (Int, HieName)) -> UniqFM (Int, HieName) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (UniqFM (Int, HieName))
ref (UniqFM (Int, HieName) -> IO ()) -> UniqFM (Int, HieName) -> IO ()
forall a b. (a -> b) -> a -> b
$! UniqFM (Int, HieName)
-> Name -> (Int, HieName) -> UniqFM (Int, HieName)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
External instance of the constraint type Uniquable Name
addToUFM UniqFM (Int, HieName)
symmap Name
name (Int
off, HieName
hieName)
      BinHandle -> Word32 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary Word32
put_ BinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word32
External instance of the constraint type Integral Int
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
External instance of the constraint type Eq SrcSpan
/= SrcSpan
span -> do
      IORef (UniqFM (Int, HieName)) -> UniqFM (Int, HieName) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (UniqFM (Int, HieName))
ref (UniqFM (Int, HieName) -> IO ()) -> UniqFM (Int, HieName) -> IO ()
forall a b. (a -> b) -> a -> b
$! UniqFM (Int, HieName)
-> Name -> (Int, HieName) -> UniqFM (Int, HieName)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
External instance of the constraint type Uniquable Name
addToUFM UniqFM (Int, HieName)
symmap Name
name (Int
off, Name -> HieName
toHieName Name
name)
      BinHandle -> Word32 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary Word32
put_ BinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word32
External instance of the constraint type Integral Int
fromIntegral Int
off :: Word32)
    Just (Int
off, HieName
_) -> BinHandle -> Word32 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary Word32
put_ BinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word32
External instance of the constraint type Integral Int
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
External instance of the constraint type Num Int
+Int
1)
        IORef (UniqFM (Int, HieName)) -> UniqFM (Int, HieName) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (UniqFM (Int, HieName))
ref (UniqFM (Int, HieName) -> IO ()) -> UniqFM (Int, HieName) -> IO ()
forall a b. (a -> b) -> a -> b
$! UniqFM (Int, HieName)
-> Name -> (Int, HieName) -> UniqFM (Int, HieName)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
External instance of the constraint type Uniquable Name
addToUFM UniqFM (Int, HieName)
symmap Name
name (Int
off, Name -> HieName
toHieName Name
name)
        BinHandle -> Word32 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary Word32
put_ BinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word32
External instance of the constraint type Integral Int
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
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type Outputable Char
External instance of the constraint type Outputable Int
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 ()
External instance of the constraint type forall a b c. (Binary a, Binary b, Binary c) => Binary (a, b, c)
External instance of the constraint type forall a. Binary a => Binary (GenModule a)
External instance of the constraint type Binary (GenUnit UnitId)
External instance of the constraint type Binary OccName
External instance of the constraint type Binary SrcSpan
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 ()
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary OccName
External instance of the constraint type Binary SrcSpan
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 ()
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary Char
External instance of the constraint type Binary Int
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
External instance of the constraint type forall a b c. (Binary a, Binary b, Binary c) => Binary (a, b, c)
External instance of the constraint type forall a. Binary a => Binary (GenModule a)
External instance of the constraint type Binary (GenUnit UnitId)
External instance of the constraint type Binary OccName
External instance of the constraint type Binary SrcSpan
get BinHandle
bh
      HieName -> IO HieName
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary OccName
External instance of the constraint type Binary SrcSpan
get BinHandle
bh
      HieName -> IO HieName
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary Char
External instance of the constraint type Binary Int
get BinHandle
bh
      HieName -> IO HieName
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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"