Commit a94dc4c3 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺
Browse files

Move Applicative/MonadPlus into GHC.Base

This is necessary in order to invert the import-dependency between
Data.Foldable and Control.Monad (for addressing #9586)

This also updates the `binary` submodule to qualify a GHC.Base import

Reviewed By: austin

Differential Revision: https://phabricator.haskell.org/D223
parent eae19112
......@@ -49,18 +49,15 @@ module Control.Applicative (
import Control.Category
import Control.Arrow
import Control.Monad (liftM, ap, Monad(..), MonadPlus(..), Alternative(..))
import Data.Functor ((<$>), (<$))
import Data.Maybe
import Data.Monoid (Monoid(..))
import Data.Tuple
import Data.Eq
import Data.Ord
import Data.Functor (Functor(..))
import Data.Functor ((<$>))
import GHC.Base (const, Applicative(..),liftA, liftA2, liftA3, (<**>))
import GHC.Base hiding ((.), id)
import GHC.Generics
import GHC.List (map, repeat, zipWith)
import GHC.List (repeat, zipWith)
import GHC.Read (Read)
import GHC.Show (Show)
......
......@@ -81,8 +81,6 @@ import Data.Maybe
import GHC.List
import GHC.Base
infixl 3 <|>
-- -----------------------------------------------------------------------------
-- Prelude monad functions
......@@ -110,76 +108,6 @@ mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
{-# INLINE mapM_ #-}
mapM_ f as = sequence_ (map f as)
-- -----------------------------------------------------------------------------
-- The Alternative class definition
-- | A monoid on applicative functors.
--
-- Minimal complete definition: 'empty' and '<|>'.
--
-- If defined, 'some' and 'many' should be the least solutions
-- of the equations:
--
-- * @some v = (:) '<$>' v '<*>' many v@
--
-- * @many v = some v '<|>' 'pure' []@
class Applicative f => Alternative f where
-- | The identity of '<|>'
empty :: f a
-- | An associative binary operation
(<|>) :: f a -> f a -> f a
-- | One or more.
some :: f a -> f [a]
some v = some_v
where
many_v = some_v <|> pure []
some_v = (fmap (:) v) <*> many_v
-- | Zero or more.
many :: f a -> f [a]
many v = many_v
where
many_v = some_v <|> pure []
some_v = (fmap (:) v) <*> many_v
instance Alternative Maybe where
empty = Nothing
Nothing <|> r = r
l <|> _ = l
instance Alternative [] where
empty = []
(<|>) = (++)
-- -----------------------------------------------------------------------------
-- The MonadPlus class definition
-- | Monads that also support choice and failure.
class (Alternative m, Monad m) => MonadPlus m where
-- | the identity of 'mplus'. It should also satisfy the equations
--
-- > mzero >>= f = mzero
-- > v >> mzero = mzero
--
mzero :: m a
mzero = empty
-- | an associative operation
mplus :: m a -> m a -> m a
mplus = (<|>)
instance MonadPlus [] where
mzero = []
mplus = (++)
instance MonadPlus Maybe where
mzero = Nothing
Nothing `mplus` ys = ys
xs `mplus` _ys = xs
-- -----------------------------------------------------------------------------
-- Functions mandated by the Prelude
......
......@@ -107,7 +107,6 @@ module Data.Data (
------------------------------------------------------------------------------
import Control.Monad ( MonadPlus(..) )
import Data.Either
import Data.Eq
import Data.Maybe
......
......@@ -58,8 +58,7 @@ module Data.Foldable (
find
) where
import Control.Applicative
import Control.Monad ( Monad(..), MonadPlus(..) )
import Control.Applicative ( Const )
import Data.Bool
import Data.Either
import Data.Eq
......@@ -70,8 +69,7 @@ import Data.Ord
import Data.Proxy
import GHC.Arr ( Array(..), Ix(..), elems )
import GHC.Base ( (.), ($!), error, flip, id )
import GHC.Exts ( build )
import GHC.Base hiding ( foldr )
import GHC.Num ( Num(..) )
-- | Data structures that can be folded.
......
......@@ -74,8 +74,6 @@ import Text.ParserCombinators.ReadPrec ( ReadPrec )
import GHC.Float ( FFFormat, RealFloat, Floating )
import Data.Bits ( Bits, FiniteBits )
import GHC.Enum ( Bounded, Enum )
import Control.Monad ( MonadPlus )
-- import Data.Int
import GHC.Fingerprint.Type
import {-# SOURCE #-} GHC.Fingerprint
......@@ -422,9 +420,12 @@ deriving instance Typeable Ix
deriving instance Typeable Show
deriving instance Typeable Read
deriving instance Typeable Alternative
deriving instance Typeable Applicative
deriving instance Typeable Functor
deriving instance Typeable Monad
deriving instance Typeable MonadPlus
deriving instance Typeable Monoid
deriving instance Typeable Typeable
......
......@@ -598,6 +598,69 @@ instance Monad Maybe where
return = Just
fail _ = Nothing
-- -----------------------------------------------------------------------------
-- The Alternative class definition
infixl 3 <|>
-- | A monoid on applicative functors.
--
-- Minimal complete definition: 'empty' and '<|>'.
--
-- If defined, 'some' and 'many' should be the least solutions
-- of the equations:
--
-- * @some v = (:) '<$>' v '<*>' many v@
--
-- * @many v = some v '<|>' 'pure' []@
class Applicative f => Alternative f where
-- | The identity of '<|>'
empty :: f a
-- | An associative binary operation
(<|>) :: f a -> f a -> f a
-- | One or more.
some :: f a -> f [a]
some v = some_v
where
many_v = some_v <|> pure []
some_v = (fmap (:) v) <*> many_v
-- | Zero or more.
many :: f a -> f [a]
many v = many_v
where
many_v = some_v <|> pure []
some_v = (fmap (:) v) <*> many_v
instance Alternative Maybe where
empty = Nothing
Nothing <|> r = r
l <|> _ = l
-- -----------------------------------------------------------------------------
-- The MonadPlus class definition
-- | Monads that also support choice and failure.
class (Alternative m, Monad m) => MonadPlus m where
-- | the identity of 'mplus'. It should also satisfy the equations
--
-- > mzero >>= f = mzero
-- > v >> mzero = mzero
--
mzero :: m a
mzero = empty
-- | an associative operation
mplus :: m a -> m a -> m a
mplus = (<|>)
instance MonadPlus Maybe where
mzero = Nothing
Nothing `mplus` ys = ys
xs `mplus` _ys = xs
\end{code}
......@@ -620,6 +683,14 @@ instance Monad [] where
m >> k = foldr ((++) . (\ _ -> k)) [] m
return x = [x]
fail _ = []
instance Alternative [] where
empty = []
(<|>) = (++)
instance MonadPlus [] where
mzero = []
mplus = (++)
\end{code}
A few list functions that appear here because they are used here.
......
......@@ -100,7 +100,6 @@ import Data.Typeable
#ifndef mingw32_HOST_OS
import Data.Dynamic
#endif
import Control.Monad
import Data.Maybe
import GHC.Base
......
......@@ -28,7 +28,7 @@ module GHC.Enum(
) where
import GHC.Base
import GHC.Base hiding ( many )
import GHC.Char
import GHC.Integer
import GHC.Num
......
......@@ -31,7 +31,7 @@ import Foreign.C.Types (CSize(..))
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Foreign.Storable (Storable(..))
import GHC.Base
import GHC.Base hiding (empty)
import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_)
import GHC.Num (Num(..))
import GHC.Real (fromIntegral)
......
......@@ -88,7 +88,7 @@ module GHC.Event.PSQ
, atMost
) where
import GHC.Base
import GHC.Base hiding (empty)
import GHC.Num (Num(..))
import GHC.Show (Show(showsPrec))
import GHC.Event.Unique (Unique)
......
......@@ -310,10 +310,6 @@ annotateIOError :: IOError
annotateIOError ioe loc hdl path =
ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,
ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe }
where
mplus :: Maybe a -> Maybe a -> Maybe a
Nothing `mplus` ys = ys
xs `mplus` _ = xs
-- | The 'catchIOError' function establishes a handler that receives any
-- 'IOError' raised in the action protected by 'catchIOError'.
......
......@@ -72,10 +72,10 @@ module Text.ParserCombinators.ReadP
)
where
import Control.Monad ( Alternative(empty, (<|>)), MonadPlus(..), sequence )
import Control.Monad ( sequence )
import {-# SOURCE #-} GHC.Unicode ( isSpace )
import GHC.List ( replicate, null )
import GHC.Base
import GHC.Base hiding ( many )
infixr 5 +++, <++
......
......@@ -61,7 +61,6 @@ import qualified Text.ParserCombinators.ReadP as ReadP
, pfail
)
import Control.Monad( MonadPlus(..), Alternative(..) )
import GHC.Num( Num(..) )
import GHC.Base
......
Subproject commit 2647d42f19bedae46c020fc3af029073f5690d5b
Subproject commit f5f6fe72bd069a2b56dd52e645aad406c6195526
......@@ -14,7 +14,7 @@ c2 :: (C a b, N b, S b) => a -> b
c3 :: C a b => forall a. a -> b
c4 :: C a b => forall a1. a1 -> b
-- imported via Control.Monad
class (Control.Monad.Alternative m, Monad m) =>
class (GHC.Base.Alternative m, Monad m) =>
MonadPlus (m :: * -> *) where
mzero :: m a
mplus :: m a -> m a -> m a
......
class (Control.Monad.Alternative m, GHC.Base.Monad m) =>
Control.Monad.MonadPlus (m :: * -> *) where
class (GHC.Base.Alternative m, GHC.Base.Monad m) =>
GHC.Base.MonadPlus (m :: * -> *) where
...
mplus :: m a -> m a -> m a
class (Control.Monad.Alternative m, GHC.Base.Monad m) =>
Control.Monad.MonadPlus (m :: * -> *) where
class (GHC.Base.Alternative m, GHC.Base.Monad m) =>
GHC.Base.MonadPlus (m :: * -> *) where
...
Control.Monad.mplus :: m a -> m a -> m a
......@@ -2,7 +2,7 @@
module T5359a (linesT) where
import GHC.Base
import GHC.Base hiding (empty)
import GHC.Word
import GHC.ST (ST(..), runST)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment