Commit 82059172 authored by Ian Lynagh's avatar Ian Lynagh

Remove 'threadsafe' FFI imports

They've been deprecated since GHC 6.12.
parent e6af412f
......@@ -874,9 +874,8 @@ foreignCall conv_string results_code expr_code args_code vols safety ret
code (emitForeignCall' PlayRisky results
(CmmCallee expr' convention) args vols NoC_SRT ret)
CmmSafe srt ->
code (emitForeignCall' (PlaySafe unused) results
code (emitForeignCall' PlaySafe results
(CmmCallee expr' convention) args vols NoC_SRT ret) where
unused = panic "not used by emitForeignCall'"
CmmInterruptible ->
code (emitForeignCall' PlayInterruptible results
(CmmCallee expr' convention) args vols NoC_SRT ret)
......@@ -911,9 +910,8 @@ primCall results_code name args_code vols safety
code (emitForeignCall' PlayRisky results
(CmmPrim p) args vols NoC_SRT CmmMayReturn)
CmmSafe srt ->
code (emitForeignCall' (PlaySafe unused) results
code (emitForeignCall' PlaySafe results
(CmmPrim p) args vols NoC_SRT CmmMayReturn) where
unused = panic "not used by emitForeignCall'"
CmmInterruptible ->
code (emitForeignCall' PlayInterruptible results
(CmmPrim p) args vols NoC_SRT CmmMayReturn)
......
......@@ -351,8 +351,7 @@ repCCallConv callConv = notHandled "repCCallConv" (ppr callConv)
repSafety :: Safety -> DsM (Core TH.Safety)
repSafety PlayRisky = rep2 unsafeName []
repSafety PlayInterruptible = rep2 interruptibleName []
repSafety (PlaySafe False) = rep2 safeName []
repSafety (PlaySafe True) = rep2 threadsafeName []
repSafety PlaySafe = rep2 safeName []
ds_msg :: SDoc
ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:")
......@@ -1797,7 +1796,6 @@ templateHaskellNames = [
-- Safety
unsafeName,
safeName,
threadsafeName,
interruptibleName,
-- InlineSpec
inlineSpecNoPhaseName, inlineSpecPhaseName,
......@@ -2046,10 +2044,9 @@ cCallName = libFun (fsLit "cCall") cCallIdKey
stdCallName = libFun (fsLit "stdCall") stdCallIdKey
-- data Safety = ...
unsafeName, safeName, threadsafeName, interruptibleName :: Name
unsafeName, safeName, interruptibleName :: Name
unsafeName = libFun (fsLit "unsafe") unsafeIdKey
safeName = libFun (fsLit "safe") safeIdKey
threadsafeName = libFun (fsLit "threadsafe") threadsafeIdKey
interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
-- data InlineSpec = ...
......@@ -2328,10 +2325,9 @@ cCallIdKey = mkPreludeMiscIdUnique 394
stdCallIdKey = mkPreludeMiscIdUnique 395
-- data Safety = ...
unsafeIdKey, safeIdKey, threadsafeIdKey, interruptibleIdKey :: Unique
unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
unsafeIdKey = mkPreludeMiscIdUnique 400
safeIdKey = mkPreludeMiscIdUnique 401
threadsafeIdKey = mkPreludeMiscIdUnique 402
interruptibleIdKey = mkPreludeMiscIdUnique 403
-- data InlineSpec =
......
......@@ -374,8 +374,7 @@ cvtForD (ImportF callconv safety from nm ty)
where
safety' = case safety of
Unsafe -> PlayRisky
Safe -> PlaySafe False
Threadsafe -> PlaySafe True
Safe -> PlaySafe
Interruptible -> PlayInterruptible
cvtForD (ExportF callconv as nm ty)
......
......@@ -451,7 +451,6 @@ data Token
| ITlabel
| ITdynamic
| ITsafe
| ITthreadsafe
| ITinterruptible
| ITunsafe
| ITstdcallconv
......@@ -599,7 +598,6 @@ isSpecial ITexport = True
isSpecial ITlabel = True
isSpecial ITdynamic = True
isSpecial ITsafe = True
isSpecial ITthreadsafe = True
isSpecial ITinterruptible = True
isSpecial ITunsafe = True
isSpecial ITccallconv = True
......@@ -662,7 +660,6 @@ reservedWordsFM = listToUFM $
( "label", ITlabel, bit ffiBit),
( "dynamic", ITdynamic, bit ffiBit),
( "safe", ITsafe, bit ffiBit .|. bit safeHaskellBit),
( "threadsafe", ITthreadsafe, bit ffiBit), -- ToDo: remove
( "interruptible", ITinterruptible, bit interruptibleFfiBit),
( "unsafe", ITunsafe, bit ffiBit),
( "stdcall", ITstdcallconv, bit ffiBit),
......
......@@ -238,7 +238,6 @@ incorrect.
'label' { L _ ITlabel }
'dynamic' { L _ ITdynamic }
'safe' { L _ ITsafe }
'threadsafe' { L _ ITthreadsafe } -- ToDo: remove deprecated alias
'interruptible' { L _ ITinterruptible }
'unsafe' { L _ ITunsafe }
'mdo' { L _ ITmdo }
......@@ -894,7 +893,7 @@ fdecl :: { LHsDecl RdrName }
fdecl : 'import' callconv safety fspec
{% mkImport $2 $3 (unLoc $4) >>= return.LL }
| 'import' callconv fspec
{% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
{% do { d <- mkImport $2 PlaySafe (unLoc $3);
return (LL d) } }
| 'export' callconv fspec
{% mkExport $2 (unLoc $3) >>= return.LL }
......@@ -906,9 +905,8 @@ callconv :: { CCallConv }
safety :: { Safety }
: 'unsafe' { PlayRisky }
| 'safe' { PlaySafe False }
| 'safe' { PlaySafe }
| 'interruptible' { PlayInterruptible }
| 'threadsafe' { PlaySafe True } -- deprecated alias
fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
: STRING var '::' sigtypedoc { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
......@@ -1808,7 +1806,6 @@ tyvarid :: { Located RdrName }
| 'unsafe' { L1 $! mkUnqual tvName (fsLit "unsafe") }
| 'safe' { L1 $! mkUnqual tvName (fsLit "safe") }
| 'interruptible' { L1 $! mkUnqual tvName (fsLit "interruptible") }
| 'threadsafe' { L1 $! mkUnqual tvName (fsLit "threadsafe") }
tyvarsym :: { Located RdrName }
-- Does not include "!", because that is used for strictness marks
......@@ -1842,7 +1839,6 @@ varid :: { Located RdrName }
| 'unsafe' { L1 $! mkUnqual varName (fsLit "unsafe") }
| 'safe' { L1 $! mkUnqual varName (fsLit "safe") }
| 'interruptible' { L1 $! mkUnqual varName (fsLit "interruptible") }
| 'threadsafe' { L1 $! mkUnqual varName (fsLit "threadsafe") }
| 'forall' { L1 $! mkUnqual varName (fsLit "forall") }
| 'family' { L1 $! mkUnqual varName (fsLit "family") }
......
......@@ -279,7 +279,7 @@ exp :: { IfaceExpr }
-- }
| '%external' STRING aty { IfaceFCall (ForeignCall.CCall
(CCallSpec (StaticTarget (mkFastString $2) Nothing)
CCallConv (PlaySafe False)))
CCallConv PlaySafe))
$3 }
alts1 :: { [IfaceAlt] }
......
......@@ -62,10 +62,6 @@ data Safety
-- 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.
| PlayInterruptible -- Like PlaySafe, but additionally
-- the worker thread running this foreign call may
-- be unceremoniously killed, so it must be scheduled
......@@ -78,15 +74,14 @@ data Safety
{-! derive: Binary !-}
instance Outputable Safety where
ppr (PlaySafe False) = ptext (sLit "safe")
ppr (PlaySafe True) = ptext (sLit "threadsafe")
ppr PlaySafe = ptext (sLit "safe")
ppr PlayInterruptible = ptext (sLit "interruptible")
ppr PlayRisky = ptext (sLit "unsafe")
playSafe :: Safety -> Bool
playSafe PlaySafe{} = True
playSafe PlaySafe = True
playSafe PlayInterruptible = True
playSafe PlayRisky = False
playSafe PlayRisky = False
playInterruptible :: Safety -> Bool
playInterruptible PlayInterruptible = True
......@@ -244,9 +239,8 @@ instance Binary ForeignCall where
get bh = do aa <- get bh; return (CCall aa)
instance Binary Safety where
put_ bh (PlaySafe aa) = do
put_ bh PlaySafe = do
putByte bh 0
put_ bh aa
put_ bh PlayInterruptible = do
putByte bh 1
put_ bh PlayRisky = do
......@@ -254,8 +248,7 @@ instance Binary Safety where
get bh = do
h <- getByte bh
case h of
0 -> do aa <- get bh
return (PlaySafe aa)
0 -> do return PlaySafe
1 -> do return PlayInterruptible
_ -> do return PlayRisky
......
......@@ -88,15 +88,14 @@ tcFImport d = pprPanic "tcFImport" (ppr d)
\begin{code}
tcCheckFIType :: Type -> [Type] -> Type -> ForeignImport -> TcM ForeignImport
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ (CLabel _))
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ (CLabel _))
= ASSERT( null arg_tys )
do { checkCg checkCOrAsmOrLlvmOrInterp
; 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 safety _ CWrapper) = do
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ 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
......@@ -104,7 +103,6 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ CWrapper) = do
-- is DEPRECATED, though.
checkCg checkCOrAsmOrLlvmOrInterp
checkCConv cconv
checkSafety safety
case arg_tys of
[arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys
checkForeignRes nonIOok False isFFIExportResultTy res1_ty
......@@ -118,7 +116,6 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar
| isDynamicTarget target = do -- Foreign import dynamic
checkCg checkCOrAsmOrLlvmOrInterp
checkCConv cconv
checkSafety safety
case arg_tys of -- The first arg must be Ptr, FunPtr, or Addr
[] -> do
check False (illegalForeignTyErr empty sig_ty)
......@@ -149,7 +146,6 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar
| otherwise = do -- Normal foreign import
checkCg (checkCOrAsmOrLlvmOrDotNetOrInterp)
checkCConv cconv
checkSafety safety
checkCTarget target
dflags <- getDOpts
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
......@@ -323,14 +319,6 @@ checkCConv PrimCallConv = addErrTc (text "The `prim' calling convention can only
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