Remove 'threadsafe' FFI imports

They've been deprecated since GHC 6.12.

compiler/cmm/CmmParse.y

@@ -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)

compiler/deSugar/DsMeta.hs

@@ -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 =

compiler/hsSyn/Convert.lhs

@@ -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)

compiler/parser/Lexer.x

@@ -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),

compiler/parser/Parser.y.pp

@@ -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") }
 

compiler/parser/ParserCore.y

@@ -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] }

compiler/prelude/ForeignCall.lhs

@@ -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
 

compiler/typecheck/TcForeign.lhs

@@ -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}