{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.Types.ForeignCall (
ForeignDecl(..),
LForeignDecl,
ForeignCall(..),
isSafeForeignCall,
CCallSpec(..),
ForeignExport(..),
CExportSpec(..),
ForeignImport(..),
CCallTarget(..),
StaticTargetGhc(..),
CCallStaticTargetUnit(..),
isDynamicTarget,
ForeignKind(..),
Safety(..),
playSafe,
playInterruptible,
CImportSpec(..),
CType(..),
defaultCType,
mkCType,
typeCheckCType,
CTypeGhc(..),
CCallConv(..),
defaultCCallConv,
ccallConvAttribute,
CLabelString,
isCLabelString,
pprCLabelString,
Header(..),
renameHeader,
typeCheckHeader,
) where
import GHC.Prelude
import GHC.Data.FastString
import GHC.Hs.Extension
import GHC.Types.SourceText (SourceText(..), pprWithSourceText)
import GHC.Unit.Types
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Language.Haskell.Syntax.Decls.Foreign
import Language.Haskell.Syntax.Extension
import Data.Char
import Data.Data (Data)
import Data.Functor ((<&>))
import Control.DeepSeq (NFData(..))
newtype ForeignCall = CCall CCallSpec
deriving (ForeignCall -> ForeignCall -> Bool
(ForeignCall -> ForeignCall -> Bool)
-> (ForeignCall -> ForeignCall -> Bool) -> Eq ForeignCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForeignCall -> ForeignCall -> Bool
== :: ForeignCall -> ForeignCall -> Bool
$c/= :: ForeignCall -> ForeignCall -> Bool
/= :: ForeignCall -> ForeignCall -> Bool
Eq)
isSafeForeignCall :: ForeignCall -> Bool
isSafeForeignCall :: ForeignCall -> Bool
isSafeForeignCall (CCall (CCallSpec CCallTarget GhcTc
_ CCallConv
_ Safety
safe)) = Safety -> Bool
playSafe Safety
safe
instance Outputable ForeignCall where
ppr :: ForeignCall -> SDoc
ppr (CCall CCallSpec
cc) = CCallSpec -> SDoc
forall a. Outputable a => a -> SDoc
ppr CCallSpec
cc
playSafe :: Safety -> Bool
playSafe :: Safety -> Bool
playSafe Safety
PlaySafe = Bool
True
playSafe Safety
PlayInterruptible = Bool
True
playSafe Safety
PlayRisky = Bool
False
playInterruptible :: Safety -> Bool
playInterruptible :: Safety -> Bool
playInterruptible Safety
PlayInterruptible = Bool
True
playInterruptible Safety
_ = Bool
False
data CCallSpec
= CCallSpec
(CCallTarget GhcTc)
CCallConv
Safety
deriving (CCallSpec -> CCallSpec -> Bool
(CCallSpec -> CCallSpec -> Bool)
-> (CCallSpec -> CCallSpec -> Bool) -> Eq CCallSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CCallSpec -> CCallSpec -> Bool
== :: CCallSpec -> CCallSpec -> Bool
$c/= :: CCallSpec -> CCallSpec -> Bool
/= :: CCallSpec -> CCallSpec -> Bool
Eq)
isDynamicTarget :: CCallTarget p -> Bool
isDynamicTarget :: forall p. CCallTarget p -> Bool
isDynamicTarget DynamicTarget{} = Bool
True
isDynamicTarget CCallTarget p
_ = Bool
False
defaultCCallConv :: CCallConv
defaultCCallConv :: CCallConv
defaultCCallConv = CCallConv
CCallConv
ccallConvAttribute :: CCallConv -> SDoc
ccallConvAttribute :: CCallConv -> SDoc
ccallConvAttribute CCallConv
StdCallConv = String -> SDoc
forall a. HasCallStack => String -> a
panic String
"ccallConvAttribute StdCallConv"
ccallConvAttribute CCallConv
CCallConv = SDoc
forall doc. IsOutput doc => doc
empty
ccallConvAttribute CCallConv
CApiConv = SDoc
forall doc. IsOutput doc => doc
empty
ccallConvAttribute (PrimCallConv {}) = String -> SDoc
forall a. HasCallStack => String -> a
panic String
"ccallConvAttribute PrimCallConv"
ccallConvAttribute CCallConv
JavaScriptCallConv = SDoc
forall doc. IsOutput doc => doc
empty
pprCLabelString :: CLabelString -> SDoc
pprCLabelString :: CLabelString -> SDoc
pprCLabelString CLabelString
lbl = CLabelString -> SDoc
forall doc. IsLine doc => CLabelString -> doc
ftext CLabelString
lbl
isCLabelString :: CLabelString -> Bool
isCLabelString :: CLabelString -> Bool
isCLabelString CLabelString
lbl
= (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
ok (CLabelString -> String
unpackFS CLabelString
lbl)
where
ok :: Char -> Bool
ok Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'
instance Outputable CCallSpec where
ppr :: CCallSpec -> SDoc
ppr (CCallSpec CCallTarget GhcTc
fun CCallConv
cconv Safety
safety)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug SDoc
callconv, CCallTarget GhcTc -> SDoc
ppr_fun CCallTarget GhcTc
fun, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" ::" ]
where
callconv :: SDoc
callconv = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CCallConv -> SDoc
forall a. Outputable a => a -> SDoc
ppr CCallConv
cconv SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-}"
gc_suf :: SDoc
gc_suf | Safety -> Bool
playSafe Safety
safety = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"_safe"
| Bool
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"_unsafe"
ppr_fun :: CCallTarget GhcTc -> SDoc
ppr_fun = \case
DynamicTarget{} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__ffi_dyn_ccall" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
gc_suf SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\"\""
StaticTarget XStaticTarget GhcTc
ext CLabelString
label ForeignKind
isFun ->
let pCallType :: SDoc
pCallType = case ForeignKind
isFun of
ForeignKind
ForeignValue -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__ffi_static_ccall_value"
ForeignKind
ForeignFunction -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__ffi_static_ccall"
pprUnit :: StaticTargetGhc -> SDoc
pprUnit StaticTargetGhc
ext = case StaticTargetGhc -> CCallStaticTargetUnit
staticTargetUnit StaticTargetGhc
ext of
CCallStaticTargetUnit
TargetIsInThisUnit -> SDoc
forall doc. IsOutput doc => doc
empty
TargetIsInThat Unit
unit -> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
unit
(SourceText
srcTxt, SDoc
pPkgId) = (StaticTargetGhc -> SourceText
staticTargetLabel XStaticTarget GhcTc
StaticTargetGhc
ext, StaticTargetGhc -> SDoc
pprUnit XStaticTarget GhcTc
StaticTargetGhc
ext)
in SDoc
pCallType
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
gc_suf
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pPkgId
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
":"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabelString
label
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
srcTxt SDoc
forall doc. IsOutput doc => doc
empty)
defaultCType :: String -> CType (GhcPass p)
defaultCType :: forall (p :: Pass). String -> CType (GhcPass p)
defaultCType =
XCType (GhcPass p)
-> Maybe (Header (GhcPass p)) -> CLabelString -> CType (GhcPass p)
forall pass.
XCType pass -> Maybe (Header pass) -> CLabelString -> CType pass
CType (SourceText -> SourceText -> CTypeGhc
CTypeGhc SourceText
NoSourceText SourceText
NoSourceText) Maybe (Header (GhcPass p))
forall a. Maybe a
Nothing (CLabelString -> CType (GhcPass p))
-> (String -> CLabelString) -> String -> CType (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CLabelString
fsLit
mkCType :: SourceText -> SourceText -> Maybe (Header (GhcPass p)) -> FastString -> CType (GhcPass p)
mkCType :: forall (p :: Pass).
SourceText
-> SourceText
-> Maybe (Header (GhcPass p))
-> CLabelString
-> CType (GhcPass p)
mkCType SourceText
x SourceText
y Maybe (Header (GhcPass p))
m =
XCType (GhcPass p)
-> Maybe (Header (GhcPass p)) -> CLabelString -> CType (GhcPass p)
forall pass.
XCType pass -> Maybe (Header pass) -> CLabelString -> CType pass
CType (SourceText -> SourceText -> CTypeGhc
CTypeGhc SourceText
x SourceText
y) Maybe (Header (GhcPass p))
m
typeCheckCType :: CType GhcRn -> CType GhcTc
typeCheckCType :: CType GhcRn -> CType GhcTc
typeCheckCType (CType XCType GhcRn
x Maybe (Header GhcRn)
y CLabelString
z) = XCType GhcTc -> Maybe (Header GhcTc) -> CLabelString -> CType GhcTc
forall pass.
XCType pass -> Maybe (Header pass) -> CLabelString -> CType pass
CType XCType GhcRn
XCType GhcTc
x (Header GhcRn -> Header GhcTc
typeCheckHeader (Header GhcRn -> Header GhcTc)
-> Maybe (Header GhcRn) -> Maybe (Header GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Header GhcRn)
y) CLabelString
z
typeCheckHeader :: Header GhcRn -> Header GhcTc
(Header XHeader GhcRn
a CLabelString
b) = XHeader GhcTc -> CLabelString -> Header GhcTc
forall pass. XHeader pass -> CLabelString -> Header pass
Header XHeader GhcRn
XHeader GhcTc
a CLabelString
b
renameHeader :: Header GhcPs -> Header GhcRn
(Header XHeader GhcPs
a CLabelString
b) = XHeader GhcRn -> CLabelString -> Header GhcRn
forall pass. XHeader pass -> CLabelString -> Header pass
Header XHeader GhcPs
XHeader GhcRn
a CLabelString
b
instance Binary ForeignCall where
put_ :: WriteBinHandle -> ForeignCall -> IO ()
put_ WriteBinHandle
bh (CCall CCallSpec
aa) = WriteBinHandle -> CCallSpec -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CCallSpec
aa
get :: ReadBinHandle -> IO ForeignCall
get ReadBinHandle
bh = do aa <- ReadBinHandle -> IO CCallSpec
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; return (CCall aa)
instance Binary CCallSpec where
put_ :: WriteBinHandle -> CCallSpec -> IO ()
put_ WriteBinHandle
bh (CCallSpec CCallTarget GhcTc
aa CCallConv
ab Safety
ac) = do
WriteBinHandle -> CCallTarget GhcTc -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CCallTarget GhcTc
aa
WriteBinHandle -> CCallConv -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CCallConv
ab
WriteBinHandle -> Safety -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Safety
ac
get :: ReadBinHandle -> IO CCallSpec
get ReadBinHandle
bh = do
aa <- ReadBinHandle -> IO (CCallTarget GhcTc)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
ab <- get bh
ac <- get bh
return (CCallSpec aa ab ac)
instance NFData ForeignCall where
rnf :: ForeignCall -> ()
rnf (CCall CCallSpec
c) = CCallSpec -> ()
forall a. NFData a => a -> ()
rnf CCallSpec
c
instance NFData CCallSpec where
rnf :: CCallSpec -> ()
rnf (CCallSpec CCallTarget GhcTc
t CCallConv
c Safety
s) = CCallTarget GhcTc -> ()
forall a. NFData a => a -> ()
rnf CCallTarget GhcTc
t () -> () -> ()
forall a b. a -> b -> b
`seq` CCallConv -> ()
forall a. NFData a => a -> ()
rnf CCallConv
c () -> () -> ()
forall a b. a -> b -> b
`seq` Safety -> ()
forall a. NFData a => a -> ()
rnf Safety
s
instance Binary CCallConv where
put_ :: WriteBinHandle -> CCallConv -> IO ()
put_ WriteBinHandle
bh CCallConv
CCallConv =
WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
put_ WriteBinHandle
bh CCallConv
StdCallConv =
WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
put_ WriteBinHandle
bh CCallConv
PrimCallConv =
WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
put_ WriteBinHandle
bh CCallConv
CApiConv =
WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
put_ WriteBinHandle
bh CCallConv
JavaScriptCallConv =
WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4
get :: ReadBinHandle -> IO CCallConv
get ReadBinHandle
bh = do
h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
case h of
Word8
0 -> CCallConv -> IO CCallConv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CCallConv
CCallConv
Word8
1 -> CCallConv -> IO CCallConv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CCallConv
StdCallConv
Word8
2 -> CCallConv -> IO CCallConv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CCallConv
PrimCallConv
Word8
3 -> CCallConv -> IO CCallConv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CCallConv
CApiConv
Word8
_ -> CCallConv -> IO CCallConv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CCallConv
JavaScriptCallConv
data CCallStaticTargetUnit
= TargetIsInThisUnit
| TargetIsInThat Unit
deriving (Typeable CCallStaticTargetUnit
Typeable CCallStaticTargetUnit =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CCallStaticTargetUnit
-> c CCallStaticTargetUnit)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallStaticTargetUnit)
-> (CCallStaticTargetUnit -> Constr)
-> (CCallStaticTargetUnit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCallStaticTargetUnit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CCallStaticTargetUnit))
-> ((forall b. Data b => b -> b)
-> CCallStaticTargetUnit -> CCallStaticTargetUnit)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CCallStaticTargetUnit
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CCallStaticTargetUnit
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> CCallStaticTargetUnit -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> CCallStaticTargetUnit -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit)
-> Data CCallStaticTargetUnit
CCallStaticTargetUnit -> Constr
CCallStaticTargetUnit -> DataType
(forall b. Data b => b -> b)
-> CCallStaticTargetUnit -> CCallStaticTargetUnit
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CCallStaticTargetUnit -> u
forall u.
(forall d. Data d => d -> u) -> CCallStaticTargetUnit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallStaticTargetUnit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallStaticTargetUnit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallStaticTargetUnit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CCallStaticTargetUnit
-> c CCallStaticTargetUnit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCallStaticTargetUnit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CCallStaticTargetUnit)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CCallStaticTargetUnit
-> c CCallStaticTargetUnit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CCallStaticTargetUnit
-> c CCallStaticTargetUnit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallStaticTargetUnit
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallStaticTargetUnit
$ctoConstr :: CCallStaticTargetUnit -> Constr
toConstr :: CCallStaticTargetUnit -> Constr
$cdataTypeOf :: CCallStaticTargetUnit -> DataType
dataTypeOf :: CCallStaticTargetUnit -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCallStaticTargetUnit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCallStaticTargetUnit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CCallStaticTargetUnit)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CCallStaticTargetUnit)
$cgmapT :: (forall b. Data b => b -> b)
-> CCallStaticTargetUnit -> CCallStaticTargetUnit
gmapT :: (forall b. Data b => b -> b)
-> CCallStaticTargetUnit -> CCallStaticTargetUnit
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallStaticTargetUnit -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallStaticTargetUnit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallStaticTargetUnit -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallStaticTargetUnit -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CCallStaticTargetUnit -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CCallStaticTargetUnit -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CCallStaticTargetUnit -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CCallStaticTargetUnit -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CCallStaticTargetUnit -> m CCallStaticTargetUnit
Data, CCallStaticTargetUnit -> CCallStaticTargetUnit -> Bool
(CCallStaticTargetUnit -> CCallStaticTargetUnit -> Bool)
-> (CCallStaticTargetUnit -> CCallStaticTargetUnit -> Bool)
-> Eq CCallStaticTargetUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CCallStaticTargetUnit -> CCallStaticTargetUnit -> Bool
== :: CCallStaticTargetUnit -> CCallStaticTargetUnit -> Bool
$c/= :: CCallStaticTargetUnit -> CCallStaticTargetUnit -> Bool
/= :: CCallStaticTargetUnit -> CCallStaticTargetUnit -> Bool
Eq)
data StaticTargetGhc = StaticTargetGhc
{ StaticTargetGhc -> SourceText
staticTargetLabel :: SourceText
, StaticTargetGhc -> CCallStaticTargetUnit
staticTargetUnit :: CCallStaticTargetUnit
}
deriving (Typeable StaticTargetGhc
Typeable StaticTargetGhc =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StaticTargetGhc -> c StaticTargetGhc)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StaticTargetGhc)
-> (StaticTargetGhc -> Constr)
-> (StaticTargetGhc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StaticTargetGhc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StaticTargetGhc))
-> ((forall b. Data b => b -> b)
-> StaticTargetGhc -> StaticTargetGhc)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StaticTargetGhc -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StaticTargetGhc -> r)
-> (forall u.
(forall d. Data d => d -> u) -> StaticTargetGhc -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> StaticTargetGhc -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc)
-> Data StaticTargetGhc
StaticTargetGhc -> Constr
StaticTargetGhc -> DataType
(forall b. Data b => b -> b) -> StaticTargetGhc -> StaticTargetGhc
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> StaticTargetGhc -> u
forall u. (forall d. Data d => d -> u) -> StaticTargetGhc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StaticTargetGhc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StaticTargetGhc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StaticTargetGhc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StaticTargetGhc -> c StaticTargetGhc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StaticTargetGhc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StaticTargetGhc)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StaticTargetGhc -> c StaticTargetGhc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StaticTargetGhc -> c StaticTargetGhc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StaticTargetGhc
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StaticTargetGhc
$ctoConstr :: StaticTargetGhc -> Constr
toConstr :: StaticTargetGhc -> Constr
$cdataTypeOf :: StaticTargetGhc -> DataType
dataTypeOf :: StaticTargetGhc -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StaticTargetGhc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StaticTargetGhc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StaticTargetGhc)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StaticTargetGhc)
$cgmapT :: (forall b. Data b => b -> b) -> StaticTargetGhc -> StaticTargetGhc
gmapT :: (forall b. Data b => b -> b) -> StaticTargetGhc -> StaticTargetGhc
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StaticTargetGhc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StaticTargetGhc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StaticTargetGhc -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StaticTargetGhc -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StaticTargetGhc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> StaticTargetGhc -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StaticTargetGhc -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StaticTargetGhc -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StaticTargetGhc -> m StaticTargetGhc
Data, StaticTargetGhc -> StaticTargetGhc -> Bool
(StaticTargetGhc -> StaticTargetGhc -> Bool)
-> (StaticTargetGhc -> StaticTargetGhc -> Bool)
-> Eq StaticTargetGhc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticTargetGhc -> StaticTargetGhc -> Bool
== :: StaticTargetGhc -> StaticTargetGhc -> Bool
$c/= :: StaticTargetGhc -> StaticTargetGhc -> Bool
/= :: StaticTargetGhc -> StaticTargetGhc -> Bool
Eq)
data CTypeGhc = CTypeGhc
{ CTypeGhc -> SourceText
cTypeSourceText :: SourceText
, CTypeGhc -> SourceText
cTypeOtherText :: SourceText
}
deriving (Typeable CTypeGhc
Typeable CTypeGhc =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CTypeGhc -> c CTypeGhc)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CTypeGhc)
-> (CTypeGhc -> Constr)
-> (CTypeGhc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CTypeGhc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CTypeGhc))
-> ((forall b. Data b => b -> b) -> CTypeGhc -> CTypeGhc)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CTypeGhc -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CTypeGhc -> r)
-> (forall u. (forall d. Data d => d -> u) -> CTypeGhc -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CTypeGhc -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc)
-> Data CTypeGhc
CTypeGhc -> Constr
CTypeGhc -> DataType
(forall b. Data b => b -> b) -> CTypeGhc -> CTypeGhc
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CTypeGhc -> u
forall u. (forall d. Data d => d -> u) -> CTypeGhc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CTypeGhc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CTypeGhc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CTypeGhc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CTypeGhc -> c CTypeGhc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CTypeGhc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CTypeGhc)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CTypeGhc -> c CTypeGhc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CTypeGhc -> c CTypeGhc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CTypeGhc
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CTypeGhc
$ctoConstr :: CTypeGhc -> Constr
toConstr :: CTypeGhc -> Constr
$cdataTypeOf :: CTypeGhc -> DataType
dataTypeOf :: CTypeGhc -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CTypeGhc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CTypeGhc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CTypeGhc)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CTypeGhc)
$cgmapT :: (forall b. Data b => b -> b) -> CTypeGhc -> CTypeGhc
gmapT :: (forall b. Data b => b -> b) -> CTypeGhc -> CTypeGhc
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CTypeGhc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CTypeGhc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CTypeGhc -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CTypeGhc -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CTypeGhc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CTypeGhc -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CTypeGhc -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CTypeGhc -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTypeGhc -> m CTypeGhc
Data, CTypeGhc -> CTypeGhc -> Bool
(CTypeGhc -> CTypeGhc -> Bool)
-> (CTypeGhc -> CTypeGhc -> Bool) -> Eq CTypeGhc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CTypeGhc -> CTypeGhc -> Bool
== :: CTypeGhc -> CTypeGhc -> Bool
$c/= :: CTypeGhc -> CTypeGhc -> Bool
/= :: CTypeGhc -> CTypeGhc -> Bool
Eq)
type instance XStaticTarget GhcPs = SourceText
type instance XStaticTarget GhcRn = StaticTargetGhc
type instance XStaticTarget GhcTc = StaticTargetGhc
type instance XDynamicTarget (GhcPass p) = NoExtField
type instance XXCCallTarget (GhcPass p) = DataConCantHappen
type instance XCType (GhcPass p) = CTypeGhc
type instance XXCType (GhcPass p) = DataConCantHappen
type instance (GhcPass p) = SourceText
type instance (GhcPass p) = DataConCantHappen
deriving instance Eq (Header (GhcPass p))
instance NFData (CType (GhcPass p)) where
rnf :: CType (GhcPass p) -> ()
rnf (CType XCType (GhcPass p)
ext Maybe (Header (GhcPass p))
mh CLabelString
fs) =
CTypeGhc -> ()
forall a. NFData a => a -> ()
rnf XCType (GhcPass p)
CTypeGhc
ext () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe (Header (GhcPass p)) -> ()
forall a. NFData a => a -> ()
rnf Maybe (Header (GhcPass p))
mh () -> () -> ()
forall a b. a -> b -> b
`seq` CLabelString -> ()
forall a. NFData a => a -> ()
rnf CLabelString
fs
instance NFData (Header (GhcPass p)) where
rnf :: Header (GhcPass p) -> ()
rnf (Header XHeader (GhcPass p)
s CLabelString
h) =
SourceText -> ()
forall a. NFData a => a -> ()
rnf XHeader (GhcPass p)
SourceText
s () -> () -> ()
forall a b. a -> b -> b
`seq` CLabelString -> ()
forall a. NFData a => a -> ()
rnf CLabelString
h
instance NFData CCallStaticTargetUnit where
rnf :: CCallStaticTargetUnit -> ()
rnf = \case
CCallStaticTargetUnit
TargetIsInThisUnit -> ()
TargetIsInThat Unit
unit -> Unit -> ()
forall a. NFData a => a -> ()
rnf Unit
unit
instance Binary CCallStaticTargetUnit where
put_ :: WriteBinHandle -> CCallStaticTargetUnit -> IO ()
put_ WriteBinHandle
bh = \case
CCallStaticTargetUnit
TargetIsInThisUnit -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
TargetIsInThat Unit
unit -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriteBinHandle -> Unit -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Unit
unit
get :: ReadBinHandle -> IO CCallStaticTargetUnit
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh IO Word8
-> (Word8 -> IO CCallStaticTargetUnit) -> IO CCallStaticTargetUnit
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
0 -> CCallStaticTargetUnit -> IO CCallStaticTargetUnit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CCallStaticTargetUnit
TargetIsInThisUnit
Word8
_ -> Unit -> CCallStaticTargetUnit
Unit -> CCallStaticTargetUnit
TargetIsInThat (Unit -> CCallStaticTargetUnit)
-> IO Unit -> IO CCallStaticTargetUnit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Unit
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance NFData CTypeGhc where
rnf :: CTypeGhc -> ()
rnf CTypeGhc
st =
SourceText -> ()
forall a. NFData a => a -> ()
rnf (CTypeGhc -> SourceText
cTypeSourceText CTypeGhc
st) () -> () -> ()
forall a b. a -> b -> b
`seq`
SourceText -> ()
forall a. NFData a => a -> ()
rnf (CTypeGhc -> SourceText
cTypeOtherText CTypeGhc
st)
instance Binary CTypeGhc where
put_ :: WriteBinHandle -> CTypeGhc -> IO ()
put_ WriteBinHandle
bh CTypeGhc
ct = do
WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (CTypeGhc -> SourceText
cTypeSourceText CTypeGhc
ct)
WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (CTypeGhc -> SourceText
cTypeOtherText CTypeGhc
ct)
get :: ReadBinHandle -> IO CTypeGhc
get ReadBinHandle
bh = do
str1 <- ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
str2 <- get bh
return $ CTypeGhc
{ cTypeSourceText = str1
, cTypeOtherText = str2
}
instance NFData StaticTargetGhc where
rnf :: StaticTargetGhc -> ()
rnf StaticTargetGhc
st =
SourceText -> ()
forall a. NFData a => a -> ()
rnf (StaticTargetGhc -> SourceText
staticTargetLabel StaticTargetGhc
st) () -> () -> ()
forall a b. a -> b -> b
`seq`
CCallStaticTargetUnit -> ()
forall a. NFData a => a -> ()
rnf (StaticTargetGhc -> CCallStaticTargetUnit
staticTargetUnit StaticTargetGhc
st)
instance Binary StaticTargetGhc where
put_ :: WriteBinHandle -> StaticTargetGhc -> IO ()
put_ WriteBinHandle
bh StaticTargetGhc
st = do
WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (StaticTargetGhc -> SourceText
staticTargetLabel StaticTargetGhc
st)
WriteBinHandle -> CCallStaticTargetUnit -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (StaticTargetGhc -> CCallStaticTargetUnit
staticTargetUnit StaticTargetGhc
st)
get :: ReadBinHandle -> IO StaticTargetGhc
get ReadBinHandle
bh = do
label <- ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
unit <- get bh
return $ StaticTargetGhc
{ staticTargetLabel = label
, staticTargetUnit = unit
}
instance forall p. IsPass p => Eq (CCallTarget (GhcPass p)) where
== :: CCallTarget (GhcPass p) -> CCallTarget (GhcPass p) -> Bool
(==) = \case
DynamicTarget{} -> \case
DynamicTarget{} -> Bool
True
CCallTarget (GhcPass p)
_ -> Bool
False
StaticTarget XStaticTarget (GhcPass p)
x1 CLabelString
a1 ForeignKind
b1 -> \case
StaticTarget XStaticTarget (GhcPass p)
x2 CLabelString
a2 ForeignKind
b2 -> CLabelString
a1 CLabelString -> CLabelString -> Bool
forall a. Eq a => a -> a -> Bool
== CLabelString
a2 Bool -> Bool -> Bool
&& ForeignKind
b1 ForeignKind -> ForeignKind -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignKind
b2 Bool -> Bool -> Bool
&& case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
GhcPass p
GhcPs -> XStaticTarget (GhcPass p)
SourceText
x1 SourceText -> SourceText -> Bool
forall a. Eq a => a -> a -> Bool
== XStaticTarget (GhcPass p)
SourceText
x2
GhcPass p
GhcRn -> XStaticTarget (GhcPass p)
StaticTargetGhc
x1 StaticTargetGhc -> StaticTargetGhc -> Bool
forall a. Eq a => a -> a -> Bool
== XStaticTarget (GhcPass p)
StaticTargetGhc
x2
GhcPass p
GhcTc -> XStaticTarget (GhcPass p)
StaticTargetGhc
x1 StaticTargetGhc -> StaticTargetGhc -> Bool
forall a. Eq a => a -> a -> Bool
== XStaticTarget (GhcPass p)
StaticTargetGhc
x2
CCallTarget (GhcPass p)
_ -> Bool
False
instance forall p. IsPass p => NFData (CCallTarget (GhcPass p)) where
rnf :: CCallTarget (GhcPass p) -> ()
rnf = \case
DynamicTarget XDynamicTarget (GhcPass p)
NoExtField
NoExtField -> ()
StaticTarget XStaticTarget (GhcPass p)
x CLabelString
a ForeignKind
b -> CLabelString -> ()
forall a. NFData a => a -> ()
rnf CLabelString
a () -> () -> ()
forall a b. a -> b -> b
`seq` ForeignKind -> ()
forall a. NFData a => a -> ()
rnf ForeignKind
b () -> () -> ()
forall a b. a -> b -> b
`seq` case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
GhcPass p
GhcPs -> SourceText -> ()
forall a. NFData a => a -> ()
rnf XStaticTarget (GhcPass p)
SourceText
x
GhcPass p
GhcRn -> StaticTargetGhc -> ()
forall a. NFData a => a -> ()
rnf XStaticTarget (GhcPass p)
StaticTargetGhc
x
GhcPass p
GhcTc -> StaticTargetGhc -> ()
forall a. NFData a => a -> ()
rnf XStaticTarget (GhcPass p)
StaticTargetGhc
x
instance forall p. IsPass p => Binary (CCallTarget (GhcPass p)) where
put_ :: WriteBinHandle -> CCallTarget (GhcPass p) -> IO ()
put_ WriteBinHandle
bh = \case
StaticTarget XStaticTarget (GhcPass p)
x CLabelString
a ForeignKind
b -> do
WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
WriteBinHandle -> CLabelString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CLabelString
a
WriteBinHandle -> ForeignKind -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ForeignKind
b
case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
GhcPass p
GhcPs -> WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh XStaticTarget (GhcPass p)
SourceText
x
GhcPass p
GhcRn -> WriteBinHandle -> StaticTargetGhc -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh XStaticTarget (GhcPass p)
StaticTargetGhc
x
GhcPass p
GhcTc -> WriteBinHandle -> StaticTargetGhc -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh XStaticTarget (GhcPass p)
StaticTargetGhc
x
DynamicTarget XDynamicTarget (GhcPass p)
NoExtField
NoExtField -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
get :: ReadBinHandle -> IO (CCallTarget (GhcPass p))
get ReadBinHandle
bh = do
h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
case h of
Word8
0 -> do
(a :: CLabelString) <- ReadBinHandle -> IO CLabelString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
(b :: ForeignKind ) <- get bh
case ghcPass @p of
GhcPass p
GhcPs -> (\SourceText
x -> XStaticTarget (GhcPass p)
-> CLabelString -> ForeignKind -> CCallTarget (GhcPass p)
forall pass.
XStaticTarget pass
-> CLabelString -> ForeignKind -> CCallTarget pass
StaticTarget XStaticTarget (GhcPass p)
SourceText
x CLabelString
a ForeignKind
b) (SourceText -> CCallTarget (GhcPass p))
-> IO SourceText -> IO (CCallTarget (GhcPass p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
GhcPass p
GhcRn -> (\StaticTargetGhc
x -> XStaticTarget (GhcPass p)
-> CLabelString -> ForeignKind -> CCallTarget (GhcPass p)
forall pass.
XStaticTarget pass
-> CLabelString -> ForeignKind -> CCallTarget pass
StaticTarget XStaticTarget (GhcPass p)
StaticTargetGhc
x CLabelString
a ForeignKind
b) (StaticTargetGhc -> CCallTarget (GhcPass p))
-> IO StaticTargetGhc -> IO (CCallTarget (GhcPass p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO StaticTargetGhc
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
GhcPass p
GhcTc -> (\StaticTargetGhc
x -> XStaticTarget (GhcPass p)
-> CLabelString -> ForeignKind -> CCallTarget (GhcPass p)
forall pass.
XStaticTarget pass
-> CLabelString -> ForeignKind -> CCallTarget pass
StaticTarget XStaticTarget (GhcPass p)
StaticTargetGhc
x CLabelString
a ForeignKind
b) (StaticTargetGhc -> CCallTarget (GhcPass p))
-> IO StaticTargetGhc -> IO (CCallTarget (GhcPass p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO StaticTargetGhc
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
_ -> CCallTarget (GhcPass p) -> IO (CCallTarget (GhcPass p))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CCallTarget (GhcPass p) -> IO (CCallTarget (GhcPass p)))
-> CCallTarget (GhcPass p) -> IO (CCallTarget (GhcPass p))
forall a b. (a -> b) -> a -> b
$ XDynamicTarget (GhcPass p) -> CCallTarget (GhcPass p)
forall pass. XDynamicTarget pass -> CCallTarget pass
DynamicTarget XDynamicTarget (GhcPass p)
NoExtField
NoExtField
instance Binary CExportSpec where
put_ :: WriteBinHandle -> CExportSpec -> IO ()
put_ WriteBinHandle
bh (CExportStatic CLabelString
aa CCallConv
ab) = do
WriteBinHandle -> CLabelString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CLabelString
aa
WriteBinHandle -> CCallConv -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CCallConv
ab
get :: ReadBinHandle -> IO CExportSpec
get ReadBinHandle
bh = do
aa <- ReadBinHandle -> IO CLabelString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
ab <- get bh
return (CExportStatic aa ab)
instance Binary (CType (GhcPass p)) where
put_ :: WriteBinHandle -> CType (GhcPass p) -> IO ()
put_ WriteBinHandle
bh (CType XCType (GhcPass p)
ext Maybe (Header (GhcPass p))
mh CLabelString
fs) = do
WriteBinHandle -> CTypeGhc -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh XCType (GhcPass p)
CTypeGhc
ext
WriteBinHandle -> Maybe (Header (GhcPass p)) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe (Header (GhcPass p))
mh
WriteBinHandle -> CLabelString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CLabelString
fs
get :: ReadBinHandle -> IO (CType (GhcPass p))
get ReadBinHandle
bh = do
ext <- ReadBinHandle -> IO CTypeGhc
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
mh <- get bh
fs <- get bh
return (CType ext mh fs)
instance Binary ForeignKind where
put_ :: WriteBinHandle -> ForeignKind -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh (Word8 -> IO ()) -> (ForeignKind -> Word8) -> ForeignKind -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
ForeignKind
ForeignValue -> Word8
0
ForeignKind
ForeignFunction -> Word8
1
get :: ReadBinHandle -> IO ForeignKind
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh IO Word8 -> (Word8 -> ForeignKind) -> IO ForeignKind
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Word8
0 -> ForeignKind
ForeignValue
Word8
_ -> ForeignKind
ForeignFunction
instance Binary (Header (GhcPass p)) where
put_ :: WriteBinHandle -> Header (GhcPass p) -> IO ()
put_ WriteBinHandle
bh (Header XHeader (GhcPass p)
s CLabelString
h) = WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh XHeader (GhcPass p)
SourceText
s 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 -> CLabelString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CLabelString
h
get :: ReadBinHandle -> IO (Header (GhcPass p))
get ReadBinHandle
bh = do
s <- ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
h <- get bh
return (Header s h)
instance Binary Safety where
put_ :: WriteBinHandle -> Safety -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh (Word8 -> IO ()) -> (Safety -> Word8) -> Safety -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Safety
PlaySafe -> Word8
0
Safety
PlayInterruptible -> Word8
1
Safety
PlayRisky -> Word8
2
get :: ReadBinHandle -> IO Safety
get ReadBinHandle
bh = do
h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
case h of
Word8
0 -> Safety -> IO Safety
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Safety
PlaySafe
Word8
1 -> Safety -> IO Safety
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Safety
PlayInterruptible
Word8
_ -> Safety -> IO Safety
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Safety
PlayRisky
instance Outputable CCallConv where
ppr :: CCallConv -> SDoc
ppr CCallConv
StdCallConv = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"stdcall"
ppr CCallConv
CCallConv = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ccall"
ppr CCallConv
CApiConv = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"capi"
ppr CCallConv
PrimCallConv = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"prim"
ppr CCallConv
JavaScriptCallConv = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"javascript"
instance Outputable CExportSpec where
ppr :: CExportSpec -> SDoc
ppr (CExportStatic CLabelString
str CCallConv
_) = CLabelString -> SDoc
pprCLabelString CLabelString
str
instance Outputable (CType (GhcPass p)) where
ppr :: CType (GhcPass p) -> SDoc
ppr (CType XCType (GhcPass p)
ext Maybe (Header (GhcPass p))
mh CLabelString
ct) =
SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
stp (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{-# CTYPE") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
hDoc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
stct (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (CLabelString -> SDoc
forall doc. IsLine doc => CLabelString -> doc
ftext CLabelString
ct)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#-}"
where
stp :: SourceText
stp = CTypeGhc -> SourceText
cTypeSourceText XCType (GhcPass p)
CTypeGhc
ext
stct :: SourceText
stct = CTypeGhc -> SourceText
cTypeOtherText XCType (GhcPass p)
CTypeGhc
ext
hDoc :: SDoc
hDoc = case Maybe (Header (GhcPass p))
mh of
Maybe (Header (GhcPass p))
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
Just Header (GhcPass p)
h -> Header (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Header (GhcPass p)
h
instance Outputable (Header (GhcPass p)) where
ppr :: Header (GhcPass p) -> SDoc
ppr (Header XHeader (GhcPass p)
st CLabelString
h) = SourceText -> SDoc -> SDoc
pprWithSourceText XHeader (GhcPass p)
SourceText
st (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ CLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabelString
h)
instance Outputable Safety where
ppr :: Safety -> SDoc
ppr Safety
PlaySafe = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"safe"
ppr Safety
PlayInterruptible = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"interruptible"
ppr Safety
PlayRisky = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unsafe"