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

\section[Foreign]{Foreign calls}
-}

{-# LANGUAGE DeriveDataTypeable #-}

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

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

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

import GhcPrelude

import FastString
import Binary
import Outputable
import Module
import BasicTypes ( 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
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
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
  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
$cp1Data :: Typeable 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 BasicTypes
        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
$cp1Data :: Typeable CExportSpec
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
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 BasicTypes
        CLabelString                    -- C-land name of label.

        (Maybe UnitId)              -- 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
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
$cp1Data :: Typeable CCallTarget
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
$cp1Data :: Typeable 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
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
'.'
        -- 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
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 UnitId
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 UnitId
mPkgId of
            Maybe UnitId
Nothing -> SDoc
empty
            Just UnitId
pkgId -> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
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 BasicTypes
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
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
$cp1Data :: Typeable Header
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
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 ApiAnnotation
data CType = CType SourceText -- Note [Pragma source text] in BasicTypes
                   (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
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
$cp1Data :: Typeable CType
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
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 ()
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
get BinHandle
bh; ForeignCall -> IO ForeignCall
forall (m :: * -> *) a. Monad m => a -> m a
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
return Safety
PlaySafe
              Word8
1 -> do Safety -> IO Safety
forall (m :: * -> *) a. Monad m => a -> m a
return Safety
PlayInterruptible
              Word8
_ -> do Safety -> IO Safety
forall (m :: * -> *) a. Monad m => a -> m a
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 ()
put_ BinHandle
bh SourceText
ss
            BinHandle -> CLabelString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CLabelString
aa
            BinHandle -> CCallConv -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
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
get BinHandle
bh
          CLabelString
aa <- BinHandle -> IO CLabelString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
          CCallConv
ab <- BinHandle -> IO CCallConv
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
          CExportSpec -> IO CExportSpec
forall (m :: * -> *) a. Monad m => a -> m a
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 ()
put_ BinHandle
bh CCallTarget
aa
            BinHandle -> CCallConv -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CCallConv
ab
            BinHandle -> Safety -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
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
get BinHandle
bh
          CCallConv
ab <- BinHandle -> IO CCallConv
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
          Safety
ac <- BinHandle -> IO Safety
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
          CCallSpec -> IO CCallSpec
forall (m :: * -> *) a. Monad m => a -> m a
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 UnitId
ab Bool
ac) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
ss
            BinHandle -> CLabelString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CLabelString
aa
            BinHandle -> Maybe UnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe UnitId
ab
            BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
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
get BinHandle
bh
                      CLabelString
aa <- BinHandle -> IO CLabelString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      Maybe UnitId
ab <- BinHandle -> IO (Maybe UnitId)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      Bool
ac <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      CCallTarget -> IO CCallTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText -> CLabelString -> Maybe UnitId -> Bool -> CCallTarget
StaticTarget SourceText
ss CLabelString
aa Maybe UnitId
ab Bool
ac)
              Word8
_ -> do CCallTarget -> IO CCallTarget
forall (m :: * -> *) a. Monad m => a -> m a
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
return CCallConv
CCallConv
              Word8
1 -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
return CCallConv
StdCallConv
              Word8
2 -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
return CCallConv
PrimCallConv
              Word8
3 -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
return CCallConv
CApiConv
              Word8
_ -> do CCallConv -> IO CCallConv
forall (m :: * -> *) a. Monad m => a -> m a
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 ()
put_ BinHandle
bh SourceText
s
                                 BinHandle -> Maybe Header -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Header
mh
                                 BinHandle -> (SourceText, CLabelString) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
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
get BinHandle
bh
                Maybe Header
mh <- BinHandle -> IO (Maybe Header)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                (SourceText, CLabelString)
fs <- BinHandle -> IO (SourceText, CLabelString)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                CType -> IO CType
forall (m :: * -> *) a. Monad m => a -> m a
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 ()
put_ BinHandle
bh SourceText
s IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> CLabelString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
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
get BinHandle
bh
                CLabelString
h <- BinHandle -> IO CLabelString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText -> CLabelString -> Header
Header SourceText
s CLabelString
h)