{-# LANGUAGE DerivingStrategies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module GHC.Iface.Ext.Binary.Instances where

import GHC.Types.Unique (getUnique)
import GHC.Types.Unique.DSet (unionManyUniqDSets)
import Control.Monad
import Data.Proxy
import GHC.Types.Name
import GHC.Types.Avail
import GHC.Types.Basic
import GHC.Types.Var hiding (varName)
import GHC.Unit.Types
import GHC.Iface.Type

import GHC.Iface.Ext.Binary.Utils

import GHC.Utils.Panic.Plain (panic)

instance Binary Name where
   put_ :: WriteBinHandle -> Name -> IO ()
put_ WriteBinHandle
bh Name
name =
      case Proxy Name -> WriteBinHandle -> BinaryWriter Name
forall a. Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a
findUserDataWriter Proxy Name
forall {k} (t :: k). Proxy t
Proxy WriteBinHandle
bh of
        BinaryWriter Name
tbl -> BinaryWriter Name -> WriteBinHandle -> Name -> IO ()
forall s. BinaryWriter s -> WriteBinHandle -> s -> IO ()
putEntry BinaryWriter Name
tbl WriteBinHandle
bh Name
name

   get :: ReadBinHandle -> IO Name
get ReadBinHandle
bh =
      case Proxy Name -> ReadBinHandle -> BinaryReader Name
forall a. Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a
findUserDataReader Proxy Name
forall {k} (t :: k). Proxy t
Proxy ReadBinHandle
bh of
        BinaryReader Name
tbl -> BinaryReader Name -> ReadBinHandle -> IO Name
forall s. BinaryReader s -> ReadBinHandle -> IO s
getEntry BinaryReader Name
tbl ReadBinHandle
bh

instance Binary a => Binary (GenModule a) where
  put_ :: WriteBinHandle -> GenModule a -> IO ()
put_ WriteBinHandle
bh (Module a
p ModuleName
n) = WriteBinHandle -> a -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh a
p IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> ModuleName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ModuleName
n
  -- Module has strict fields, so use $! in order not to allocate a thunk
  get :: ReadBinHandle -> IO (GenModule a)
get ReadBinHandle
bh = do a
p <- ReadBinHandle -> IO a
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; ModuleName
n <- ReadBinHandle -> IO ModuleName
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; GenModule a -> IO (GenModule a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenModule a -> IO (GenModule a))
-> GenModule a -> IO (GenModule a)
forall a b. (a -> b) -> a -> b
$! a -> ModuleName -> GenModule a
forall unit. unit -> ModuleName -> GenModule unit
Module a
p ModuleName
n

instance Binary Unit where
  put_ :: WriteBinHandle -> Unit -> IO ()
put_ WriteBinHandle
bh (RealUnit Definite UnitId
def_uid) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    WriteBinHandle -> Definite UnitId -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Definite UnitId
def_uid
  put_ WriteBinHandle
bh (VirtUnit GenInstantiatedUnit UnitId
indef_uid) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    WriteBinHandle -> GenInstantiatedUnit UnitId -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh GenInstantiatedUnit UnitId
indef_uid
  put_ WriteBinHandle
bh Unit
HoleUnit =
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
  get :: ReadBinHandle -> IO Unit
get ReadBinHandle
bh = do Word8
b <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
              Unit
u <- case Word8
b of
                Word8
0 -> (Definite UnitId -> Unit) -> IO (Definite UnitId) -> IO Unit
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (ReadBinHandle -> IO (Definite UnitId)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh)
                Word8
1 -> (GenInstantiatedUnit UnitId -> Unit)
-> IO (GenInstantiatedUnit UnitId) -> IO Unit
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenInstantiatedUnit UnitId -> Unit
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit (ReadBinHandle -> IO (GenInstantiatedUnit UnitId)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh)
                Word8
_ -> Unit -> IO Unit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit
forall uid. GenUnit uid
HoleUnit
              -- Unit has strict fields that need forcing; otherwise we allocate a thunk.
              Unit -> IO Unit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unit -> IO Unit) -> Unit -> IO Unit
forall a b. (a -> b) -> a -> b
$! Unit
u

deriving newtype instance Binary unit => Binary (Definite unit)

instance Binary InstantiatedUnit where
  put_ :: WriteBinHandle -> GenInstantiatedUnit UnitId -> IO ()
put_ WriteBinHandle
bh GenInstantiatedUnit UnitId
indef = do
    WriteBinHandle -> UnitId -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (GenInstantiatedUnit UnitId -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf GenInstantiatedUnit UnitId
indef)
    WriteBinHandle -> GenInstantiations UnitId -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (GenInstantiatedUnit UnitId -> GenInstantiations UnitId
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit UnitId
indef)
  get :: ReadBinHandle -> IO (GenInstantiatedUnit UnitId)
get ReadBinHandle
bh = do
    UnitId
cid   <- ReadBinHandle -> IO UnitId
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    GenInstantiations UnitId
insts <- ReadBinHandle -> IO (GenInstantiations UnitId)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    let fs :: FastString
fs = UnitId -> GenInstantiations UnitId -> FastString
forall u.
IsUnitId u =>
u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
mkInstantiatedUnitHash UnitId
cid GenInstantiations UnitId
insts
    -- InstantiatedUnit has strict fields, so use $! in order not to allocate a thunk
    GenInstantiatedUnit UnitId -> IO (GenInstantiatedUnit UnitId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenInstantiatedUnit UnitId -> IO (GenInstantiatedUnit UnitId))
-> GenInstantiatedUnit UnitId -> IO (GenInstantiatedUnit UnitId)
forall a b. (a -> b) -> a -> b
$! InstantiatedUnit {
                instUnitInstanceOf :: UnitId
instUnitInstanceOf = UnitId
cid,
                instUnitInsts :: GenInstantiations UnitId
instUnitInsts = GenInstantiations UnitId
insts,
                instUnitHoles :: UniqDSet ModuleName
instUnitHoles = [UniqDSet ModuleName] -> UniqDSet ModuleName
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (((ModuleName, GenModule Unit) -> UniqDSet ModuleName)
-> GenInstantiations UnitId -> [UniqDSet ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (GenModule Unit -> UniqDSet ModuleName
forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles(GenModule Unit -> UniqDSet ModuleName)
-> ((ModuleName, GenModule Unit) -> GenModule Unit)
-> (ModuleName, GenModule Unit)
-> UniqDSet ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ModuleName, GenModule Unit) -> GenModule Unit
forall a b. (a, b) -> b
snd) GenInstantiations UnitId
insts),
                instUnitFS :: FastString
instUnitFS = FastString
fs,
                instUnitKey :: Unique
instUnitKey = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
fs
              }

instance Binary UnitId where
  put_ :: WriteBinHandle -> UnitId -> IO ()
put_ WriteBinHandle
bh (UnitId FastString
fs) = WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
fs
  get :: ReadBinHandle -> IO UnitId
get ReadBinHandle
bh = do FastString
fs <- ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; UnitId -> IO UnitId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> UnitId
UnitId FastString
fs)

instance Binary AvailInfo where
    put_ :: WriteBinHandle -> AvailInfo -> IO ()
put_ WriteBinHandle
bh (Avail Name
aa) = do
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
            WriteBinHandle -> Name -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Name
aa
    put_ WriteBinHandle
bh (AvailTC Name
ab [Name]
ac) = do
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
            WriteBinHandle -> Name -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Name
ab
            WriteBinHandle -> [Name] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [Name]
ac
    get :: ReadBinHandle -> IO AvailInfo
get ReadBinHandle
bh = do
            Word8
h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case Word8
h of
              Word8
0 -> do Name
aa <- ReadBinHandle -> IO Name
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      AvailInfo -> IO AvailInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> AvailInfo
Avail Name
aa)
              Word8
_ -> do Name
ab <- ReadBinHandle -> IO Name
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      [Name]
ac <- ReadBinHandle -> IO [Name]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      AvailInfo -> IO AvailInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name] -> AvailInfo
AvailTC Name
ab [Name]
ac)

instance Binary IfaceTyCon where
  put_ :: WriteBinHandle -> IfaceTyCon -> IO ()
put_ WriteBinHandle
bh (IfaceTyCon Name
n IfaceTyConInfo
i) = WriteBinHandle -> Name -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Name
n IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> IfaceTyConInfo -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTyConInfo
i

  get :: ReadBinHandle -> IO IfaceTyCon
get ReadBinHandle
bh = do
    Name
n <- ReadBinHandle -> IO Name
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    IfaceTyConInfo
i <- ReadBinHandle -> IO IfaceTyConInfo
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    IfaceTyCon -> IO IfaceTyCon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon Name
n IfaceTyConInfo
i)

instance Binary IfaceTyConSort where
   put_ :: WriteBinHandle -> IfaceTyConSort -> IO ()
put_ WriteBinHandle
bh IfaceTyConSort
IfaceNormalTyCon             = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
   put_ WriteBinHandle
bh (IfaceTupleTyCon Arity
arity TupleSort
sort) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Arity -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Arity
arity IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> TupleSort -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh TupleSort
sort
   put_ WriteBinHandle
bh (IfaceSumTyCon Arity
arity)        = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Arity -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Arity
arity
   put_ WriteBinHandle
bh IfaceTyConSort
IfaceEqualityTyCon           = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3

   get :: ReadBinHandle -> IO IfaceTyConSort
get ReadBinHandle
bh = do
       Word8
n <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
       case Word8
n of
         Word8
0 -> IfaceTyConSort -> IO IfaceTyConSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceNormalTyCon
         Word8
1 -> Arity -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon (Arity -> TupleSort -> IfaceTyConSort)
-> IO Arity -> IO (TupleSort -> IfaceTyConSort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Arity
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (TupleSort -> IfaceTyConSort)
-> IO TupleSort -> IO IfaceTyConSort
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 TupleSort
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
         Word8
2 -> Arity -> IfaceTyConSort
IfaceSumTyCon (Arity -> IfaceTyConSort) -> IO Arity -> IO IfaceTyConSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Arity
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
         Word8
_ -> IfaceTyConSort -> IO IfaceTyConSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceEqualityTyCon

instance Binary IfaceTyConInfo where
   put_ :: WriteBinHandle -> IfaceTyConInfo -> IO ()
put_ WriteBinHandle
bh (IfaceTyConInfo PromotionFlag
i IfaceTyConSort
s) = WriteBinHandle -> PromotionFlag -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh PromotionFlag
i IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> IfaceTyConSort -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTyConSort
s

   get :: ReadBinHandle -> IO IfaceTyConInfo
get ReadBinHandle
bh = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo)
-> IO PromotionFlag -> IO (IfaceTyConSort -> IfaceTyConInfo)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ReadBinHandle -> IO PromotionFlag
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (IfaceTyConSort -> IfaceTyConInfo)
-> IO IfaceTyConSort -> IO IfaceTyConInfo
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 IfaceTyConSort
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    -- We want to make sure, when reading from disk, as the most common case
    -- is supposed to be shared. Any thunk adds an additional indirection
    -- making sharing less useful.
    --
    -- See !12200 for how this bang and the one in 'IfaceTyCon' reduces the
    -- residency by ~10% when loading 'mi_extra_decls' from disk.

instance Binary TupleSort where
    put_ :: WriteBinHandle -> TupleSort -> IO ()
put_ WriteBinHandle
bh TupleSort
BoxedTuple      = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh TupleSort
UnboxedTuple    = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    put_ WriteBinHandle
bh TupleSort
ConstraintTuple = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    get :: ReadBinHandle -> IO TupleSort
get ReadBinHandle
bh = do
      Word8
h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
      case Word8
h of
        Word8
0 -> TupleSort -> IO TupleSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
BoxedTuple
        Word8
1 -> TupleSort -> IO TupleSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
UnboxedTuple
        Word8
_ -> TupleSort -> IO TupleSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
ConstraintTuple

instance Binary PromotionFlag where
   put_ :: WriteBinHandle -> PromotionFlag -> IO ()
put_ WriteBinHandle
bh PromotionFlag
NotPromoted = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
   put_ WriteBinHandle
bh PromotionFlag
IsPromoted  = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1

   get :: ReadBinHandle -> IO PromotionFlag
get ReadBinHandle
bh = do
       Word8
n <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
       case Word8
n of
         Word8
0 -> PromotionFlag -> IO PromotionFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PromotionFlag
NotPromoted
         Word8
1 -> PromotionFlag -> IO PromotionFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PromotionFlag
IsPromoted
         Word8
_ -> String -> IO PromotionFlag
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Binary(IsPromoted): fail)"

instance Binary ForAllTyFlag where
  put_ :: WriteBinHandle -> ForAllTyFlag -> IO ()
put_ WriteBinHandle
bh ForAllTyFlag
Required  = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
  put_ WriteBinHandle
bh ForAllTyFlag
Specified = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
  put_ WriteBinHandle
bh ForAllTyFlag
Inferred  = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2

  get :: ReadBinHandle -> IO ForAllTyFlag
get ReadBinHandle
bh = do
    Word8
h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
    case Word8
h of
      Word8
0 -> ForAllTyFlag -> IO ForAllTyFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForAllTyFlag
Required
      Word8
1 -> ForAllTyFlag -> IO ForAllTyFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForAllTyFlag
Specified
      Word8
_ -> ForAllTyFlag -> IO ForAllTyFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForAllTyFlag
Inferred

instance Binary IfaceTyLit where
  put_ :: WriteBinHandle -> IfaceTyLit -> IO ()
put_ WriteBinHandle
bh (IfaceNumTyLit Integer
n)   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Integer -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Integer
n
  put_ WriteBinHandle
bh (IfaceStrTyLit FastString
n)   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
n
  put_ WriteBinHandle
bh (IfaceCharTyLit Char
n)  = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Char -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Char
n

  get :: ReadBinHandle -> IO IfaceTyLit
get ReadBinHandle
bh =
    do Word8
tag <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
       case Word8
tag of
         Word8
1 -> do { Integer
n <- ReadBinHandle -> IO Integer
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IfaceTyLit
IfaceNumTyLit Integer
n) }
         Word8
2 -> do { FastString
n <- ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfaceTyLit
IfaceStrTyLit FastString
n) }
         Word8
3 -> do { Char
n <- ReadBinHandle -> IO Char
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> IfaceTyLit
IfaceCharTyLit Char
n) }
         Word8
_ -> String -> IO IfaceTyLit
forall a. HasCallStack => String -> a
panic (String
"get IfaceTyLit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)

putAllTables :: WriteBinHandle -> [WriterTable] -> IO b -> IO ([Int], b)
putAllTables :: forall b.
WriteBinHandle -> [WriterTable] -> IO b -> IO ([Arity], b)
putAllTables WriteBinHandle
_ [] IO b
act = do
  b
a <- IO b
act
  ([Arity], b) -> IO ([Arity], b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], b
a)
putAllTables WriteBinHandle
bh (WriterTable
x : [WriterTable]
xs) IO b
act = do
  (Arity
r, ([Arity]
res, b
a)) <- WriteBinHandle
-> (([Arity], b) -> IO Arity)
-> IO ([Arity], b)
-> IO (Arity, ([Arity], b))
forall b a. WriteBinHandle -> (b -> IO a) -> IO b -> IO (a, b)
forwardPutRel WriteBinHandle
bh (IO Arity -> ([Arity], b) -> IO Arity
forall a b. a -> b -> a
const (IO Arity -> ([Arity], b) -> IO Arity)
-> IO Arity -> ([Arity], b) -> IO Arity
forall a b. (a -> b) -> a -> b
$ WriterTable -> WriteBinHandle -> IO Arity
putTable WriterTable
x WriteBinHandle
bh) (IO ([Arity], b) -> IO (Arity, ([Arity], b)))
-> IO ([Arity], b) -> IO (Arity, ([Arity], b))
forall a b. (a -> b) -> a -> b
$ do
    WriteBinHandle -> [WriterTable] -> IO b -> IO ([Arity], b)
forall b.
WriteBinHandle -> [WriterTable] -> IO b -> IO ([Arity], b)
putAllTables WriteBinHandle
bh [WriterTable]
xs IO b
act
  ([Arity], b) -> IO ([Arity], b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arity
r Arity -> [Arity] -> [Arity]
forall a. a -> [a] -> [a]
: [Arity]
res, b
a)

instance Binary OccName where
    put_ :: WriteBinHandle -> OccName -> IO ()
put_ WriteBinHandle
bh OccName
name = do
            WriteBinHandle -> NameSpace -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (OccName -> NameSpace
occNameSpace OccName
name)
            WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (OccName -> FastString
occNameFS OccName
name)
    get :: ReadBinHandle -> IO OccName
get ReadBinHandle
bh = do
          NameSpace
aa <- ReadBinHandle -> IO NameSpace
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          FastString
ab <- ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          OccName -> IO OccName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
aa FastString
ab)

instance Binary NameSpace where
    put_ :: WriteBinHandle -> NameSpace -> IO ()
put_ WriteBinHandle
_ NameSpace
_ = IO ()
forall a. HasCallStack => a
undefined
    get :: ReadBinHandle -> IO NameSpace
get ReadBinHandle
bh = do
            Word8
h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case Word8
h of
              Word8
0 -> NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
varName
              Word8
1 -> NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
dataName
              Word8
2 -> NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
tvName
              Word8
3 -> NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NameSpace
tcClsName
              Word8
_ -> do
                FastString
parent <- ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                NameSpace -> IO NameSpace
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameSpace -> IO NameSpace) -> NameSpace -> IO NameSpace
forall a b. (a -> b) -> a -> b
$ FastString -> NameSpace
fieldName FastString
parent