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

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

libraries/base/Control/Monad.hs

@@ -78,26 +78,11 @@ 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
 

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

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,

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)

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

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

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

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

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

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

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

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

testsuite/tests/module/mod176.hs

 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