diff options
author | Herbert Valerio Riedel <hvr@gnu.org> | 2014-09-18 23:05:35 +0200 |
---|---|---|
committer | Herbert Valerio Riedel <hvr@gnu.org> | 2014-09-18 23:07:35 +0200 |
commit | eae19112462fe77a3f1298bff12b409b205a581d (patch) | |
tree | 1cf7c44ad1e064a34b0eebb74a996e58ad3b440f /libraries | |
parent | 8b9083655f34120b47fe407123272e0687e0bd60 (diff) | |
download | haskell-eae19112462fe77a3f1298bff12b409b205a581d.tar.gz |
Move `when` to GHC.Base
This allows several modules to avoid importing Control.Monad and thus break
import cycles that manifest themselves when implementing #9586
Reviewed By: austin, ekmett
Differential Revision: https://phabricator.haskell.org/D222
Diffstat (limited to 'libraries')
26 files changed, 27 insertions, 50 deletions
diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs index e5a0ebfe20..9ab209e5d5 100644 --- a/libraries/base/Control/Concurrent.hs +++ b/libraries/base/Control/Concurrent.hs @@ -119,7 +119,6 @@ import GHC.Base import System.Posix.Types ( Fd ) import Foreign.StablePtr import Foreign.C.Types -import Control.Monad #ifdef mingw32_HOST_OS import Foreign.C diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 089e996f47..698d620800 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -303,22 +303,7 @@ replicateM_ :: (Monad m) => Int -> m a -> m () {-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-} replicateM_ n x = sequence_ (replicate n x) -{- | Conditional execution of monadic expressions. For example, - -> when debug (putStr "Debugging\n") - -will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True', -and otherwise do nothing. --} - -when :: (Monad m) => Bool -> m () -> m () -{-# INLINEABLE when #-} -{-# SPECIALISE when :: Bool -> IO () -> IO () #-} -{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} -when p s = if p then s else return () - -- | The reverse of 'when'. - unless :: (Monad m) => Bool -> m () -> m () {-# INLINEABLE unless #-} {-# SPECIALISE unless :: Bool -> IO () -> IO () #-} diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 8407c6f1ba..c6ee6f0f04 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -107,7 +107,7 @@ module Data.Data ( ------------------------------------------------------------------------------ -import Control.Monad +import Control.Monad ( MonadPlus(..) ) import Data.Either import Data.Eq import Data.Maybe diff --git a/libraries/base/Data/Functor.hs b/libraries/base/Data/Functor.hs index f769d52446..00cc254a8b 100644 --- a/libraries/base/Data/Functor.hs +++ b/libraries/base/Data/Functor.hs @@ -23,7 +23,7 @@ module Data.Functor void, ) where -import Control.Monad +import Control.Monad ( void ) import GHC.Base ( Functor(..), flip ) infixl 4 <$> diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index 19e9d477e6..227b6ba038 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -52,7 +52,6 @@ module Data.Traversable ( ) where import Control.Applicative -import Control.Monad ( Monad(..) ) import qualified Control.Monad import Data.Either import Data.Foldable ( Foldable ) @@ -62,7 +61,7 @@ import Data.Monoid ( Monoid ) import Data.Proxy import GHC.Arr -import GHC.Base ( ($), (.), id, flip ) +import GHC.Base ( ($), (.), Monad(..), id, flip ) import qualified GHC.List as List -- | Functors representing data structures that can be traversed from diff --git a/libraries/base/Data/Version.hs b/libraries/base/Data/Version.hs index adc0f125b5..60b85cdf29 100644 --- a/libraries/base/Data/Version.hs +++ b/libraries/base/Data/Version.hs @@ -34,13 +34,12 @@ module Data.Version ( showVersion, parseVersion, ) where -import Control.Monad ( Monad(..), liftM ) import Data.Char ( isDigit, isAlphaNum ) import Data.Eq import Data.List import Data.Ord import Data.Typeable ( Typeable ) -import GHC.Base ( ($), (&&), String, Int ) +import GHC.Base ( ($), (&&), Monad(..), String, Int, liftM ) import GHC.Read import GHC.Show import Text.ParserCombinators.ReadP diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs index 9705e29fdc..ddb19a077d 100644 --- a/libraries/base/Debug/Trace.hs +++ b/libraries/base/Debug/Trace.hs @@ -45,7 +45,6 @@ module Debug.Trace ( ) where import System.IO.Unsafe -import Control.Monad import Foreign.C.String import GHC.Base diff --git a/libraries/base/Foreign/C/Error.hs b/libraries/base/Foreign/C/Error.hs index dbc0b3ec56..b4dddff782 100644 --- a/libraries/base/Foreign/C/Error.hs +++ b/libraries/base/Foreign/C/Error.hs @@ -93,7 +93,7 @@ module Foreign.C.Error ( import Foreign.Ptr import Foreign.C.Types import Foreign.C.String -import Control.Monad ( void ) +import Data.Functor ( void ) import Data.Maybe import GHC.IO diff --git a/libraries/base/Foreign/C/String.hs b/libraries/base/Foreign/C/String.hs index cdbd241db5..e72b620af5 100644 --- a/libraries/base/Foreign/C/String.hs +++ b/libraries/base/Foreign/C/String.hs @@ -102,8 +102,6 @@ import Foreign.Storable import Data.Word -import Control.Monad - import GHC.Char import GHC.List import GHC.Real diff --git a/libraries/base/Foreign/Marshal/Pool.hs b/libraries/base/Foreign/Marshal/Pool.hs index 8dc57ae753..1488e0ff09 100644 --- a/libraries/base/Foreign/Marshal/Pool.hs +++ b/libraries/base/Foreign/Marshal/Pool.hs @@ -46,7 +46,7 @@ module Foreign.Marshal.Pool ( pooledNewArray0 ) where -import GHC.Base ( Int, Monad(..), (.), not ) +import GHC.Base ( Int, Monad(..), (.), liftM, not ) import GHC.Err ( undefined ) import GHC.Exception ( throw ) import GHC.IO ( IO, mask, catchAny ) @@ -54,7 +54,6 @@ import GHC.IORef ( IORef, newIORef, readIORef, writeIORef ) import GHC.List ( elem, length ) import GHC.Num ( Num(..) ) -import Control.Monad ( liftM ) import Data.List ( delete ) import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free ) import Foreign.Marshal.Array ( pokeArray, pokeArray0 ) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 14a6957454..9d121bd1f7 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -493,6 +493,18 @@ original default. (=<<) :: Monad m => (a -> m b) -> m a -> m b f =<< x = x >>= f +-- | Conditional execution of monadic expressions. For example, +-- +-- > when debug (putStrLn "Debugging") +-- +-- will output the string @Debugging@ if the Boolean value @debug@ +-- is 'True', and otherwise do nothing. +when :: (Monad m) => Bool -> m () -> m () +{-# INLINEABLE when #-} +{-# SPECIALISE when :: Bool -> IO () -> IO () #-} +{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} +when p s = if p then s else return () + -- | Promote a function to a monad. liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r liftM f m1 = do { x1 <- m1; return (f x1) } diff --git a/libraries/base/GHC/Event/Array.hs b/libraries/base/GHC/Event/Array.hs index 3626387669..f0f261e4d5 100644 --- a/libraries/base/GHC/Event/Array.hs +++ b/libraries/base/GHC/Event/Array.hs @@ -24,7 +24,6 @@ module GHC.Event.Array , useAsPtr ) where -import Control.Monad hiding (forM_, empty) import Data.Bits ((.|.), shiftR) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef) import Data.Maybe diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs index 53a9bc86d8..747a416343 100644 --- a/libraries/base/GHC/Event/Control.hs +++ b/libraries/base/GHC/Event/Control.hs @@ -28,7 +28,6 @@ module GHC.Event.Control #include "EventConfig.h" -import Control.Monad (when) import Foreign.ForeignPtr (ForeignPtr) import GHC.Base import GHC.Conc.Signal (Signal) diff --git a/libraries/base/GHC/Event/EPoll.hsc b/libraries/base/GHC/Event/EPoll.hsc index f3d635bb5f..748a1cee4b 100644 --- a/libraries/base/GHC/Event/EPoll.hsc +++ b/libraries/base/GHC/Event/EPoll.hsc @@ -38,7 +38,6 @@ available = False #include <sys/epoll.h> -import Control.Monad (when) import Data.Bits (Bits, FiniteBits, (.|.), (.&.)) import Data.Word (Word32) import Foreign.C.Error (eNOENT, getErrno, throwErrno, diff --git a/libraries/base/GHC/Event/IntTable.hs b/libraries/base/GHC/Event/IntTable.hs index d8cbcc0d45..cb76319e86 100644 --- a/libraries/base/GHC/Event/IntTable.hs +++ b/libraries/base/GHC/Event/IntTable.hs @@ -12,13 +12,12 @@ module GHC.Event.IntTable , updateWith ) where -import Control.Monad ((=<<), liftM, unless, when) import Data.Bits ((.&.), shiftL, shiftR) import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import Data.Maybe (Maybe(..), isJust) +import Data.Maybe (Maybe(..), isJust, isNothing) import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr) import Foreign.Storable (peek, poke) -import GHC.Base (Monad(..), ($), const, otherwise) +import GHC.Base (Monad(..), (=<<), ($), const, liftM, otherwise, when) import GHC.Classes (Eq(..), Ord(..)) import GHC.Event.Arr (Arr) import GHC.Num (Num(..)) @@ -134,7 +133,7 @@ updateWith f k (IntTable ref) = do (fbv, oldVal, newBucket) <- go False `liftM` Arr.read tabArr idx when (isJust oldVal) $ do Arr.write tabArr idx newBucket - unless (isJust fbv) $ + when (isNothing fbv) $ withForeignPtr tabSize $ \ptr -> do size <- peek ptr poke ptr (size - 1) diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs index b6c028a9e1..ea49c0d8cb 100644 --- a/libraries/base/GHC/Event/Manager.hs +++ b/libraries/base/GHC/Event/Manager.hs @@ -52,7 +52,7 @@ module GHC.Event.Manager import Control.Concurrent.MVar (MVar, newMVar, readMVar, putMVar, tryPutMVar, takeMVar, withMVar) import Control.Exception (onException) -import Control.Monad (forM_, when, replicateM, void) +import Control.Monad (forM_, replicateM, void) import Data.Bits ((.&.)) import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) diff --git a/libraries/base/GHC/Event/Poll.hsc b/libraries/base/GHC/Event/Poll.hsc index 686bc711da..b8f8c02aac 100644 --- a/libraries/base/GHC/Event/Poll.hsc +++ b/libraries/base/GHC/Event/Poll.hsc @@ -26,7 +26,6 @@ available = False #include <poll.h> import Control.Concurrent.MVar (MVar, newMVar, swapMVar) -import Control.Monad (unless) import Data.Bits (Bits, FiniteBits, (.|.), (.&.)) import Data.Word import Foreign.C.Types (CInt(..), CShort(..)) @@ -93,7 +92,7 @@ poll p mtout f = do c_pollLoop ptr (fromIntegral len) (fromTimeout tout) Nothing -> c_poll_unsafe ptr (fromIntegral len) 0 - unless (n == 0) $ do + when (n /= 0) $ do A.loop a 0 $ \i e -> do let r = pfdRevents e if r /= 0 diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs index 3d4dc7d405..f74fb7ddc5 100644 --- a/libraries/base/GHC/Event/Thread.hs +++ b/libraries/base/GHC/Event/Thread.hs @@ -16,7 +16,7 @@ module GHC.Event.Thread ) where import Control.Exception (finally, SomeException, toException) -import Control.Monad (forM, forM_, sequence_, zipWithM, when) +import Control.Monad (forM, forM_, sequence_, zipWithM) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.List (zipWith3) import Data.Tuple (snd) diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs index e55dddf82a..bac4685d94 100644 --- a/libraries/base/GHC/Event/TimerManager.hs +++ b/libraries/base/GHC/Event/TimerManager.hs @@ -39,7 +39,7 @@ module GHC.Event.TimerManager -- Imports import Control.Exception (finally) -import Control.Monad (sequence_, when) +import Control.Monad (sequence_) import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) import GHC.Base diff --git a/libraries/base/GHC/Fingerprint.hs b/libraries/base/GHC/Fingerprint.hs index a7568e6bc0..ba890004fa 100644 --- a/libraries/base/GHC/Fingerprint.hs +++ b/libraries/base/GHC/Fingerprint.hs @@ -30,7 +30,6 @@ import GHC.Show import Foreign import Foreign.C import System.IO -import Control.Monad (when) import GHC.Fingerprint.Type diff --git a/libraries/base/GHC/Foreign.hs b/libraries/base/GHC/Foreign.hs index ef64d48572..c4bab8c3b3 100644 --- a/libraries/base/GHC/Foreign.hs +++ b/libraries/base/GHC/Foreign.hs @@ -44,7 +44,6 @@ import Foreign.Storable import Data.Word -- Imports for the locale-encoding version of marshallers -import Control.Monad import Data.Tuple (fst) import Data.Maybe diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 1783125a90..80030b2b78 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -35,7 +35,6 @@ import GHC.Num import GHC.Real import GHC.Show import GHC.Enum -import Control.Monad import Data.Typeable import GHC.IO diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs index 6219670028..776618121f 100644 --- a/libraries/base/GHC/IO/Handle.hs +++ b/libraries/base/GHC/IO/Handle.hs @@ -68,7 +68,7 @@ import GHC.Num import GHC.Real import Data.Maybe import Data.Typeable -import Control.Monad +import Control.Monad ( mapM ) -- --------------------------------------------------------------------------- -- Closing a handle diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs index e53349ac35..118b71e469 100644 --- a/libraries/base/GHC/IO/Handle/Internals.hs +++ b/libraries/base/GHC/IO/Handle/Internals.hs @@ -73,7 +73,6 @@ import GHC.Show import GHC.IORef import GHC.MVar import Data.Typeable -import Control.Monad import Data.Maybe import Foreign.Safe import System.Posix.Internals hiding (FD) diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs index f182e7f382..4191356959 100644 --- a/libraries/base/GHC/IO/Handle/Text.hs +++ b/libraries/base/GHC/IO/Handle/Text.hs @@ -49,7 +49,6 @@ import qualified Control.Exception as Exception import Data.Typeable import System.IO.Error import Data.Maybe -import Control.Monad import GHC.IORef import GHC.Base diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs index 89ef6f47a7..fccd3499bd 100644 --- a/libraries/base/System/Posix/Internals.hs +++ b/libraries/base/System/Posix/Internals.hs @@ -24,9 +24,6 @@ module System.Posix.Internals where #include "HsBaseConfig.h" -#if ! (defined(mingw32_HOST_OS) || defined(__MINGW32__)) -import Control.Monad -#endif import System.Posix.Types import Foreign @@ -323,7 +320,7 @@ setNonBlockingFD fd set = do (c_fcntl_read fd const_f_getfl) let flags' | set = flags .|. o_NONBLOCK | otherwise = flags .&. complement o_NONBLOCK - unless (flags == flags') $ do + when (flags /= flags') $ do -- An error when setting O_NONBLOCK isn't fatal: on some systems -- there are certain file handles on which this will fail (eg. /dev/null -- on FreeBSD) so we throw away the return code from fcntl_write. |