( "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),
'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 }
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) }
module ForeignCall (
ForeignCall(..),
- Safety(..), playSafe, playThreadSafe,
+ Safety(..), playSafe,
CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
CCallSpec(..),
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
playSafe :: Safety -> Bool
playSafe PlaySafe{} = True
playSafe PlayRisky = False
-
-playThreadSafe :: Safety -> Bool
-playThreadSafe (PlaySafe x) = x
-playThreadSafe _ = False
\end{code}
_ -> 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
-- 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
| 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)
| otherwise = do -- Normal foreign import
checkCg (checkCOrAsmOrDotNetOrInterp)
checkCConv cconv
+ checkSafety safety
checkCTarget target
dflags <- getDOpts
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
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}