-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module ForeignCall (
ForeignCall(..),
- Safety(..), playSafe,
+ Safety(..), playSafe, playInterruptible,
CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
CCallSpec(..),
import FastString
import Binary
import Outputable
+import Module
import Data.Char
+import Data.Data
\end{code}
-- which is now an alias for "safe". This information
-- is never used except to emit a deprecation warning.
+ | 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 ( Eq, Show )
+ deriving ( Eq, Show, Data, Typeable )
-- Show used just for Show Lex.Token, I think
{-! derive: Binary !-}
instance Outputable Safety where
ppr (PlaySafe False) = ptext (sLit "safe")
ppr (PlaySafe True) = ptext (sLit "threadsafe")
+ ppr PlayInterruptible = ptext (sLit "interruptible")
ppr PlayRisky = ptext (sLit "unsafe")
playSafe :: Safety -> Bool
playSafe PlaySafe{} = True
+playSafe PlayInterruptible = True
playSafe PlayRisky = False
+
+playInterruptible :: Safety -> Bool
+playInterruptible PlayInterruptible = True
+playInterruptible _ = False
\end{code}
= CExportStatic -- foreign export ccall foo :: ty
CLabelString -- C Name of exported function
CCallConv
+ deriving (Data, Typeable)
{-! derive: Binary !-}
data CCallSpec
The call target:
\begin{code}
+
+-- | How to call a particular function in C-land.
data CCallTarget
- = StaticTarget CLabelString -- An "unboxed" ccall# to `fn'.
- | DynamicTarget -- First argument (an Addr#) is the function pointer
- deriving( Eq )
+ -- An "unboxed" ccall# to named function in a particular package.
+ = StaticTarget
+ CLabelString -- C-land name of label.
+
+ (Maybe PackageId) -- 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" ..."
+ | DynamicTarget
+
+ deriving( Eq, Data, Typeable )
{-! derive: Binary !-}
isDynamicTarget :: CCallTarget -> Bool
\begin{code}
data CCallConv = CCallConv | StdCallConv | CmmCallConv | PrimCallConv
- deriving (Eq)
+ deriving (Eq, Data, Typeable)
{-! derive: Binary !-}
instance Outputable CCallConv where
gc_suf | playSafe safety = text "_GC"
| otherwise = empty
- ppr_fun DynamicTarget = text "__dyn_ccall" <> gc_suf <+> text "\"\""
- ppr_fun (StaticTarget fn) = text "__ccall" <> gc_suf <+> pprCLabelString fn
+ ppr_fun (StaticTarget fn Nothing)
+ = text "__pkg_ccall" <> gc_suf <+> pprCLabelString fn
+
+ ppr_fun (StaticTarget fn (Just pkgId))
+ = text "__pkg_ccall" <> gc_suf <+> ppr pkgId <+> pprCLabelString fn
+
+ ppr_fun DynamicTarget
+ = text "__dyn_ccall" <> gc_suf <+> text "\"\""
\end{code}
put_ bh (PlaySafe aa) = do
putByte bh 0
put_ bh aa
- put_ bh PlayRisky = do
+ put_ bh PlayInterruptible = do
putByte bh 1
+ put_ bh PlayRisky = do
+ putByte bh 2
get bh = do
h <- getByte bh
case h of
0 -> do aa <- get bh
return (PlaySafe aa)
+ 1 -> do return PlayInterruptible
_ -> do return PlayRisky
instance Binary CExportSpec where
return (CCallSpec aa ab ac)
instance Binary CCallTarget where
- put_ bh (StaticTarget aa) = do
+ put_ bh (StaticTarget aa ab) = do
putByte bh 0
put_ bh aa
+ put_ bh ab
put_ bh DynamicTarget = do
putByte bh 1
get bh = do
h <- getByte bh
case h of
0 -> do aa <- get bh
- return (StaticTarget aa)
+ ab <- get bh
+ return (StaticTarget aa ab)
_ -> do return DynamicTarget
instance Binary CCallConv where