{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

\section[Foreign]{Foreign calls}
-}

{-# LANGUAGE DeriveDataTypeable #-}

module GHC.Types.ForeignCall (
        ForeignCall(..), isSafeForeignCall,
        Safety(..), playSafe, playInterruptible,

        CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
        CCallSpec(..),
        CCallTarget(..), isDynamicTarget,
        CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,

        Header(..), CType(..),
    ) where

import GHC.Prelude

import GHC.Data.FastString
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Unit.Module
import GHC.Types.Basic ( SourceText, pprWithSourceText )

import Data.Char
import Data.Data

{-
************************************************************************
*                                                                      *
\subsubsection{Data types}
*                                                                      *
************************************************************************
-}

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
/= :: ForeignCall -> ForeignCall -> Bool
$c/= :: ForeignCall -> ForeignCall -> Bool
== :: ForeignCall -> ForeignCall -> Bool
$c== :: ForeignCall -> ForeignCall -> Bool
Instance of class: Eq of the constraint type Eq CCallSpec
Eq

isSafeForeignCall :: ForeignCall -> Bool
isSafeForeignCall :: ForeignCall -> Bool
isSafeForeignCall (CCall (CCallSpec CCallTarget
_ CCallConv
_ Safety
safe)) = Safety -> Bool
playSafe Safety
safe

-- We may need more clues to distinguish foreign calls
-- but this simple printer will do for now
instance Outputable ForeignCall where
  ppr :: ForeignCall -> SDoc
ppr (CCall CCallSpec
cc)  = CCallSpec -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type Outputable CCallSpec
ppr CCallSpec
cc

data Safety
  = PlaySafe          -- ^ Might invoke Haskell GC, or do a call back, or
                      --   switch threads, etc.  So make sure things are
                      --   tidy before the call. Additionally, in the threaded
                      --   RTS we arrange for the external call to be executed
                      --   by a separate OS thread, i.e., _concurrently_ to the
                      --   execution of other Haskell threads.

  | PlayInterruptible -- ^ Like PlaySafe, but additionally
                      --   the worker thread running this foreign call may
                      --   be unceremoniously killed, so it must be scheduled
                      --   on an unbound thread.

  | PlayRisky         -- ^ None of the above can happen; the call will return
                      --   without interacting with the runtime system at all.
                      --   Specifically:
                      --
                      --     * No GC
                      --     * No call backs
                      --     * No blocking
                      --     * No precise exceptions
                      --
  deriving ( Safety -> Safety -> Bool
(Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool) -> Eq Safety
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Safety -> Safety -> Bool
$c/= :: Safety -> Safety -> Bool
== :: Safety -> Safety -> Bool
$c== :: Safety -> Safety -> Bool
Eq, Int -> Safety -> ShowS
[Safety] -> ShowS
Safety -> String
(Int -> Safety -> ShowS)
-> (Safety -> String) -> ([Safety] -> ShowS) -> Show Safety
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Safety] -> ShowS
$cshowList :: [Safety] -> ShowS
show :: Safety -> String
$cshow :: Safety -> String
showsPrec :: Int -> Safety -> ShowS
$cshowsPrec :: Int -> Safety -> ShowS
Show, Typeable Safety
DataType
Constr
Typeable Safety
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Safety -> c Safety)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Safety)
-> (Safety -> Constr)
-> (Safety -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Safety))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Safety))
-> ((forall b. Data b => b -> b) -> Safety -> Safety)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Safety -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Safety -> r)
-> (forall u. (forall d. Data d => d -> u) -> Safety -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Safety -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Safety -> m Safety)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Safety -> m Safety)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Safety -> m Safety)
-> Data Safety
Safety -> DataType
Safety -> Constr
(forall b. Data b => b -> b) -> Safety -> Safety
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Safety -> c Safety
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Safety
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) -> Safety -> u
forall u. (forall d. Data d => d -> u) -> Safety -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Safety -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Safety -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Safety -> m Safety
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Safety -> m Safety
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Safety
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Safety -> c Safety
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Safety)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Safety)
$cPlayRisky :: Constr
$cPlayInterruptible :: Constr
$cPlaySafe :: Constr
$tSafety :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Safety -> m Safety
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Safety -> m Safety
gmapMp :: (forall d. Data d => d -> m d) -> Safety -> m Safety
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Safety -> m Safety
gmapM :: (forall d. Data d => d -> m d) -> Safety -> m Safety
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Safety -> m Safety
gmapQi :: Int -> (forall d. Data d => d -> u) -> Safety -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Safety -> u
gmapQ :: (forall d. Data d => d -> u) -> Safety -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Safety -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Safety -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Safety -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Safety -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Safety -> r
gmapT :: (forall b. Data b => b -> b) -> Safety -> Safety
$cgmapT :: (forall b. Data b => b -> b) -> Safety -> Safety
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Safety)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Safety)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Safety)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Safety)
dataTypeOf :: Safety -> DataType
$cdataTypeOf :: Safety -> DataType
toConstr :: Safety -> Constr
$ctoConstr :: Safety -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Safety
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Safety
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Safety -> c Safety
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Safety -> c Safety
Data )
        -- Show used just for Show Lex.Token, I think

instance Outputable Safety where
  ppr :: Safety -> SDoc
ppr Safety
PlaySafe = String -> SDoc
text String
"safe"
  ppr Safety
PlayInterruptible = String -> SDoc
text String
"interruptible"
  ppr Safety
PlayRisky = String -> SDoc
text String
"unsafe"

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

{-
************************************************************************
*                                                                      *
\subsubsection{Calling C}
*                                                                      *
************************************************************************
-}

data CExportSpec
  = CExportStatic               -- foreign export ccall foo :: ty
        SourceText              -- of the CLabelString.
                                -- See note [Pragma source text] in GHC.Types.Basic
        CLabelString            -- C Name of exported function
        CCallConv
  deriving Typeable CExportSpec
DataType
Constr
Typeable CExportSpec
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CExportSpec -> c CExportSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CExportSpec)
-> (CExportSpec -> Constr)
-> (CExportSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CExportSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CExportSpec))
-> ((forall b. Data b => b -> b) -> CExportSpec -> CExportSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CExportSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CExportSpec -> r)
-> (forall u. (forall d. Data d => d -> u) -> CExportSpec -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CExportSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec)
-> Data CExportSpec
CExportSpec -> DataType
CExportSpec -> Constr
(forall b. Data b => b -> b) -> CExportSpec -> CExportSpec
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CExportSpec -> c CExportSpec
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CExportSpec
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) -> CExportSpec -> u
forall u. (forall d. Data d => d -> u) -> CExportSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CExportSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CExportSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CExportSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CExportSpec -> c CExportSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CExportSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CExportSpec)
$cCExportStatic :: Constr
$tCExportSpec :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec
gmapMp :: (forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec
gmapM :: (forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CExportSpec -> m CExportSpec
gmapQi :: Int -> (forall d. Data d => d -> u) -> CExportSpec -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CExportSpec -> u
gmapQ :: (forall d. Data d => d -> u) -> CExportSpec -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CExportSpec -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CExportSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CExportSpec -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CExportSpec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CExportSpec -> r
gmapT :: (forall b. Data b => b -> b) -> CExportSpec -> CExportSpec
$cgmapT :: (forall b. Data b => b -> b) -> CExportSpec -> CExportSpec
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CExportSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CExportSpec)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CExportSpec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CExportSpec)
dataTypeOf :: CExportSpec -> DataType
$cdataTypeOf :: CExportSpec -> DataType
toConstr :: CExportSpec -> Constr
$ctoConstr :: CExportSpec -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CExportSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CExportSpec
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CExportSpec -> c CExportSpec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CExportSpec -> c CExportSpec
External instance of the constraint type Data SourceText
External instance of the constraint type Data CLabelString
Instance of class: Data of the constraint type Data CCallConv
Data

data CCallSpec
  =  CCallSpec  CCallTarget     -- What to call
                CCallConv       -- Calling convention to use.
                Safety
  deriving( CCallSpec -> CCallSpec -> Bool
(CCallSpec -> CCallSpec -> Bool)
-> (CCallSpec -> CCallSpec -> Bool) -> Eq CCallSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CCallSpec -> CCallSpec -> Bool
$c/= :: CCallSpec -> CCallSpec -> Bool
== :: CCallSpec -> CCallSpec -> Bool
$c== :: CCallSpec -> CCallSpec -> Bool
Instance of class: Eq of the constraint type Eq Safety
Instance of class: Eq of the constraint type Eq CCallConv
Instance of class: Eq of the constraint type Eq CCallTarget
Eq )

-- The call target:

-- | How to call a particular function in C-land.
data CCallTarget
  -- An "unboxed" ccall# to named function in a particular package.
  = StaticTarget
        SourceText                -- of the CLabelString.
                                  -- See note [Pragma source text] in GHC.Types.Basic
        CLabelString                    -- C-land name of label.

        (Maybe Unit)                    -- What package the function is in.
                                        -- If Nothing, then it's taken to be in the current package.
                                        -- Note: This information is only used for PrimCalls on Windows.
                                        --       See CLabel.labelDynamic and CoreToStg.coreToStgApp
                                        --       for the difference in representation between PrimCalls
                                        --       and ForeignCalls. If the CCallTarget is representing
                                        --       a regular ForeignCall then it's safe to set this to Nothing.

  -- The first argument of the import is the name of a function pointer (an Addr#).
  --    Used when importing a label as "foreign import ccall "dynamic" ..."
        Bool                            -- True => really a function
                                        -- False => a value; only
                                        -- allowed in CAPI imports
  | DynamicTarget

  deriving( CCallTarget -> CCallTarget -> Bool
(CCallTarget -> CCallTarget -> Bool)
-> (CCallTarget -> CCallTarget -> Bool) -> Eq CCallTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CCallTarget -> CCallTarget -> Bool
$c/= :: CCallTarget -> CCallTarget -> Bool
== :: CCallTarget -> CCallTarget -> Bool
$c== :: CCallTarget -> CCallTarget -> Bool
External instance of the constraint type Eq Unit
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Unit
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type Eq CLabelString
External instance of the constraint type Eq SourceText
Eq, Typeable CCallTarget
DataType
Constr
Typeable CCallTarget
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CCallTarget -> c CCallTarget)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CCallTarget)
-> (CCallTarget -> Constr)
-> (CCallTarget -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CCallTarget))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CCallTarget))
-> ((forall b. Data b => b -> b) -> CCallTarget -> CCallTarget)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CCallTarget -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CCallTarget -> r)
-> (forall u. (forall d. Data d => d -> u) -> CCallTarget -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CCallTarget -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget)
-> Data CCallTarget
CCallTarget -> DataType
CCallTarget -> Constr
(forall b. Data b => b -> b) -> CCallTarget -> CCallTarget
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCallTarget -> c CCallTarget
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallTarget
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) -> CCallTarget -> u
forall u. (forall d. Data d => d -> u) -> CCallTarget -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallTarget -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallTarget -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallTarget
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCallTarget -> c CCallTarget
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCallTarget)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CCallTarget)
$cDynamicTarget :: Constr
$cStaticTarget :: Constr
$tCCallTarget :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget
gmapMp :: (forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget
gmapM :: (forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCallTarget -> m CCallTarget
gmapQi :: Int -> (forall d. Data d => d -> u) -> CCallTarget -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CCallTarget -> u
gmapQ :: (forall d. Data d => d -> u) -> CCallTarget -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CCallTarget -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallTarget -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallTarget -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallTarget -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallTarget -> r
gmapT :: (forall b. Data b => b -> b) -> CCallTarget -> CCallTarget
$cgmapT :: (forall b. Data b => b -> b) -> CCallTarget -> CCallTarget
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CCallTarget)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CCallTarget)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CCallTarget)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCallTarget)
dataTypeOf :: CCallTarget -> DataType
$cdataTypeOf :: CCallTarget -> DataType
toConstr :: CCallTarget -> Constr
$ctoConstr :: CCallTarget -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallTarget
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallTarget
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCallTarget -> c CCallTarget
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCallTarget -> c CCallTarget
External instance of the constraint type Data Unit
External instance of the constraint type Data Unit
External instance of the constraint type Data Unit
External instance of the constraint type forall a. Data a => Data (Maybe a)
External instance of the constraint type Data Bool
External instance of the constraint type Data SourceText
External instance of the constraint type Data CLabelString
Data )

isDynamicTarget :: CCallTarget -> Bool
isDynamicTarget :: CCallTarget -> Bool
isDynamicTarget CCallTarget
DynamicTarget = Bool
True
isDynamicTarget CCallTarget
_             = Bool
False

{-
Stuff to do with calling convention:

ccall:          Caller allocates parameters, *and* deallocates them.

stdcall:        Caller allocates parameters, callee deallocates.
                Function name has @N after it, where N is number of arg bytes
                e.g.  _Foo@8. This convention is x86 (win32) specific.

See: http://www.programmersheaven.com/2/Calling-conventions
-}

-- any changes here should be replicated in  the CallConv type in template haskell
data CCallConv = CCallConv | CApiConv | StdCallConv | PrimCallConv | JavaScriptCallConv
  deriving (CCallConv -> CCallConv -> Bool
(CCallConv -> CCallConv -> Bool)
-> (CCallConv -> CCallConv -> Bool) -> Eq CCallConv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CCallConv -> CCallConv -> Bool
$c/= :: CCallConv -> CCallConv -> Bool
== :: CCallConv -> CCallConv -> Bool
$c== :: CCallConv -> CCallConv -> Bool
Eq, Typeable CCallConv
DataType
Constr
Typeable CCallConv
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CCallConv -> c CCallConv)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CCallConv)
-> (CCallConv -> Constr)
-> (CCallConv -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CCallConv))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCallConv))
-> ((forall b. Data b => b -> b) -> CCallConv -> CCallConv)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CCallConv -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CCallConv -> r)
-> (forall u. (forall d. Data d => d -> u) -> CCallConv -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CCallConv -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CCallConv -> m CCallConv)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CCallConv -> m CCallConv)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CCallConv -> m CCallConv)
-> Data CCallConv
CCallConv -> DataType
CCallConv -> Constr
(forall b. Data b => b -> b) -> CCallConv -> CCallConv
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCallConv -> c CCallConv
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallConv
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) -> CCallConv -> u
forall u. (forall d. Data d => d -> u) -> CCallConv -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallConv -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallConv -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCallConv -> m CCallConv
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCallConv -> m CCallConv
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallConv
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCallConv -> c CCallConv
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCallConv)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCallConv)
$cJavaScriptCallConv :: Constr
$cPrimCallConv :: Constr
$cStdCallConv :: Constr
$cCApiConv :: Constr
$cCCallConv :: Constr
$tCCallConv :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CCallConv -> m CCallConv
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCallConv -> m CCallConv
gmapMp :: (forall d. Data d => d -> m d) -> CCallConv -> m CCallConv
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCallConv -> m CCallConv
gmapM :: (forall d. Data d => d -> m d) -> CCallConv -> m CCallConv
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCallConv -> m CCallConv
gmapQi :: Int -> (forall d. Data d => d -> u) -> CCallConv -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CCallConv -> u
gmapQ :: (forall d. Data d => d -> u) -> CCallConv -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CCallConv -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallConv -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCallConv -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallConv -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCallConv -> r
gmapT :: (forall b. Data b => b -> b) -> CCallConv -> CCallConv
$cgmapT :: (forall b. Data b => b -> b) -> CCallConv -> CCallConv
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCallConv)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCallConv)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CCallConv)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCallConv)
dataTypeOf :: CCallConv -> DataType
$cdataTypeOf :: CCallConv -> DataType
toConstr :: CCallConv -> Constr
$ctoConstr :: CCallConv -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallConv
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCallConv
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCallConv -> c CCallConv
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCallConv -> c CCallConv
Data)

instance Outputable CCallConv where
  ppr :: CCallConv -> SDoc
ppr CCallConv
StdCallConv = String -> SDoc
text String
"stdcall"
  ppr CCallConv
CCallConv   = String -> SDoc
text String
"ccall"
  ppr CCallConv
CApiConv    = String -> SDoc
text String
"capi"
  ppr CCallConv
PrimCallConv = String -> SDoc
text String
"prim"
  ppr CCallConv
JavaScriptCallConv = String -> SDoc
text String
"javascript"

defaultCCallConv :: CCallConv
defaultCCallConv :: CCallConv
defaultCCallConv = CCallConv
CCallConv

ccallConvToInt :: CCallConv -> Int
ccallConvToInt :: CCallConv -> Int
ccallConvToInt CCallConv
StdCallConv = Int
0
ccallConvToInt CCallConv
CCallConv   = Int
1
ccallConvToInt CCallConv
CApiConv    = String -> Int
forall a. String -> a
panic String
"ccallConvToInt CApiConv"
ccallConvToInt (PrimCallConv {}) = String -> Int
forall a. String -> a
panic String
"ccallConvToInt PrimCallConv"
ccallConvToInt CCallConv
JavaScriptCallConv = String -> Int
forall a. String -> a
panic String
"ccallConvToInt JavaScriptCallConv"

{-
Generate the gcc attribute corresponding to the given
calling convention (used by PprAbsC):
-}

ccallConvAttribute :: CCallConv -> SDoc
ccallConvAttribute :: CCallConv -> SDoc
ccallConvAttribute CCallConv
StdCallConv       = String -> SDoc
text String
"__attribute__((__stdcall__))"
ccallConvAttribute CCallConv
CCallConv         = SDoc
empty
ccallConvAttribute CCallConv
CApiConv          = SDoc
empty
ccallConvAttribute (PrimCallConv {}) = String -> SDoc
forall a. String -> a
panic String
"ccallConvAttribute PrimCallConv"
ccallConvAttribute CCallConv
JavaScriptCallConv = String -> SDoc
forall a. String -> a
panic String
"ccallConvAttribute JavaScriptCallConv"

type CLabelString = FastString          -- A C label, completely unencoded

pprCLabelString :: CLabelString -> SDoc
pprCLabelString :: CLabelString -> SDoc
pprCLabelString CLabelString
lbl = CLabelString -> SDoc
ftext CLabelString
lbl

isCLabelString :: CLabelString -> Bool  -- Checks to see if this is a valid C label
isCLabelString :: CLabelString -> Bool
isCLabelString CLabelString
lbl
  = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
External instance of the constraint type Foldable []
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
External instance of the constraint type Eq Char
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'.'
        -- The '.' appears in e.g. "foo.so" in the
        -- module part of a ExtName.  Maybe it should be separate

-- Printing into C files:

instance Outputable CExportSpec where
  ppr :: CExportSpec -> SDoc
ppr (CExportStatic SourceText
_ CLabelString
str CCallConv
_) = CLabelString -> SDoc
pprCLabelString CLabelString
str

instance Outputable CCallSpec where
  ppr :: CCallSpec -> SDoc
ppr (CCallSpec CCallTarget
fun CCallConv
cconv Safety
safety)
    = [SDoc] -> SDoc
hcat [ SDoc -> SDoc
whenPprDebug SDoc
callconv, CCallTarget -> SDoc
ppr_fun CCallTarget
fun ]
    where
      callconv :: SDoc
callconv = String -> SDoc
text String
"{-" SDoc -> SDoc -> SDoc
<> CCallConv -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type Outputable CCallConv
ppr CCallConv
cconv SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"-}"

      gc_suf :: SDoc
gc_suf | Safety -> Bool
playSafe Safety
safety = String -> SDoc
text String
"_GC"
             | Bool
otherwise       = SDoc
empty

      ppr_fun :: CCallTarget -> SDoc
ppr_fun (StaticTarget SourceText
st CLabelString
_fn Maybe Unit
mPkgId Bool
isFun)
        = String -> SDoc
text (if Bool
isFun then String
"__pkg_ccall"
                         else String
"__pkg_ccall_value")
       SDoc -> SDoc -> SDoc
<> SDoc
gc_suf
       SDoc -> SDoc -> SDoc
<+> (case Maybe Unit
mPkgId of
            Maybe Unit
Nothing -> SDoc
empty
            Just Unit
pkgId -> Unit -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Unit
ppr Unit
pkgId)
       SDoc -> SDoc -> SDoc
<+> (SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
st SDoc
empty)

      ppr_fun CCallTarget
DynamicTarget
        = String -> SDoc
text String
"__dyn_ccall" SDoc -> SDoc -> SDoc
<> SDoc
gc_suf SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"\"\""

-- The filename for a C header file
-- Note [Pragma source text] in GHC.Types.Basic
data Header = Header SourceText FastString
    deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
External instance of the constraint type Eq CLabelString
External instance of the constraint type Eq SourceText
Eq, Typeable Header
DataType
Constr
Typeable Header
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Header -> c Header)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Header)
-> (Header -> Constr)
-> (Header -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Header))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Header))
-> ((forall b. Data b => b -> b) -> Header -> Header)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Header -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Header -> r)
-> (forall u. (forall d. Data d => d -> u) -> Header -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Header -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Header -> m Header)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Header -> m Header)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Header -> m Header)
-> Data Header
Header -> DataType
Header -> Constr
(forall b. Data b => b -> b) -> Header -> Header
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Header -> c Header
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Header
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) -> Header -> u
forall u. (forall d. Data d => d -> u) -> Header -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Header -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Header -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Header -> m Header
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Header -> m Header
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Header
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Header -> c Header
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Header)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Header)
$cHeader :: Constr
$tHeader :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Header -> m Header
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Header -> m Header
gmapMp :: (forall d. Data d => d -> m d) -> Header -> m Header
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Header -> m Header
gmapM :: (forall d. Data d => d -> m d) -> Header -> m Header
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Header -> m Header
gmapQi :: Int -> (forall d. Data d => d -> u) -> Header -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Header -> u
gmapQ :: (forall d. Data d => d -> u) -> Header -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Header -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Header -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Header -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Header -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Header -> r
gmapT :: (forall b. Data b => b -> b) -> Header -> Header
$cgmapT :: (forall b. Data b => b -> b) -> Header -> Header
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Header)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Header)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Header)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Header)
dataTypeOf :: Header -> DataType
$cdataTypeOf :: Header -> DataType
toConstr :: Header -> Constr
$ctoConstr :: Header -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Header
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Header
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Header -> c Header
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Header -> c Header
External instance of the constraint type Data SourceText
External instance of the constraint type Data CLabelString
Data)

instance Outputable Header where
    ppr :: Header -> SDoc
ppr (Header SourceText
st CLabelString
h) = SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
st (SDoc -> SDoc
doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ CLabelString -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabelString
ppr CLabelString
h)

-- | A C type, used in CAPI FFI calls
--
--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CTYPE'@,
--        'ApiAnnotation.AnnHeader','ApiAnnotation.AnnVal',
--        'ApiAnnotation.AnnClose' @'\#-}'@,

-- For details on above see note [Api annotations] in GHC.Parser.Annotation
data CType = CType SourceText -- Note [Pragma source text] in GHC.Types.Basic
                   (Maybe Header) -- header to include for this type
                   (SourceText,FastString) -- the type itself
    deriving (CType -> CType -> Bool
(CType -> CType -> Bool) -> (CType -> CType -> Bool) -> Eq CType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CType -> CType -> Bool
$c/= :: CType -> CType -> Bool
== :: CType -> CType -> Bool
$c== :: CType -> CType -> Bool
External instance of the constraint type Eq CLabelString
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
Instance of class: Eq of the constraint type Eq Header
External instance of the constraint type Eq SourceText
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type Eq CLabelString
External instance of the constraint type Eq SourceText
Instance of class: Eq of the constraint type Eq Header
Eq, Typeable CType
DataType
Constr
Typeable CType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CType -> c CType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CType)
-> (CType -> Constr)
-> (CType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CType))
-> ((forall b. Data b => b -> b) -> CType -> CType)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r)
-> (forall u. (forall d. Data d => d -> u) -> CType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CType -> m CType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CType -> m CType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CType -> m CType)
-> Data CType
CType -> DataType
CType -> Constr
(forall b. Data b => b -> b) -> CType -> CType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CType -> c CType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CType
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) -> CType -> u
forall u. (forall d. Data d => d -> u) -> CType -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CType -> m CType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CType -> m CType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CType -> c CType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CType)
$cCType :: Constr
$tCType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CType -> m CType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CType -> m CType
gmapMp :: (forall d. Data d => d -> m d) -> CType -> m CType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CType -> m CType
gmapM :: (forall d. Data d => d -> m d) -> CType -> m CType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CType -> m CType
gmapQi :: Int -> (forall d. Data d => d -> u) -> CType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CType -> u
gmapQ :: (forall d. Data d => d -> u) -> CType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CType -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CType -> r
gmapT :: (forall b. Data b => b -> b) -> CType -> CType
$cgmapT :: (forall b. Data b => b -> b) -> CType -> CType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CType)
dataTypeOf :: CType -> DataType
$cdataTypeOf :: CType -> DataType
toConstr :: CType -> Constr
$ctoConstr :: CType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CType -> c CType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CType -> c CType
Instance of class: Data of the constraint type Data Header
External instance of the constraint type Data CLabelString
External instance of the constraint type Data SourceText
Instance of class: Data of the constraint type Data Header
External instance of the constraint type Data CLabelString
External instance of the constraint type Data SourceText
External instance of the constraint type forall a b. (Data a, Data b) => Data (a, b)
External instance of the constraint type forall a. Data a => Data (Maybe a)
External instance of the constraint type Data SourceText
External instance of the constraint type Data CLabelString
Instance of class: Data of the constraint type Data Header
Data)

instance Outputable CType where
    ppr :: CType -> SDoc
ppr (CType SourceText
stp Maybe Header
mh (SourceText
stct,CLabelString
ct))
      = SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
stp (String -> SDoc
text String
"{-# CTYPE") SDoc -> SDoc -> SDoc
<+> SDoc
hDoc
        SDoc -> SDoc -> SDoc
<+> SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
stct (SDoc -> SDoc
doubleQuotes (CLabelString -> SDoc
ftext CLabelString
ct)) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"#-}"
        where hDoc :: SDoc
hDoc = case Maybe Header
mh of
                     Maybe Header
Nothing -> SDoc
empty
                     Just Header
h -> Header -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type Outputable Header
ppr Header
h

{-
************************************************************************
*                                                                      *
\subsubsection{Misc}
*                                                                      *
************************************************************************
-}

instance Binary ForeignCall where
    put_ :: BinHandle -> ForeignCall -> IO ()
put_ BinHandle
bh (CCall CCallSpec
aa) = BinHandle -> CCallSpec -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type Binary CCallSpec
put_ BinHandle
bh CCallSpec
aa
    get :: BinHandle -> IO ForeignCall
get BinHandle
bh = do CCallSpec
aa <- BinHandle -> IO CCallSpec
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type Binary CCallSpec
get BinHandle
bh; ForeignCall -> IO ForeignCall
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (CCallSpec -> ForeignCall
CCall CCallSpec
aa)

instance Binary Safety where
    put_ :: BinHandle -> Safety -> IO ()
put_ BinHandle
bh Safety
PlaySafe = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh Safety
PlayInterruptible = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    put_ BinHandle
bh Safety
PlayRisky = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    get :: BinHandle -> IO Safety
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do Safety -> IO Safety
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Safety
PlaySafe
              Word8
1 -> do Safety -> IO Safety
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Safety
PlayInterruptible
              Word8
_ -> do Safety -> IO Safety
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Safety
PlayRisky

instance Binary CExportSpec where
    put_ :: BinHandle -> CExportSpec -> IO ()
put_ BinHandle
bh (CExportStatic SourceText
ss CLabelString
aa CCallConv
ab) = do
            BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary SourceText
put_ BinHandle
bh SourceText
ss
            BinHandle -> CLabelString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary CLabelString
put_ BinHandle
bh CLabelString
aa
            BinHandle -> CCallConv -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type Binary CCallConv
put_ BinHandle
bh CCallConv
ab
    get :: BinHandle -> IO CExportSpec
get BinHandle
bh = do
          SourceText
ss <- BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary SourceText
get BinHandle
bh
          CLabelString
aa <- BinHandle -> IO CLabelString
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary CLabelString
get BinHandle
bh
          CCallConv
ab <- BinHandle -> IO CCallConv
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type Binary CCallConv
get BinHandle
bh
          CExportSpec -> IO CExportSpec
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (SourceText -> CLabelString -> CCallConv -> CExportSpec
CExportStatic SourceText
ss CLabelString
aa CCallConv
ab)

instance Binary CCallSpec where
    put_ :: BinHandle -> CCallSpec -> IO ()
put_ BinHandle
bh (CCallSpec CCallTarget
aa CCallConv
ab Safety
ac) = do
            BinHandle -> CCallTarget -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type Binary CCallTarget
put_ BinHandle
bh CCallTarget
aa
            BinHandle -> CCallConv -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type Binary CCallConv
put_ BinHandle
bh CCallConv
ab
            BinHandle -> Safety -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type Binary Safety
put_ BinHandle
bh Safety
ac
    get :: BinHandle -> IO CCallSpec
get BinHandle
bh = do
          CCallTarget
aa <- BinHandle -> IO CCallTarget
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type Binary CCallTarget
get BinHandle
bh
          CCallConv
ab <- BinHandle -> IO CCallConv
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type Binary CCallConv
get BinHandle
bh
          Safety
ac <- BinHandle -> IO Safety
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type Binary Safety
get BinHandle
bh
          CCallSpec -> IO CCallSpec
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (CCallTarget -> CCallConv -> Safety -> CCallSpec
CCallSpec CCallTarget
aa CCallConv
ab Safety
ac)

instance Binary CCallTarget where
    put_ :: BinHandle -> CCallTarget -> IO ()
put_ BinHandle
bh (StaticTarget SourceText
ss CLabelString
aa Maybe Unit
ab Bool
ac) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary SourceText
put_ BinHandle
bh SourceText
ss
            BinHandle -> CLabelString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary CLabelString
put_ BinHandle
bh CLabelString
aa
            BinHandle -> Maybe Unit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type forall a. Binary a => Binary (Maybe a)
External instance of the constraint type Binary Unit
put_ BinHandle
bh Maybe Unit
ab
            BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary Bool
put_ BinHandle
bh Bool
ac
    put_ BinHandle
bh CCallTarget
DynamicTarget = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    get :: BinHandle -> IO CCallTarget
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do SourceText
ss <- BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary SourceText
get BinHandle
bh
                      CLabelString
aa <- BinHandle -> IO CLabelString
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary CLabelString
get BinHandle
bh
                      Maybe Unit
ab <- BinHandle -> IO (Maybe Unit)
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type forall a. Binary a => Binary (Maybe a)
External instance of the constraint type Binary Unit
get BinHandle
bh
                      Bool
ac <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary Bool
get BinHandle
bh
                      CCallTarget -> IO CCallTarget
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (SourceText -> CLabelString -> Maybe Unit -> Bool -> CCallTarget
StaticTarget SourceText
ss CLabelString
aa Maybe Unit
ab Bool
ac)
              Word8
_ -> do CCallTarget -> IO CCallTarget
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return CCallTarget
DynamicTarget

instance Binary CCallConv where
    put_ :: BinHandle -> CCallConv -> IO ()
put_ BinHandle
bh CCallConv
CCallConv = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh CCallConv
StdCallConv = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    put_ BinHandle
bh CCallConv
PrimCallConv = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    put_ BinHandle
bh CCallConv
CApiConv = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
    put_ BinHandle
bh CCallConv
JavaScriptCallConv = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
    get :: BinHandle -> IO CCallConv
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return CCallConv
CCallConv
              Word8
1 -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return CCallConv
StdCallConv
              Word8
2 -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return CCallConv
PrimCallConv
              Word8
3 -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return CCallConv
CApiConv
              Word8
_ -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return CCallConv
JavaScriptCallConv

instance Binary CType where
    put_ :: BinHandle -> CType -> IO ()
put_ BinHandle
bh (CType SourceText
s Maybe Header
mh (SourceText, CLabelString)
fs) = do BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary SourceText
put_ BinHandle
bh SourceText
s
                                 BinHandle -> Maybe Header -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type forall a. Binary a => Binary (Maybe a)
Instance of class: Binary of the constraint type Binary Header
put_ BinHandle
bh Maybe Header
mh
                                 BinHandle -> (SourceText, CLabelString) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary SourceText
External instance of the constraint type Binary CLabelString
put_ BinHandle
bh (SourceText, CLabelString)
fs
    get :: BinHandle -> IO CType
get BinHandle
bh = do SourceText
s  <- BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary SourceText
get BinHandle
bh
                Maybe Header
mh <- BinHandle -> IO (Maybe Header)
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type forall a. Binary a => Binary (Maybe a)
Instance of class: Binary of the constraint type Binary Header
get BinHandle
bh
                (SourceText, CLabelString)
fs <- BinHandle -> IO (SourceText, CLabelString)
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary SourceText
External instance of the constraint type Binary CLabelString
get BinHandle
bh
                CType -> IO CType
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (SourceText -> Maybe Header -> (SourceText, CLabelString) -> CType
CType SourceText
s Maybe Header
mh (SourceText, CLabelString)
fs)

instance Binary Header where
    put_ :: BinHandle -> Header -> IO ()
put_ BinHandle
bh (Header SourceText
s CLabelString
h) = BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary SourceText
put_ BinHandle
bh SourceText
s IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> BinHandle -> CLabelString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary CLabelString
put_ BinHandle
bh CLabelString
h
    get :: BinHandle -> IO Header
get BinHandle
bh = do SourceText
s <- BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary SourceText
get BinHandle
bh
                CLabelString
h <- BinHandle -> IO CLabelString
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary CLabelString
get BinHandle
bh
                Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (SourceText -> CLabelString -> Header
Header SourceText
s CLabelString
h)