diff options
author | Herbert Valerio Riedel <hvr@gnu.org> | 2014-09-21 19:14:04 +0200 |
---|---|---|
committer | Herbert Valerio Riedel <hvr@gnu.org> | 2014-09-21 19:14:56 +0200 |
commit | 5ed12810e0972b1e0d408fe1355805746c4614f9 (patch) | |
tree | 93bef49c2ea5d5e2d67cb1684e14f227a3401c7f | |
parent | 835d874df1973b7e1c602a747b42b77095592a9c (diff) | |
download | haskell-5ed12810e0972b1e0d408fe1355805746c4614f9.tar.gz |
Move `mapM` and `sequence` to GHC.Base and break import-cycles
This simplifies the import graph and more importantly removes import
cycles that arise due to `Control.Monad` & `Data.List` importing
`Data.Traversable` (preparation for #9586)
Reviewed By: ekmett, austin
Differential Revision: https://phabricator.haskell.org/D234
-rw-r--r-- | libraries/base/Control/Arrow.hs | 3 | ||||
-rw-r--r-- | libraries/base/Control/Monad.hs | 17 | ||||
-rw-r--r-- | libraries/base/Control/Monad/Fix.hs | 3 | ||||
-rw-r--r-- | libraries/base/Data/List.hs | 2 | ||||
-rw-r--r-- | libraries/base/Data/Traversable.hs | 17 | ||||
-rw-r--r-- | libraries/base/GHC/Base.lhs | 13 | ||||
-rw-r--r-- | libraries/base/GHC/Event/Manager.hs | 7 | ||||
-rw-r--r-- | libraries/base/GHC/Event/Thread.hs | 11 | ||||
-rw-r--r-- | libraries/base/GHC/Event/TimerManager.hs | 2 | ||||
-rw-r--r-- | libraries/base/GHC/ForeignPtr.hs | 2 | ||||
-rw-r--r-- | libraries/base/GHC/IO/Handle.hs | 1 | ||||
-rw-r--r-- | libraries/base/Prelude.hs | 2 | ||||
-rw-r--r-- | libraries/base/Text/ParserCombinators/ReadP.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/module/mod176.hs | 4 |
14 files changed, 42 insertions, 46 deletions
diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs index 0efaa87e69..d5ea9f82be 100644 --- a/libraries/base/Control/Arrow.hs +++ b/libraries/base/Control/Arrow.hs @@ -44,10 +44,9 @@ module Control.Arrow ( import Data.Tuple ( fst, snd, uncurry ) import Data.Either -import Control.Monad import Control.Monad.Fix import Control.Category -import GHC.Base ( Applicative(..), const, ($) ) +import GHC.Base hiding ( (.), id ) infixr 5 <+> infixr 3 *** diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index eb00939f42..c04c4a8f4d 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -78,27 +78,12 @@ module Control.Monad import Data.Foldable ( sequence_, msum, mapM_, forM_ ) import Data.Functor ( void ) +import Data.Traversable () import GHC.Base import GHC.List ( zipWith, unzip, replicate ) -- ----------------------------------------------------------------------------- --- Prelude monad functions - --- | Evaluate each action in the sequence from left to right, --- and collect the results. -sequence :: Monad m => [m a] -> m [a] -{-# INLINE sequence #-} -sequence ms = foldr k (return []) ms - where - k m m' = do { x <- m; xs <- m'; return (x:xs) } - --- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@. -mapM :: Monad m => (a -> m b) -> [a] -> m [b] -{-# INLINE mapM #-} -mapM f as = sequence (map f as) - --- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude -- | @'guard' b@ is @'return' ()@ if @b@ is 'True', diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs index 56e249c746..98aaa2682b 100644 --- a/libraries/base/Control/Monad/Fix.hs +++ b/libraries/base/Control/Monad/Fix.hs @@ -23,11 +23,10 @@ module Control.Monad.Fix ( fix ) where -import Control.Monad ( Monad ) import Data.Either import Data.Function ( fix ) import Data.Maybe -import GHC.Base ( error, (.) ) +import GHC.Base ( Monad, error, (.) ) import GHC.List ( head, tail ) import GHC.ST import System.IO diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index 5bc812194a..e742cac97b 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -208,6 +208,8 @@ module Data.List ) where import Data.Foldable +import Data.Traversable () + import Data.OldList hiding ( all, and, any, concat, concatMap, elem, find, foldl, foldl1, foldl', foldr, foldr1, maximum, maximumBy, minimum, minimumBy, notElem, or, diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index 227b6ba038..d050aeaf4d 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -51,18 +51,17 @@ module Data.Traversable ( foldMapDefault, ) where -import Control.Applicative -import qualified Control.Monad -import Data.Either +import Control.Applicative ( Const(..), WrappedMonad(..) ) +import Data.Either ( Either(..) ) import Data.Foldable ( Foldable ) import Data.Functor -import Data.Maybe -import Data.Monoid ( Monoid ) -import Data.Proxy +import Data.Proxy ( Proxy(..) ) import GHC.Arr -import GHC.Base ( ($), (.), Monad(..), id, flip ) -import qualified GHC.List as List +import GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..), + ($), (.), id, flip ) +import qualified GHC.Base as Monad ( mapM ) +import qualified GHC.List as List ( foldr ) -- | Functors representing data structures that can be traversed from -- left to right. @@ -182,7 +181,7 @@ instance Traversable [] where traverse f = List.foldr cons_f (pure []) where cons_f x ys = (:) <$> f x <*> ys - mapM = Control.Monad.mapM + mapM = Monad.mapM instance Traversable (Either a) where traverse _ (Left x) = pure (Left x) diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index 70f589729e..d8eb3e690f 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -505,6 +505,19 @@ when :: (Monad m) => Bool -> m () -> m () {-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} when p s = if p then s else return () +-- | Evaluate each action in the sequence from left to right, +-- and collect the results. +sequence :: Monad m => [m a] -> m [a] +{-# INLINE sequence #-} +sequence ms = foldr k (return []) ms + where + k m m' = do { x <- m; xs <- m'; return (x:xs) } + +-- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@. +mapM :: Monad m => (a -> m b) -> [a] -> m [b] +{-# INLINE mapM #-} +mapM f as = sequence (map f as) + -- | 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/Manager.hs b/libraries/base/GHC/Event/Manager.hs index ea49c0d8cb..20413792db 100644 --- a/libraries/base/GHC/Event/Manager.hs +++ b/libraries/base/GHC/Event/Manager.hs @@ -52,8 +52,9 @@ module GHC.Event.Manager import Control.Concurrent.MVar (MVar, newMVar, readMVar, putMVar, tryPutMVar, takeMVar, withMVar) import Control.Exception (onException) -import Control.Monad (forM_, replicateM, void) import Data.Bits ((.&.)) +import Data.Foldable (forM_) +import Data.Functor (void) import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) import Data.Maybe (maybe) @@ -61,7 +62,7 @@ import GHC.Arr (Array, (!), listArray) import GHC.Base import GHC.Conc.Signal (runHandlers) import GHC.Conc.Sync (yield) -import GHC.List (filter) +import GHC.List (filter, replicate) import GHC.Num (Num(..)) import GHC.Real (fromIntegral) import GHC.Show (Show(..)) @@ -192,6 +193,8 @@ newWith oneShot be = do registerControlFd mgr (controlReadFd ctrl) evtRead registerControlFd mgr (wakeupReadFd ctrl) evtRead return mgr + where + replicateM n x = sequence (replicate n x) failOnInvalidFile :: String -> Fd -> IO Bool -> IO () failOnInvalidFile loc fd m = do diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs index 6fe76895ad..482e41f172 100644 --- a/libraries/base/GHC/Event/Thread.hs +++ b/libraries/base/GHC/Event/Thread.hs @@ -16,14 +16,14 @@ module GHC.Event.Thread ) where import Control.Exception (finally, SomeException, toException) -import Control.Monad (forM, forM_, sequence_, zipWithM) +import Data.Foldable (forM_, mapM_, sequence_) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) import Foreign.C.Types (CInt(..), CUInt(..)) import Foreign.Ptr (Ptr) import GHC.Base -import GHC.List (zipWith3) +import GHC.List (zipWith, zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, @@ -99,15 +99,16 @@ closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. closeFdWith close fd = do eventManagerArray <- readIORef eventManager let (low, high) = boundsIOArray eventManagerArray - mgrs <- forM [low..high] $ \i -> do + mgrs <- flip mapM [low..high] $ \i -> do Just (_,!mgr) <- readIOArray eventManagerArray i return mgr mask_ $ do - tables <- forM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd + tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp + zipWithM f xs ys = sequence (zipWith f xs ys) threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do @@ -244,7 +245,7 @@ startIOManagerThreads = withMVar ioManagerLock $ \_ -> do eventManagerArray <- readIORef eventManager let (_, high) = boundsIOArray eventManagerArray - forM_ [0..high] (startIOManagerThread eventManagerArray) + mapM_ (startIOManagerThread eventManagerArray) [0..high] writeIORef numEnabledEventManagers (high+1) show_int :: Int -> String diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs index bac4685d94..bf6339a4d8 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_) +import Data.Foldable (sequence_) import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) import GHC.Base diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index fe7293e41e..7943ef44d6 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -44,8 +44,8 @@ module GHC.ForeignPtr finalizeForeignPtr ) where -import Control.Monad ( sequence_ ) import Foreign.Storable +import Data.Foldable ( sequence_ ) import Data.Typeable import GHC.Show diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs index 776618121f..5a8d570642 100644 --- a/libraries/base/GHC/IO/Handle.hs +++ b/libraries/base/GHC/IO/Handle.hs @@ -68,7 +68,6 @@ import GHC.Num import GHC.Real import Data.Maybe import Data.Typeable -import Control.Monad ( mapM ) -- --------------------------------------------------------------------------- -- Closing a handle diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs index 72100d64f9..854456a3db 100644 --- a/libraries/base/Prelude.hs +++ b/libraries/base/Prelude.hs @@ -148,7 +148,7 @@ import Data.Maybe import Data.Traversable ( Traversable ) import Data.Tuple -import GHC.Base hiding ( foldr ) +import GHC.Base hiding ( foldr, mapM, sequence ) import Text.Read import GHC.Enum import GHC.Num diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs index 0139e7733d..48cbe57e5d 100644 --- a/libraries/base/Text/ParserCombinators/ReadP.hs +++ b/libraries/base/Text/ParserCombinators/ReadP.hs @@ -310,10 +310,6 @@ count :: Int -> ReadP a -> ReadP [a] -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of -- results is returned. count n p = sequence (replicate n p) - where -- local 'sequence' to avoid import-cycle - sequence ms = foldr k (return []) ms - where - k m m' = do { x <- m; xs <- m'; return (x:xs) } between :: ReadP open -> ReadP close -> ReadP a -> ReadP a -- ^ @between open close p@ parses @open@, followed by @p@ and finally diff --git a/testsuite/tests/module/mod176.hs b/testsuite/tests/module/mod176.hs index 250711345c..3a7419c355 100644 --- a/testsuite/tests/module/mod176.hs +++ b/testsuite/tests/module/mod176.hs @@ -1,10 +1,10 @@ module ShouldCompile where import Prelude () -import Control.Monad( Monad(return), mapM ) +import Control.Monad( Monad(return), unless ) -- Should report Monad and return as unused imports import GHC.Base -- But not their import from here x = True -y x = mapM +y x = unless |