{-# LANGUAGE BlockArguments #-}
module GHC.Iface.Ext.Binary.GHC912 (
  readHieFile908
, readHieFile910
, readHieFile912
) where

import           Data.Typeable
import Prelude hiding (span, mod)

import GHC.Builtin.Utils
import GHC.Iface.Ext.Binary.Utils
import GHC.Iface.Ext.Types
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Types.Unique
import GHC.Utils.Outputable hiding (char)
import GHC.Utils.Panic
import GHC.Types.Avail (AvailInfo)
import GHC.Unit.Module (Module)
import GHC.Types.SrcLoc

import Data.Array (Array)
import qualified Data.Array        as A
import qualified Data.Array.IO     as A
import qualified Data.Array.Unsafe as A
import Data.Word                  ( Word32 )
import Data.ByteString (ByteString)
import Control.Monad

readHieFile908 :: ReadBinHandle -> NameCache -> IO HieFile
readHieFile908 :: ReadBinHandle -> NameCache -> IO HieFile
readHieFile908 = GHC -> ReadBinHandle -> NameCache -> IO HieFile
readHieFile908_910 GHC
GHC908

readHieFile910 :: ReadBinHandle -> NameCache -> IO HieFile
readHieFile910 :: ReadBinHandle -> NameCache -> IO HieFile
readHieFile910 = GHC -> ReadBinHandle -> NameCache -> IO HieFile
readHieFile908_910 GHC
GHC910

readHieFile908_910 :: GHC -> ReadBinHandle -> NameCache -> IO HieFile
readHieFile908_910 :: GHC -> ReadBinHandle -> NameCache -> IO HieFile
readHieFile908_910 GHC
ghc ReadBinHandle
bh0 NameCache
name_cache = do
  Bin ()
dict_p <- ReadBinHandle -> IO (Bin ())
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh0
  Bin ()
symtab_p <- ReadBinHandle -> IO (Bin ())
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh0
  GHC
-> Bin ()
-> Bin ()
-> (ReadBinHandle -> IO NameEntityInfo)
-> ReadBinHandle
-> NameCache
-> IO HieFile
readHieFile GHC
ghc Bin ()
dict_p Bin ()
symtab_p (IO NameEntityInfo -> ReadBinHandle -> IO NameEntityInfo
forall a b. a -> b -> a
const IO NameEntityInfo
forall a. Monoid a => a
mempty) ReadBinHandle
bh0 NameCache
name_cache

readHieFile912 :: ReadBinHandle -> NameCache -> IO HieFile
readHieFile912 :: ReadBinHandle -> NameCache -> IO HieFile
readHieFile912 ReadBinHandle
bh0 NameCache
name_cache = do
  Bin ()
dict_p <- RelBin () -> Bin ()
forall {k} (a :: k). RelBin a -> Bin a
makeAbsoluteBin (RelBin () -> Bin ()) -> IO (RelBin ()) -> IO (Bin ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO (RelBin ())
forall {k} (a :: k). ReadBinHandle -> IO (RelBin a)
getRelBin ReadBinHandle
bh0
  Bin ()
symtab_p <- RelBin () -> Bin ()
forall {k} (a :: k). RelBin a -> Bin a
makeAbsoluteBin (RelBin () -> Bin ()) -> IO (RelBin ()) -> IO (Bin ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO (RelBin ())
forall {k} (a :: k). ReadBinHandle -> IO (RelBin a)
getRelBin ReadBinHandle
bh0
  GHC
-> Bin ()
-> Bin ()
-> (ReadBinHandle -> IO NameEntityInfo)
-> ReadBinHandle
-> NameCache
-> IO HieFile
readHieFile GHC
GHC912 Bin ()
dict_p Bin ()
symtab_p ReadBinHandle -> IO NameEntityInfo
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh0 NameCache
name_cache

initReadNameTable :: GHC -> Module -> NameCache -> IO (ReaderTable Name)
initReadNameTable :: GHC -> Module -> NameCache -> IO (ReaderTable Name)
initReadNameTable GHC
ghc Module
currentModule 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 -> GHC
-> Module -> ReadBinHandle -> NameCache -> IO (SymbolTable Name)
getSymbolTable GHC
ghc Module
currentModule 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)
      }

readHieFile :: GHC -> Bin () -> Bin () -> (ReadBinHandle -> IO NameEntityInfo) -> ReadBinHandle -> NameCache -> IO HieFile
readHieFile :: GHC
-> Bin ()
-> Bin ()
-> (ReadBinHandle -> IO NameEntityInfo)
-> ReadBinHandle
-> NameCache
-> IO HieFile
readHieFile GHC
ghc Bin ()
dict_p Bin ()
symtab_p ReadBinHandle -> IO NameEntityInfo
getNameEntityInfo ReadBinHandle
bh0 NameCache
name_cache = do

  ReaderTable FastString
fsReaderTable <- IO (ReaderTable FastString)
initFastStringReaderTable
  ReadBinHandle
bh_dict <- Bin ()
-> ReaderTable FastString -> ReadBinHandle -> IO ReadBinHandle
forall a.
Typeable a =>
Bin () -> ReaderTable a -> ReadBinHandle -> IO ReadBinHandle
get_dictionary Bin ()
dict_p ReaderTable FastString
fsReaderTable ReadBinHandle
bh0

  FilePath
file <- forall a. Binary a => ReadBinHandle -> IO a
get @FilePath ReadBinHandle
bh_dict
  Module
currentModule <- forall a. Binary a => ReadBinHandle -> IO a
get @Module ReadBinHandle
bh_dict

  ReaderTable Name
nameReaderTable <- GHC -> Module -> NameCache -> IO (ReaderTable Name)
initReadNameTable GHC
ghc Module
currentModule NameCache
name_cache
  ReadBinHandle
bh_symtab <- Bin () -> ReaderTable Name -> ReadBinHandle -> IO ReadBinHandle
forall a.
Typeable a =>
Bin () -> ReaderTable a -> ReadBinHandle -> IO ReadBinHandle
get_dictionary Bin ()
symtab_p ReaderTable Name
nameReaderTable ReadBinHandle
bh_dict

  -- load the actual data
  FilePath
-> Module
-> Array Int HieTypeFlat
-> HieASTs Int
-> [AvailInfo]
-> ByteString
-> NameEntityInfo
-> HieFile
HieFile FilePath
file Module
currentModule
    (Array Int HieTypeFlat
 -> HieASTs Int
 -> [AvailInfo]
 -> ByteString
 -> NameEntityInfo
 -> HieFile)
-> IO (Array Int HieTypeFlat)
-> IO
     (HieASTs Int
      -> [AvailInfo] -> ByteString -> NameEntityInfo -> HieFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => ReadBinHandle -> IO a
get @(Array TypeIndex HieTypeFlat) ReadBinHandle
bh_symtab
    IO
  (HieASTs Int
   -> [AvailInfo] -> ByteString -> NameEntityInfo -> HieFile)
-> IO (HieASTs Int)
-> IO ([AvailInfo] -> ByteString -> NameEntityInfo -> HieFile)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => ReadBinHandle -> IO a
get @(HieASTs TypeIndex) ReadBinHandle
bh_symtab
    IO ([AvailInfo] -> ByteString -> NameEntityInfo -> HieFile)
-> IO [AvailInfo] -> IO (ByteString -> NameEntityInfo -> HieFile)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => ReadBinHandle -> IO a
get @([AvailInfo]) ReadBinHandle
bh_symtab
    IO (ByteString -> NameEntityInfo -> HieFile)
-> IO ByteString -> IO (NameEntityInfo -> HieFile)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => ReadBinHandle -> IO a
get @ByteString ReadBinHandle
bh_symtab
    IO (NameEntityInfo -> HieFile) -> IO NameEntityInfo -> IO HieFile
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO NameEntityInfo
getNameEntityInfo ReadBinHandle
bh_symtab
  where
    get_dictionary :: forall a. Typeable a => Bin () -> ReaderTable a -> ReadBinHandle -> IO ReadBinHandle
    get_dictionary :: forall a.
Typeable a =>
Bin () -> ReaderTable a -> ReadBinHandle -> IO ReadBinHandle
get_dictionary Bin ()
p ReaderTable a
tbl ReadBinHandle
bin_handle = IO ReadBinHandle -> IO ReadBinHandle
forall a. IO a -> IO a
withRestore do
      ReadBinHandle -> Bin () -> IO ()
forall {k} (a :: k). ReadBinHandle -> Bin a -> IO ()
seekBinReader ReadBinHandle
bin_handle Bin ()
p
      SymbolTable a
fsTable :: SymbolTable a <- ReaderTable a -> ReadBinHandle -> IO (SymbolTable a)
forall a. ReaderTable a -> ReadBinHandle -> IO (SymbolTable a)
getTable ReaderTable a
tbl ReadBinHandle
bin_handle
      let
        fsReader :: BinaryReader a
        fsReader :: BinaryReader a
fsReader = ReaderTable a -> SymbolTable a -> BinaryReader a
forall a. ReaderTable a -> SymbolTable a -> BinaryReader a
mkReaderFromTable ReaderTable a
tbl SymbolTable a
fsTable

        bhFs :: ReadBinHandle
        bhFs :: ReadBinHandle
bhFs = BinaryReader a -> ReadBinHandle -> ReadBinHandle
forall a.
Typeable a =>
BinaryReader a -> ReadBinHandle -> ReadBinHandle
addReaderToUserData BinaryReader a
fsReader ReadBinHandle
bin_handle
      ReadBinHandle -> IO ReadBinHandle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadBinHandle
bhFs

    withRestore :: IO a -> IO a
    withRestore :: forall a. IO a -> IO a
withRestore IO a
action = do
      Bin Any
backup <- ReadBinHandle -> IO (Bin Any)
forall {k} (a :: k). ReadBinHandle -> IO (Bin a)
tellBinReader ReadBinHandle
bh0
      IO a
action IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadBinHandle -> Bin Any -> IO ()
forall {k} (a :: k). ReadBinHandle -> Bin a -> IO ()
seekBinReader ReadBinHandle
bh0 Bin Any
backup

getSymbolTable :: GHC -> Module -> ReadBinHandle -> NameCache -> IO (SymbolTable Name)
getSymbolTable :: GHC
-> Module -> ReadBinHandle -> NameCache -> IO (SymbolTable Name)
getSymbolTable GHC
ghc Module
currentModule ReadBinHandle
bh NameCache
name_cache = do
  Int
sz <- ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
  IOArray Int Name
mut_arr <- (Int, Int) -> IO (IOArray Int Name)
forall i. Ix i => (i, i) -> IO (IOArray i Name)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
A.newArray_ (Int
0, Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: IO (A.IOArray Int Name)
  [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    HieName
od_name <- ReadBinHandle -> IO HieName
getHieName ReadBinHandle
bh
    Name
name <- GHC -> Module -> NameCache -> HieName -> IO Name
fromHieName GHC
ghc Module
currentModule NameCache
name_cache HieName
od_name
    IOArray Int Name -> Int -> Name -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
A.writeArray IOArray Int Name
mut_arr Int
i Name
name
  IOArray Int Name -> IO (SymbolTable Name)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
A.unsafeFreeze IOArray Int Name
mut_arr

getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name
getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name
getSymTabName SymbolTable Name
st ReadBinHandle
bh = do
  Word32
i :: Word32 <- ReadBinHandle -> IO Word32
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
  Name -> IO Name
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> IO Name) -> Name -> IO Name
forall a b. (a -> b) -> a -> b
$ SymbolTable Name
st SymbolTable Name -> 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)

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

fromHieName :: GHC -> Module -> NameCache -> HieName -> IO Name
fromHieName :: GHC -> Module -> NameCache -> HieName -> IO Name
fromHieName GHC
ghc Module
currentModule 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
old_name -> case Name -> SrcSpan
nameSrcSpan Name
old_name of
          UnhelpfulSpan {} -> IO (OrigNameCache, Name)
update
          RealSrcSpan {}
            | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
currentModule -> IO (OrigNameCache, Name)
update
            | Bool
otherwise -> IO (OrigNameCache, Name)
keep
          where
            new_name :: Name
new_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
extendOrigNameCache OrigNameCache
cache Module
mod OccName
occ Name
new_name
            uniq :: Unique
uniq = Name -> Unique
nameUnique Name
old_name

            update :: IO (OrigNameCache, Name)
update = (OrigNameCache, Name) -> IO (OrigNameCache, Name)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrigNameCache
new_cache, Name
new_name)
            keep :: IO (OrigNameCache, Name)
keep = (OrigNameCache, Name) -> IO (OrigNameCache, Name)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrigNameCache
cache, Name
old_name)

        Maybe Name
Nothing   -> do
          Unique
uniq <- NameCache -> IO Unique
takeUniqFromNameCache NameCache
nc
          let 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
extendOrigNameCache OrigNameCache
cache Module
mod OccName
occ Name
name
          (OrigNameCache, Name) -> IO (OrigNameCache, Name)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrigNameCache
new_cache, Name
name)

    LocalName OccName
occ SrcSpan
span -> do
      Unique
uniq <- NameCache -> IO Unique
takeUniqFromNameCache NameCache
nc
      -- don't update the NameCache for local names
      Name -> IO Name
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> IO Name) -> Name -> IO Name
forall a b. (a -> b) -> a -> b
$ Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq OccName
occ SrcSpan
span

    KnownKeyName Unique
u -> case GHC -> Unique -> Maybe Name
lookupKnownKeyName GHC
ghc Unique
u of
      Maybe Name
Nothing -> FilePath -> SDoc -> IO Name
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"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

getHieName :: ReadBinHandle -> IO HieName
getHieName :: ReadBinHandle -> IO HieName
getHieName ReadBinHandle
bh = do
  Word8
t <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
  case Word8
t of
    Word8
0 -> do
      (Module
modu, OccName
occ, BinSrcSpan
span) <- ReadBinHandle -> IO (Module, OccName, BinSrcSpan)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
      HieName -> IO HieName
forall a. a -> IO a
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 -> HieName) -> SrcSpan -> HieName
forall a b. (a -> b) -> a -> b
$ BinSrcSpan -> SrcSpan
unBinSrcSpan BinSrcSpan
span
    Word8
1 -> do
      (OccName
occ, BinSrcSpan
span) <- ReadBinHandle -> IO (OccName, BinSrcSpan)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
      HieName -> IO HieName
forall a. a -> IO a
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 -> HieName) -> SrcSpan -> HieName
forall a b. (a -> b) -> a -> b
$ BinSrcSpan -> SrcSpan
unBinSrcSpan BinSrcSpan
span
    Word8
2 -> do
      (Char
c,Word64
i) <- ReadBinHandle -> IO (Char, Word64)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
      HieName -> IO HieName
forall a. a -> IO a
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 -> Word64 -> Unique
mkUnique Char
c Word64
i
    Word8
_ -> FilePath -> IO HieName
forall a. HasCallStack => FilePath -> a
panic FilePath
"GHC.Iface.Ext.Binary.getHieName: invalid tag"