projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics
[ghc-hetmet.git]
/
compiler
/
prelude
/
ForeignCall.lhs
diff --git
a/compiler/prelude/ForeignCall.lhs
b/compiler/prelude/ForeignCall.lhs
index
4423d03
..
a92cabd
100644
(file)
--- a/
compiler/prelude/ForeignCall.lhs
+++ b/
compiler/prelude/ForeignCall.lhs
@@
-10,10
+10,11
@@
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module ForeignCall (
ForeignCall(..),
module ForeignCall (
ForeignCall(..),
- Safety(..), playSafe,
+ Safety(..), playSafe, playInterruptible,
CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
CCallSpec(..),
CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
CCallSpec(..),
@@
-27,6
+28,7
@@
import Outputable
import Module
import Data.Char
import Module
import Data.Char
+import Data.Data
\end{code}
\end{code}
@@
-61,20
+63,31
@@
data Safety
-- which is now an alias for "safe". This information
-- is never used except to emit a deprecation warning.
-- 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
| 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")
-- 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
ppr PlayRisky = ptext (sLit "unsafe")
playSafe :: Safety -> Bool
playSafe PlaySafe{} = True
+playSafe PlayInterruptible = True
playSafe PlayRisky = False
playSafe PlayRisky = False
+
+playInterruptible :: Safety -> Bool
+playInterruptible PlayInterruptible = True
+playInterruptible _ = False
\end{code}
\end{code}
@@
-89,6
+102,7
@@
data CExportSpec
= CExportStatic -- foreign export ccall foo :: ty
CLabelString -- C Name of exported function
CCallConv
= CExportStatic -- foreign export ccall foo :: ty
CLabelString -- C Name of exported function
CCallConv
+ deriving (Data, Typeable)
{-! derive: Binary !-}
data CCallSpec
{-! derive: Binary !-}
data CCallSpec
@@
-121,7
+135,7
@@
data CCallTarget
-- Used when importing a label as "foreign import ccall "dynamic" ..."
| DynamicTarget
-- Used when importing a label as "foreign import ccall "dynamic" ..."
| DynamicTarget
- deriving( Eq )
+ deriving( Eq, Data, Typeable )
{-! derive: Binary !-}
isDynamicTarget :: CCallTarget -> Bool
{-! derive: Binary !-}
isDynamicTarget :: CCallTarget -> Bool
@@
-146,7
+160,7
@@
See: http://www.programmersheaven.com/2/Calling-conventions
\begin{code}
data CCallConv = CCallConv | StdCallConv | CmmCallConv | PrimCallConv
\begin{code}
data CCallConv = CCallConv | StdCallConv | CmmCallConv | PrimCallConv
- deriving (Eq)
+ deriving (Eq, Data, Typeable)
{-! derive: Binary !-}
instance Outputable CCallConv where
{-! derive: Binary !-}
instance Outputable CCallConv where
@@
-230,13
+244,16
@@
instance Binary Safety where
put_ bh (PlaySafe aa) = do
putByte bh 0
put_ bh aa
put_ bh (PlaySafe aa) = do
putByte bh 0
put_ bh aa
- put_ bh PlayRisky = do
+ put_ bh PlayInterruptible = do
putByte bh 1
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)
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
_ -> do return PlayRisky
instance Binary CExportSpec where