diff --git a/System/Posix.hs b/System/Posix.hs index 09bdde6f54824407b96186eb247bf71cdb5e2ff8..b5b221af5db2c198552cf0b2a4d9f2b5ea2d01b6 100644 --- a/System/Posix.hs +++ b/System/Posix.hs @@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Safe #-} -#endif ----------------------------------------------------------------------------- -- | -- Module : System.Posix diff --git a/System/Posix/ByteString.hs b/System/Posix/ByteString.hs index 793020c012650841565f82d499dc943f78415316..7f0b266668cd8e4ccfcfd270ae6a742095b248fe 100644 --- a/System/Posix/ByteString.hs +++ b/System/Posix/ByteString.hs @@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Safe #-} -#endif ----------------------------------------------------------------------------- -- | -- Module : System.Posix.ByteString diff --git a/System/Posix/ByteString/FilePath.hsc b/System/Posix/ByteString/FilePath.hsc index 5e3692a692f98fc93b736f843d18286839f3d535..b6768fc65292a5c65bc60fc842d6d008e6ba162a 100644 --- a/System/Posix/ByteString/FilePath.hsc +++ b/System/Posix/ByteString/FilePath.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc index 7a3d52aee0f44ac2df47e46fa1e94fc4aa96604c..f1caaaf322dfb694e97cab23e8746a061f220cd3 100644 --- a/System/Posix/Directory.hsc +++ b/System/Posix/Directory.hsc @@ -1,8 +1,6 @@ {-# LANGUAGE CApiFFI #-} {-# LANGUAGE NondecreasingIndentation #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} -#endif ----------------------------------------------------------------------------- -- | diff --git a/System/Posix/Directory/ByteString.hsc b/System/Posix/Directory/ByteString.hsc index b67ad4657f05d7cd7e208241dabe42df1fbfdc4d..3f9683192be302d33f67c9a55df4a1ba867060ab 100644 --- a/System/Posix/Directory/ByteString.hsc +++ b/System/Posix/Directory/ByteString.hsc @@ -1,8 +1,6 @@ {-# LANGUAGE CApiFFI #-} {-# LANGUAGE NondecreasingIndentation #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} -#endif ----------------------------------------------------------------------------- -- | diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index 9fb5ac42a2b67fd1980f9596dc3cf3fd7f6a3732..aba20af055a1a2d9175d7c24f1e7a8da97a4b6dc 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif diff --git a/System/Posix/DynamicLinker.hsc b/System/Posix/DynamicLinker.hsc index a2b733642c498ff5394582ea78bf67ed45298363..656054c0632f17a8d7af87638e8537c7d8e197cd 100644 --- a/System/Posix/DynamicLinker.hsc +++ b/System/Posix/DynamicLinker.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/DynamicLinker/ByteString.hsc b/System/Posix/DynamicLinker/ByteString.hsc index 2111aa2ab72485bd4075470da26405e54aed26fa..1693fed65acedca847178cb7d5089ba167181f68 100644 --- a/System/Posix/DynamicLinker/ByteString.hsc +++ b/System/Posix/DynamicLinker/ByteString.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif diff --git a/System/Posix/DynamicLinker/Common.hsc b/System/Posix/DynamicLinker/Common.hsc index 8a44d95569398d639ae762e8bc029f4ab5fdcf10..32bfccc9a4f902af8798886349850f18871d2279 100644 --- a/System/Posix/DynamicLinker/Common.hsc +++ b/System/Posix/DynamicLinker/Common.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/DynamicLinker/Module.hsc b/System/Posix/DynamicLinker/Module.hsc index d971fa783bc070f19e1bcd74e51865326dc381bb..eb4938b0c7f664a1e717afdfe141e71c1e8ff98f 100644 --- a/System/Posix/DynamicLinker/Module.hsc +++ b/System/Posix/DynamicLinker/Module.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/DynamicLinker/Module/ByteString.hsc b/System/Posix/DynamicLinker/Module/ByteString.hsc index d5973a8845315d4987e26bad1937948639f4a411..3a902bce3280e8e7334627c359f204d4f2d4bcb4 100644 --- a/System/Posix/DynamicLinker/Module/ByteString.hsc +++ b/System/Posix/DynamicLinker/Module/ByteString.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif diff --git a/System/Posix/DynamicLinker/Prim.hsc b/System/Posix/DynamicLinker/Prim.hsc index e73791825aead5c9d9b9a6226546166b49cc69ec..67d4aa890390f7dcd51038c055ee6b353a71aae5 100644 --- a/System/Posix/DynamicLinker/Prim.hsc +++ b/System/Posix/DynamicLinker/Prim.hsc @@ -1,9 +1,8 @@ -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} #if __GLASGOW_HASKELL__ >= 709 {-# OPTIONS_GHC -fno-warn-trustworthy-safe #-} #endif -#endif + ----------------------------------------------------------------------------- -- | -- Module : System.Posix.DynamicLinker.Prim diff --git a/System/Posix/Env.hsc b/System/Posix/Env.hsc index 95b7bc8c16e2903305411e94bf2af2eaba702c86..6d7f61b72f9987d7fd1ccf37fc5d8719f43feb0b 100644 --- a/System/Posix/Env.hsc +++ b/System/Posix/Env.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/Env/ByteString.hsc b/System/Posix/Env/ByteString.hsc index 9217525388cade5ff0911f0a0b6426ef01f97b43..0bbcfd8b81d4119bca797bc82247e1f221b9a589 100644 --- a/System/Posix/Env/ByteString.hsc +++ b/System/Posix/Env/ByteString.hsc @@ -1,9 +1,7 @@ -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} #if __GLASGOW_HASKELL__ >= 709 {-# OPTIONS_GHC -fno-warn-trustworthy-safe #-} #endif -#endif ----------------------------------------------------------------------------- -- | diff --git a/System/Posix/Error.hs b/System/Posix/Error.hs index d3b10a787a254b5d5c8f6daa28fddeb74c033fe2..9d2ac702f530be1a0c677e7bdb6e3ad15970256e 100644 --- a/System/Posix/Error.hs +++ b/System/Posix/Error.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/Fcntl.hsc b/System/Posix/Fcntl.hsc index 749826ffeacf9dd9b9f5f2777cad98c7498829a8..2d8ef1286b913ba72b799ac7f5ba26cf7644add3 100644 --- a/System/Posix/Fcntl.hsc +++ b/System/Posix/Fcntl.hsc @@ -1,7 +1,7 @@ {-# LANGUAGE CApiFFI #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc index d0ff4bfce2513cd16af91ca2321dbfd488ea7672..7c637cc3ee40e6618275b57b4b3c6582e82e6286 100644 --- a/System/Posix/Files.hsc +++ b/System/Posix/Files.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif {-# LANGUAGE CApiFFI #-} diff --git a/System/Posix/Files/ByteString.hsc b/System/Posix/Files/ByteString.hsc index 12bd39aa78089ce87329f6b33dfcd42a1a700fa9..872817ed00cb8e89e147cda45575c1aa211baf24 100644 --- a/System/Posix/Files/ByteString.hsc +++ b/System/Posix/Files/ByteString.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif {-# LANGUAGE CApiFFI #-} diff --git a/System/Posix/Files/Common.hsc b/System/Posix/Files/Common.hsc index 963008f738838bd78e40210e30fae7d6010ed28b..a1a427897887bb2266e36773d8fb668fb6c0cb94 100644 --- a/System/Posix/Files/Common.hsc +++ b/System/Posix/Files/Common.hsc @@ -1,6 +1,5 @@ -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Files.Common diff --git a/System/Posix/IO.hsc b/System/Posix/IO.hsc index 41e0b3b0902d4974d2fdf756710b165adcd5dbf3..b3f4c842da078fd6d1b523934f8bcb203629057f 100644 --- a/System/Posix/IO.hsc +++ b/System/Posix/IO.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/IO/ByteString.hsc b/System/Posix/IO/ByteString.hsc index b8bc87aa7b8fa3b8f2149ce6ea2699ba25f95511..d387f0e2d42742a5c22a8c257ccca8b6553bebbe 100644 --- a/System/Posix/IO/ByteString.hsc +++ b/System/Posix/IO/ByteString.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/IO/Common.hsc b/System/Posix/IO/Common.hsc index abcd19b2b9c1c5665dbf41530de0b3a2e06a280d..8f8ddb9abab1bf299204f4bb88899baf0509f163 100644 --- a/System/Posix/IO/Common.hsc +++ b/System/Posix/IO/Common.hsc @@ -1,7 +1,7 @@ {-# LANGUAGE NondecreasingIndentation, RecordWildCards #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif @@ -70,14 +70,12 @@ import qualified System.Posix.Internals as Base import Foreign import Foreign.C -#ifdef __GLASGOW_HASKELL__ import GHC.IO.Handle.Internals import GHC.IO.Handle.Types import qualified GHC.IO.FD as FD import qualified GHC.IO.Handle.FD as FD import GHC.IO.Exception import Data.Typeable (cast) -#endif #include "HsUnix.h" @@ -206,8 +204,8 @@ handleToFd :: Handle -> IO Fd -- | Converts an 'Fd' into a 'Handle' that can be used with the -- standard Haskell IO library (see "System.IO"). fdToHandle :: Fd -> IO Handle +fdToHandle fd = FD.fdToHandle (fromIntegral fd) -#ifdef __GLASGOW_HASKELL__ handleToFd h@(FileHandle _ m) = do withHandle' "handleToFd" h m $ handleToFd' h handleToFd h@(DuplexHandle _ r w) = do @@ -231,8 +229,6 @@ handleToFd' h h_@Handle__{haType=_,..} = do FD.release fd return (Handle__{haType=ClosedHandle,..}, Fd (FD.fdFD fd)) -fdToHandle fd = FD.fdToHandle (fromIntegral fd) -#endif -- ----------------------------------------------------------------------------- -- Fd options diff --git a/System/Posix/Process.hsc b/System/Posix/Process.hsc index 72da1c6d8c15a442e71630b684471608508b754b..afdb164c6092fa19427059488ae94824ffa91dd8 100644 --- a/System/Posix/Process.hsc +++ b/System/Posix/Process.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- @@ -22,10 +22,8 @@ module System.Posix.Process ( -- * Processes -- ** Forking and executing -#ifdef __GLASGOW_HASKELL__ forkProcess, forkProcessWithUnmask, -#endif executeFile, -- ** Exiting diff --git a/System/Posix/Process/ByteString.hsc b/System/Posix/Process/ByteString.hsc index 64fc71ee6c23418a31163114c42dee42bba57737..39da5ba470923925bb521f0ca2b3e84920d2f858 100644 --- a/System/Posix/Process/ByteString.hsc +++ b/System/Posix/Process/ByteString.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif @@ -23,10 +23,8 @@ module System.Posix.Process.ByteString ( -- * Processes -- ** Forking and executing -#ifdef __GLASGOW_HASKELL__ forkProcess, forkProcessWithUnmask, -#endif executeFile, -- ** Exiting diff --git a/System/Posix/Process/Common.hsc b/System/Posix/Process/Common.hsc index d0d2b093390d908f57424ee39cf0652ef2dde59b..59212e4308f0081e699200a2f4d767817d1c9d2b 100644 --- a/System/Posix/Process/Common.hsc +++ b/System/Posix/Process/Common.hsc @@ -1,8 +1,7 @@ {-# LANGUAGE CApiFFI #-} {-# LANGUAGE InterruptibleFFI, RankNTypes #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Process.Common @@ -22,10 +21,8 @@ module System.Posix.Process.Common ( -- * Processes -- ** Forking and executing -#ifdef __GLASGOW_HASKELL__ forkProcess, forkProcessWithUnmask, -#endif -- ** Exiting exitImmediately, @@ -82,11 +79,9 @@ import System.Posix.Process.Internals import System.Posix.Types import Control.Monad -#ifdef __GLASGOW_HASKELL__ import Control.Exception.Base ( bracket, getMaskingState, MaskingState(..) ) -- used by forkProcess import GHC.TopHandler ( runIO ) import GHC.IO ( unsafeUnmask, uninterruptibleMask_ ) -#endif -- ----------------------------------------------------------------------------- -- Process environment @@ -271,7 +266,6 @@ foreign import ccall unsafe "setpriority" -- ----------------------------------------------------------------------------- -- Forking, execution -#ifdef __GLASGOW_HASKELL__ {- | 'forkProcess' corresponds to the POSIX @fork@ system call. The 'IO' action passed as an argument is executed in the child process; no other threads will be copied to the child process. @@ -311,8 +305,6 @@ foreign import ccall "forkProcess" forkProcessPrim :: StablePtr (IO ()) -> IO CP forkProcessWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ProcessID forkProcessWithUnmask action = forkProcess (action unsafeUnmask) -#endif /* __GLASGOW_HASKELL__ */ - -- ----------------------------------------------------------------------------- -- Waiting for process termination diff --git a/System/Posix/Process/Internals.hs b/System/Posix/Process/Internals.hs index 970bc9fbd448efe3762dd3b92cfecebbb61fab03..fd0e68d1f7258e973828a1955cdd68644ce22c32 100644 --- a/System/Posix/Process/Internals.hs +++ b/System/Posix/Process/Internals.hs @@ -1,8 +1,6 @@ {-# LANGUAGE CApiFFI #-} {-# LANGUAGE CPP #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} -#endif module System.Posix.Process.Internals ( pPrPr_disableITimers, c_execvpe, diff --git a/System/Posix/Resource.hsc b/System/Posix/Resource.hsc index 280c25fbc54c176b04575b0c7f390df3800c3bff..3418ecf8564aa52bba5d6f373df093e6898d481c 100644 --- a/System/Posix/Resource.hsc +++ b/System/Posix/Resource.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/Semaphore.hsc b/System/Posix/Semaphore.hsc index 02959ae996cd4557094cd12300ccb9f6f410cc45..12db9240ad4fdd25b74ace2dc85d71789c45ee33 100644 --- a/System/Posix/Semaphore.hsc +++ b/System/Posix/Semaphore.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/SharedMem.hsc b/System/Posix/SharedMem.hsc index ff43b9775ebce5e819fcd510f81ebd62c900128c..a6326a72f8c59fc61d36cf1c2182f84600379a76 100644 --- a/System/Posix/SharedMem.hsc +++ b/System/Posix/SharedMem.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc index e8fc1c50da7c13da9a3fc392b173f67e55aeafd0..222911ad3d3aa86559c495a0982663cdcb92215b 100644 --- a/System/Posix/Signals.hsc +++ b/System/Posix/Signals.hsc @@ -1,8 +1,6 @@ {-# LANGUAGE CApiFFI, CPP, DeriveDataTypeable, NondecreasingIndentation #-} {-# OPTIONS_GHC -fno-cse #-} -- global variables -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} -#endif ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Signals @@ -66,12 +64,10 @@ module System.Posix.Signals ( signalProcess, signalProcessGroup, -#ifdef __GLASGOW_HASKELL__ -- * Handling signals Handler(Default,Ignore,Catch,CatchOnce,CatchInfo,CatchInfoOnce), SignalInfo(..), SignalSpecificInfo(..), installHandler, -#endif -- * Signal sets SignalSet, @@ -88,10 +84,8 @@ module System.Posix.Signals ( getPendingSignals, awaitSignal, -#ifdef __GLASGOW_HASKELL__ -- * The @NOCLDSTOP@ flag setStoppedChildFlag, queryStoppedChildFlag, -#endif -- MISSING FUNCTIONALITY: -- sigaction(), (inc. the sigaction structure + flags etc.) @@ -114,11 +108,9 @@ import System.Posix.Process import System.Posix.Process.Internals import Data.Dynamic -#ifdef __GLASGOW_HASKELL__ ##include "rts/Signals.h" import GHC.Conc hiding (Signal) -#endif -- ----------------------------------------------------------------------------- -- Specific signals @@ -298,7 +290,7 @@ foreign import ccall unsafe "killpg" raiseSignal :: Signal -> IO () raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig) -#if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(darwin_HOST_OS)) +#if (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(darwin_HOST_OS)) foreign import ccall unsafe "genericRaise" c_raise :: CInt -> IO CInt #else @@ -306,9 +298,8 @@ foreign import ccall unsafe "raise" c_raise :: CInt -> IO CInt #endif -#ifdef __GLASGOW_HASKELL__ -type Signal = CInt +type Signal = CInt -- | The actions to perform when a signal is received. data Handler = Default @@ -448,7 +439,6 @@ unmarshalSigInfo fp = do siginfoSpecific = extra } #endif /* !__PARALLEL_HASKELL__ */ -#endif /* __GLASGOW_HASKELL__ */ -- ----------------------------------------------------------------------------- -- Alarms @@ -463,7 +453,6 @@ scheduleAlarm secs = do foreign import ccall unsafe "alarm" c_alarm :: CUInt -> IO CUInt -#ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- The NOCLDSTOP flag @@ -482,7 +471,6 @@ queryStoppedChildFlag :: IO Bool queryStoppedChildFlag = do rc <- peek nocldstop return (rc == (0::Int)) -#endif /* __GLASGOW_HASKELL__ */ -- ----------------------------------------------------------------------------- -- Manipulating signal sets diff --git a/System/Posix/Signals/Exts.hsc b/System/Posix/Signals/Exts.hsc index 95796a23dacd5f7a03be53b38683bf5c555ee96d..3634277b8d6b98d0706c340d6745e5a3f030649a 100644 --- a/System/Posix/Signals/Exts.hsc +++ b/System/Posix/Signals/Exts.hsc @@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Safe #-} -#endif ----------------------------------------------------------------------------- -- | diff --git a/System/Posix/Temp.hsc b/System/Posix/Temp.hsc index 2d7ca52c048275afaa1ad403bb28d5c87414d070..473364c8b075ee7c67bb82776c98e4d856195984 100644 --- a/System/Posix/Temp.hsc +++ b/System/Posix/Temp.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- @@ -33,10 +33,8 @@ import System.Posix.IO import System.Posix.Types import System.Posix.Internals (withFilePath, peekFilePath) -#if defined(__GLASGOW_HASKELL__) foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" c_mkstemp :: CString -> IO CInt -#endif -- | Make a unique filename and open it for reading\/writing. The returned -- 'FilePath' is the (possibly relative) path of the created file, which is @@ -48,17 +46,11 @@ foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" mkstemp :: String -> IO (FilePath, Handle) mkstemp template' = do let template = template' ++ "XXXXXX" -#if defined(__GLASGOW_HASKELL__) withFilePath template $ \ ptr -> do fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr) name <- peekFilePath ptr h <- fdToHandle (Fd fd) return (name, h) -#else - name <- mktemp template - h <- openFile name ReadWriteMode - return (name, h) -#endif #if HAVE_MKSTEMPS foreign import ccall unsafe "HsUnix.h __hscore_mkstemps" @@ -114,7 +106,7 @@ mkdtemp template' = do return name #endif -#if !defined(__GLASGOW_HASKELL__) || !HAVE_MKDTEMP +#if !HAVE_MKDTEMP foreign import ccall unsafe "mktemp" c_mktemp :: CString -> IO CString diff --git a/System/Posix/Temp/ByteString.hsc b/System/Posix/Temp/ByteString.hsc index 84ad49ed4f740c57748d98a909e88c2ef9ca5c93..67442fc36c44f0a481630178aa3a61b795254f01 100644 --- a/System/Posix/Temp/ByteString.hsc +++ b/System/Posix/Temp/ByteString.hsc @@ -1,6 +1,6 @@ #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- @@ -38,10 +38,8 @@ import System.Posix.Directory (createDirectory) import System.Posix.IO import System.Posix.Types -#if defined(__GLASGOW_HASKELL__) foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" c_mkstemp :: CString -> IO CInt -#endif -- | Make a unique filename and open it for reading\/writing. The returned -- 'RawFilePath' is the (possibly relative) path of the created file, which is @@ -53,17 +51,11 @@ foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" mkstemp :: ByteString -> IO (RawFilePath, Handle) mkstemp template' = do let template = template' `B.append` (BC.pack "XXXXXX") -#if defined(__GLASGOW_HASKELL__) withFilePath template $ \ ptr -> do fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr) name <- peekFilePath ptr h <- fdToHandle (Fd fd) return (name, h) -#else - name <- mktemp template - h <- openFile (BC.unpack name) ReadWriteMode - return (name, h) -#endif #if HAVE_MKSTEMPS foreign import ccall unsafe "HsUnix.h __hscore_mkstemps" @@ -114,7 +106,7 @@ mkdtemp template' = do return name #endif -#if !defined(__GLASGOW_HASKELL__) || !HAVE_MKDTEMP +#if !HAVE_MKDTEMP foreign import ccall unsafe "mktemp" c_mktemp :: CString -> IO CString diff --git a/System/Posix/Terminal.hsc b/System/Posix/Terminal.hsc index 88bd93fab5c3663b1721146891d801c6213b2f7b..c1b3ff835de7e135df6ba42302288a37f7d68d84 100644 --- a/System/Posix/Terminal.hsc +++ b/System/Posix/Terminal.hsc @@ -1,7 +1,7 @@ {-# LANGUAGE CApiFFI #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/Terminal/ByteString.hsc b/System/Posix/Terminal/ByteString.hsc index 3c7abfbe54314db0a46b878619bc1a09a8a24066..d98a9c002878867ed99a54984e0633b64ccfe2dc 100644 --- a/System/Posix/Terminal/ByteString.hsc +++ b/System/Posix/Terminal/ByteString.hsc @@ -1,7 +1,7 @@ {-# LANGUAGE CApiFFI #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc index 5d81ec549026ca02a8b6f22227cf76526b3604b8..573df16c11784cffcf404b9aabffc8d6827f6b5f 100644 --- a/System/Posix/Terminal/Common.hsc +++ b/System/Posix/Terminal/Common.hsc @@ -1,7 +1,6 @@ {-# LANGUAGE CApiFFI #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Terminal.Common diff --git a/System/Posix/Time.hs b/System/Posix/Time.hs index 7a2232f6094b2dccb36d46739428625c11306537..b6ed885c0a63d9a7ccb84effc454d7aeaf3eeb87 100644 --- a/System/Posix/Time.hs +++ b/System/Posix/Time.hs @@ -2,7 +2,7 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff --git a/System/Posix/Unistd.hsc b/System/Posix/Unistd.hsc index 7f791138a5932455d72b266835e802f7594ba5d9..84bd4729f574430be743ec2e0ddb13557f5cc1e0 100644 --- a/System/Posix/Unistd.hsc +++ b/System/Posix/Unistd.hsc @@ -2,7 +2,7 @@ {-# LANGUAGE NondecreasingIndentation #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 703 +#else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- @@ -118,9 +118,7 @@ sleep :: Int -> IO Int sleep 0 = return 0 sleep secs = do r <- c_sleep (fromIntegral secs); return (fromIntegral r) -#ifdef __GLASGOW_HASKELL__ {-# WARNING sleep "This function has several shortcomings (see documentation). Please consider using Control.Concurrent.threadDelay instead." #-} -#endif foreign import ccall safe "sleep" c_sleep :: CUInt -> IO CUInt diff --git a/System/Posix/User.hsc b/System/Posix/User.hsc index 3e1138948d6abe1fc27737425dfd78ec0c2c8ea6..01a417d02dfae7f7de8319a357061b6415b9b5cf 100644 --- a/System/Posix/User.hsc +++ b/System/Posix/User.hsc @@ -1,6 +1,4 @@ -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy, CApiFFI #-} -#endif ----------------------------------------------------------------------------- -- | -- Module : System.Posix.User