summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHerbert Valerio Riedel <hvr@gnu.org>2014-09-21 19:14:04 +0200
committerHerbert Valerio Riedel <hvr@gnu.org>2014-09-21 19:14:56 +0200
commit5ed12810e0972b1e0d408fe1355805746c4614f9 (patch)
tree93bef49c2ea5d5e2d67cb1684e14f227a3401c7f
parent835d874df1973b7e1c602a747b42b77095592a9c (diff)
downloadhaskell-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.hs3
-rw-r--r--libraries/base/Control/Monad.hs17
-rw-r--r--libraries/base/Control/Monad/Fix.hs3
-rw-r--r--libraries/base/Data/List.hs2
-rw-r--r--libraries/base/Data/Traversable.hs17
-rw-r--r--libraries/base/GHC/Base.lhs13
-rw-r--r--libraries/base/GHC/Event/Manager.hs7
-rw-r--r--libraries/base/GHC/Event/Thread.hs11
-rw-r--r--libraries/base/GHC/Event/TimerManager.hs2
-rw-r--r--libraries/base/GHC/ForeignPtr.hs2
-rw-r--r--libraries/base/GHC/IO/Handle.hs1
-rw-r--r--libraries/base/Prelude.hs2
-rw-r--r--libraries/base/Text/ParserCombinators/ReadP.hs4
-rw-r--r--testsuite/tests/module/mod176.hs4
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