Commit 5cb496dc authored by Duncan Coutts's avatar Duncan Coutts

Deprecate the threadsafe kind of foreign import

parent 20169649
......@@ -688,7 +688,7 @@ reservedWordsFM = listToUFM $
( "label", ITlabel, bit ffiBit),
( "dynamic", ITdynamic, bit ffiBit),
( "safe", ITsafe, bit ffiBit),
( "threadsafe", ITthreadsafe, bit ffiBit),
( "threadsafe", ITthreadsafe, bit ffiBit), -- ToDo: remove
( "unsafe", ITunsafe, bit ffiBit),
( "stdcall", ITstdcallconv, bit ffiBit),
( "ccall", ITccallconv, bit ffiBit),
......
......@@ -240,7 +240,7 @@ incorrect.
'label' { L _ ITlabel }
'dynamic' { L _ ITdynamic }
'safe' { L _ ITsafe }
'threadsafe' { L _ ITthreadsafe }
'threadsafe' { L _ ITthreadsafe } -- ToDo: remove deprecated alias
'unsafe' { L _ ITunsafe }
'mdo' { L _ ITmdo }
'family' { L _ ITfamily }
......@@ -957,7 +957,7 @@ callconv :: { CallConv }
safety :: { Safety }
: 'unsafe' { PlayRisky }
| 'safe' { PlaySafe False }
| 'threadsafe' { PlaySafe True }
| 'threadsafe' { PlaySafe True } -- deprecated alias
fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
: STRING var '::' sigtypedoc { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
......
......@@ -13,7 +13,7 @@
module ForeignCall (
ForeignCall(..),
Safety(..), playSafe, playThreadSafe,
Safety(..), playSafe,
CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
CCallSpec(..),
......@@ -57,11 +57,14 @@ instance Outputable ForeignCall where
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
Bool -- => True, external function is also re-entrant.
-- [if supported, RTS arranges for the external call
-- to be executed by a separate OS thread, i.e.,
-- _concurrently_ to the execution of other Haskell threads.]
-- 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.
Bool -- Indicates the deprecated "threadsafe" annotation
-- which is now an alias for "safe". This information
-- is never used except to emit a deprecation warning.
| PlayRisky -- None of the above can happen; the call will return
-- without interacting with the runtime system at all
......@@ -77,10 +80,6 @@ instance Outputable Safety where
playSafe :: Safety -> Bool
playSafe PlaySafe{} = True
playSafe PlayRisky = False
playThreadSafe :: Safety -> Bool
playThreadSafe (PlaySafe x) = x
playThreadSafe _ = False
\end{code}
......
......@@ -108,14 +108,15 @@ tcCheckFIType _ arg_tys res_ty (DNImport spec) = do
_ -> return ()
return (DNImport (withDNTypes spec (map toDNType arg_tys) (toDNType res_ty)))
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ _ (CLabel _))
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ _ (CLabel _))
= ASSERT( null arg_tys )
do { checkCg checkCOrAsm
; checkSafety safety
; check (isFFILabelTy res_ty) (illegalForeignTyErr empty sig_ty)
; return idecl } -- NB check res_ty not sig_ty!
-- In case sig_ty is (forall a. ForeignPtr a)
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ _ CWrapper) = do
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ CWrapper) = do
-- Foreign wrapper (former f.e.d.)
-- The type must be of the form ft -> IO (FunPtr ft), where ft is a
-- valid foreign type. For legacy reasons ft -> IO (Ptr ft) as well
......@@ -123,6 +124,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ _ CWrapper) = do
-- is DEPRECATED, though.
checkCg checkCOrAsmOrInterp
checkCConv cconv
checkSafety safety
case arg_tys of
[arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys
checkForeignRes nonIOok isFFIExportResultTy res1_ty
......@@ -137,6 +139,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ (CFunction t
| isDynamicTarget target = do -- Foreign import dynamic
checkCg checkCOrAsmOrInterp
checkCConv cconv
checkSafety safety
case arg_tys of -- The first arg must be Ptr, FunPtr, or Addr
[] -> do
check False (illegalForeignTyErr empty sig_ty)
......@@ -151,6 +154,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ (CFunction t
| otherwise = do -- Normal foreign import
checkCg (checkCOrAsmOrDotNetOrInterp)
checkCConv cconv
checkSafety safety
checkCTarget target
dflags <- getDOpts
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
......@@ -347,6 +351,14 @@ checkCConv StdCallConv = addErrTc (text "calling convention not supported on thi
checkCConv CmmCallConv = panic "checkCConv CmmCallConv"
\end{code}
Deprecated "threadsafe" calls
\begin{code}
checkSafety :: Safety -> TcM ()
checkSafety (PlaySafe True) = addWarn (text "The `threadsafe' foreign import style is deprecated. Use `safe' instead.")
checkSafety _ = return ()
\end{code}
Warnings
\begin{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment