From: Duncan Coutts Date: Thu, 11 Jun 2009 12:34:41 +0000 (+0000) Subject: Deprecate the threadsafe kind of foreign import X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=5cb496dc86fac0b6023c08d4a0d7467df8d7b540 Deprecate the threadsafe kind of foreign import --- diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index b4d40ce..4d8e0f0 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -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), diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 7465adb..47b049e 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -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) } diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs index 27f5b4f..cae46be 100644 --- a/compiler/prelude/ForeignCall.lhs +++ b/compiler/prelude/ForeignCall.lhs @@ -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} diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index aa40d02..35f627e 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -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}