summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHerbert Valerio Riedel <hvr@gnu.org>2015-10-08 16:34:17 +0200
committerHerbert Valerio Riedel <hvr@gnu.org>2015-10-08 16:34:17 +0200
commite5ae9ca83fada89652ae9989fa66b09a5a578c76 (patch)
tree431850660b8bb1472c4ca43c3407c446101bd37d
parentf64f7c36ef9395da1cc7b686aaf1b019204cd0fc (diff)
downloadhaskell-wip/base-amp-normalisation.tar.gz
base: MRP-refactoring of AMP instanceswip/base-amp-normalisation
This refactors (>>)/(*>)/return/pure methods into normalform. The redundant explicit `return` method definitions are dropped altogether.
-rw-r--r--libraries/base/Control/Applicative.hs2
-rw-r--r--libraries/base/Control/Arrow.hs1
-rw-r--r--libraries/base/Control/Monad/ST/Lazy/Imp.hs4
-rw-r--r--libraries/base/Data/Complex.hs1
-rw-r--r--libraries/base/Data/Either.hs1
-rw-r--r--libraries/base/Data/Functor/Identity.hs1
-rw-r--r--libraries/base/Data/List/NonEmpty.hs1
-rw-r--r--libraries/base/Data/Monoid.hs3
-rw-r--r--libraries/base/Data/Proxy.hs2
-rw-r--r--libraries/base/Data/Semigroup.hs21
-rw-r--r--libraries/base/Data/Traversable.hs4
-rw-r--r--libraries/base/Data/Version.hs9
-rw-r--r--libraries/base/GHC/Base.hs18
-rw-r--r--libraries/base/GHC/Conc/Sync.hs12
-rw-r--r--libraries/base/GHC/GHCi.hs3
-rw-r--r--libraries/base/GHC/ST.hs11
-rw-r--r--libraries/base/Text/ParserCombinators/ReadP.hs7
-rw-r--r--libraries/base/Text/ParserCombinators/ReadPrec.hs3
18 files changed, 39 insertions, 65 deletions
diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs
index a2f342f83f..6770234926 100644
--- a/libraries/base/Control/Applicative.hs
+++ b/libraries/base/Control/Applicative.hs
@@ -96,7 +96,7 @@ instance Monad m => Functor (WrappedMonad m) where
fmap f (WrapMonad v) = WrapMonad (liftM f v)
instance Monad m => Applicative (WrappedMonad m) where
- pure = WrapMonad . return
+ pure = WrapMonad . pure
WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)
instance MonadPlus m => Alternative (WrappedMonad m) where
diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs
index 9d09544eeb..c9281569f9 100644
--- a/libraries/base/Control/Arrow.hs
+++ b/libraries/base/Control/Arrow.hs
@@ -314,7 +314,6 @@ instance Arrow a => Applicative (ArrowMonad a) where
ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id))
instance ArrowApply a => Monad (ArrowMonad a) where
- return x = ArrowMonad (arr (\_ -> x))
ArrowMonad m >>= f = ArrowMonad $
m >>> arr (\x -> let ArrowMonad h = f x in (h, ())) >>> app
diff --git a/libraries/base/Control/Monad/ST/Lazy/Imp.hs b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
index 55b28cfc9a..c99912e62d 100644
--- a/libraries/base/Control/Monad/ST/Lazy/Imp.hs
+++ b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
@@ -71,13 +71,11 @@ instance Functor (ST s) where
(f r,new_s)
instance Applicative (ST s) where
- pure = return
+ pure a = ST $ \ s -> (a,s)
(<*>) = ap
instance Monad (ST s) where
- return a = ST $ \ s -> (a,s)
- m >> k = m >>= \ _ -> k
fail s = error s
(ST m) >>= k
diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs
index 09314f163e..31550d5ac7 100644
--- a/libraries/base/Data/Complex.hs
+++ b/libraries/base/Data/Complex.hs
@@ -213,5 +213,4 @@ instance Applicative Complex where
f :+ g <*> a :+ b = f a :+ g b
instance Monad Complex where
- return a = a :+ a
a :+ b >>= f = realPart (f a) :+ imagPart (f b)
diff --git a/libraries/base/Data/Either.hs b/libraries/base/Data/Either.hs
index d727e5219d..50e95824c8 100644
--- a/libraries/base/Data/Either.hs
+++ b/libraries/base/Data/Either.hs
@@ -134,7 +134,6 @@ instance Applicative (Either e) where
Right f <*> r = fmap f r
instance Monad (Either e) where
- return = Right
Left l >>= _ = Left l
Right r >>= k = k r
diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs
index 9f7ae24e66..46fb66650c 100644
--- a/libraries/base/Data/Functor/Identity.hs
+++ b/libraries/base/Data/Functor/Identity.hs
@@ -88,7 +88,6 @@ instance Applicative Identity where
(<*>) = coerce
instance Monad Identity where
- return = Identity
m >>= k = k (runIdentity m)
instance MonadFix Identity where
diff --git a/libraries/base/Data/List/NonEmpty.hs b/libraries/base/Data/List/NonEmpty.hs
index 6698a0ba58..d8bad07c7b 100644
--- a/libraries/base/Data/List/NonEmpty.hs
+++ b/libraries/base/Data/List/NonEmpty.hs
@@ -189,7 +189,6 @@ instance Applicative NonEmpty where
(<*>) = ap
instance Monad NonEmpty where
- return a = a :| []
~(a :| as) >>= f = b :| (bs ++ bs')
where b :| bs = f a
bs' = as >>= toList . f
diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs
index c5a4d8bdf9..eff3836396 100644
--- a/libraries/base/Data/Monoid.hs
+++ b/libraries/base/Data/Monoid.hs
@@ -82,7 +82,6 @@ instance Applicative Dual where
(<*>) = coerce
instance Monad Dual where
- return = Dual
m >>= k = k (getDual m)
-- | The monoid of endomorphisms under composition.
@@ -126,7 +125,6 @@ instance Applicative Sum where
(<*>) = coerce
instance Monad Sum where
- return = Sum
m >>= k = k (getSum m)
-- | Monoid under multiplication.
@@ -146,7 +144,6 @@ instance Applicative Product where
(<*>) = coerce
instance Monad Product where
- return = Product
m >>= k = k (getProduct m)
-- $MaybeExamples
diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs
index a9146214c0..2dad8e4e78 100644
--- a/libraries/base/Data/Proxy.hs
+++ b/libraries/base/Data/Proxy.hs
@@ -90,8 +90,6 @@ instance Applicative Proxy where
{-# INLINE (<*>) #-}
instance Monad Proxy where
- return _ = Proxy
- {-# INLINE return #-}
_ >>= _ = Proxy
{-# INLINE (>>=) #-}
diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs
index 661e513cba..f3f9f0b326 100644
--- a/libraries/base/Data/Semigroup.hs
+++ b/libraries/base/Data/Semigroup.hs
@@ -332,8 +332,7 @@ instance Applicative Min where
Min f <*> Min x = Min (f x)
instance Monad Min where
- return = Min
- _ >> a = a
+ (>>) = (*>)
Min a >>= f = f a
instance MonadFix Min where
@@ -389,8 +388,7 @@ instance Applicative Max where
Max f <*> Max x = Max (f x)
instance Monad Max where
- return = Max
- _ >> a = a
+ (>>) = (*>)
Max a >>= f = f a
instance MonadFix Max where
@@ -476,8 +474,7 @@ instance Applicative First where
First f <*> First x = First (f x)
instance Monad First where
- return = First
- _ >> a = a
+ (>>) = (*>)
First a >>= f = f a
instance MonadFix First where
@@ -523,8 +520,7 @@ instance Applicative Last where
Last f <*> Last x = Last (f x)
instance Monad Last where
- return = Last
- _ >> a = a
+ (>>) = (*>)
Last a >>= f = f a
instance MonadFix Last where
@@ -584,14 +580,13 @@ instance Applicative Option where
pure a = Option (Just a)
Option a <*> Option b = Option (a <*> b)
-instance Monad Option where
- return = pure
+ Option Nothing *> _ = Option Nothing
+ _ *> b = b
+instance Monad Option where
Option (Just a) >>= k = k a
_ >>= _ = Option Nothing
-
- Option Nothing >> _ = Option Nothing
- _ >> b = b
+ (>>) = (*>)
instance Alternative Option where
empty = Option Nothing
diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs
index 81e639cf37..9da76c6a34 100644
--- a/libraries/base/Data/Traversable.hs
+++ b/libraries/base/Data/Traversable.hs
@@ -196,9 +196,9 @@ instance Traversable Proxy where
{-# INLINE traverse #-}
sequenceA _ = pure Proxy
{-# INLINE sequenceA #-}
- mapM _ _ = return Proxy
+ mapM _ _ = pure Proxy
{-# INLINE mapM #-}
- sequence _ = return Proxy
+ sequence _ = pure Proxy
{-# INLINE sequence #-}
instance Traversable (Const m) where
diff --git a/libraries/base/Data/Version.hs b/libraries/base/Data/Version.hs
index aba8cf7f74..414b2aa859 100644
--- a/libraries/base/Data/Version.hs
+++ b/libraries/base/Data/Version.hs
@@ -36,7 +36,8 @@ module Data.Version (
makeVersion
) where
-import Control.Monad ( Monad(..), liftM )
+import Data.Functor ( Functor(..) )
+import Control.Applicative ( Applicative(..) )
import Data.Bool ( (&&) )
import Data.Char ( isDigit, isAlphaNum )
import Data.Eq
@@ -120,9 +121,9 @@ showVersion (Version branch tags)
-- | A parser for versions in the format produced by 'showVersion'.
--
parseVersion :: ReadP Version
-parseVersion = do branch <- sepBy1 (liftM read (munch1 isDigit)) (char '.')
- tags <- many (char '-' >> munch1 isAlphaNum)
- return Version{versionBranch=branch, versionTags=tags}
+parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')
+ tags <- many (char '-' *> munch1 isAlphaNum)
+ pure Version{versionBranch=branch, versionTags=tags}
-- | Construct tag-less 'Version'
--
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index 9bd6124e6a..273950b1fb 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -309,7 +309,6 @@ instance Monoid a => Applicative ((,) a) where
(u, f) <*> (v, x) = (u `mappend` v, f x)
instance Monoid a => Monad ((,) a) where
- return x = (mempty, x)
(u, a) >>= k = case k a of (v, b) -> (u `mappend` v, b)
instance Monoid a => Monoid (IO a) where
@@ -626,7 +625,6 @@ instance Applicative ((->) a) where
(<*>) f g x = f x (g x)
instance Monad ((->) r) where
- return = const
f >>= k = \ r -> k (f r) r
instance Functor ((,) a) where
@@ -652,7 +650,6 @@ instance Monad Maybe where
(>>) = (*>)
- return = Just
fail _ = Nothing
-- -----------------------------------------------------------------------------
@@ -735,8 +732,6 @@ instance Monad [] where
xs >>= f = [y | x <- xs, y <- f x]
{-# INLINE (>>) #-}
(>>) = (*>)
- {-# INLINE return #-}
- return x = [x]
{-# INLINE fail #-}
fail _ = []
@@ -1063,18 +1058,19 @@ asTypeOf = const
----------------------------------------------
instance Functor IO where
- fmap f x = x >>= (return . f)
+ fmap f x = x >>= (pure . f)
instance Applicative IO where
- pure = return
- (<*>) = ap
+ {-# INLINE pure #-}
+ {-# INLINE (*>) #-}
+ pure = returnIO
+ m *> k = m >>= \ _ -> k
+ (<*>) = ap
instance Monad IO where
- {-# INLINE return #-}
{-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
- m >> k = m >>= \ _ -> k
- return = returnIO
+ (>>) = (*>)
(>>=) = bindIO
fail s = failIO s
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs
index db6f841851..83934fe05a 100644
--- a/libraries/base/GHC/Conc/Sync.hs
+++ b/libraries/base/GHC/Conc/Sync.hs
@@ -626,19 +626,19 @@ unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
unSTM (STM a) = a
instance Functor STM where
- fmap f x = x >>= (return . f)
+ fmap f x = x >>= (pure . f)
instance Applicative STM where
- pure = return
+ {-# INLINE pure #-}
+ {-# INLINE (*>) #-}
+ pure x = returnSTM x
(<*>) = ap
+ m *> k = thenSTM m k
instance Monad STM where
- {-# INLINE return #-}
- {-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
- m >> k = thenSTM m k
- return x = returnSTM x
m >>= k = bindSTM m k
+ (>>) = (*>)
bindSTM :: STM a -> (a -> STM b) -> STM b
bindSTM (STM m) k = STM ( \s ->
diff --git a/libraries/base/GHC/GHCi.hs b/libraries/base/GHC/GHCi.hs
index c11863520c..56874a5a12 100644
--- a/libraries/base/GHC/GHCi.hs
+++ b/libraries/base/GHC/GHCi.hs
@@ -38,11 +38,10 @@ instance Functor NoIO where
fmap f (NoIO a) = NoIO (fmap f a)
instance Applicative NoIO where
- pure = return
+ pure a = NoIO (pure a)
(<*>) = ap
instance Monad NoIO where
- return a = NoIO (return a)
(>>=) k f = NoIO (noio k >>= noio . f)
instance GHCiSandboxIO NoIO where
diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs
index d5320522a5..46c5196c9e 100644
--- a/libraries/base/GHC/ST.hs
+++ b/libraries/base/GHC/ST.hs
@@ -58,16 +58,15 @@ instance Functor (ST s) where
(# new_s, f r #) }
instance Applicative (ST s) where
- pure = return
+ {-# INLINE pure #-}
+ {-# INLINE (*>) #-}
+ pure x = ST (\ s -> (# s, x #))
+ m *> k = m >>= \ _ -> k
(<*>) = ap
instance Monad (ST s) where
- {-# INLINE return #-}
- {-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
- return x = ST (\ s -> (# s, x #))
- m >> k = m >>= \ _ -> k
-
+ (>>) = (*>)
(ST m) >>= k
= ST (\ s ->
case (m s) of { (# new_s, r #) ->
diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs
index 034411d6bf..bae2abc90e 100644
--- a/libraries/base/Text/ParserCombinators/ReadP.hs
+++ b/libraries/base/Text/ParserCombinators/ReadP.hs
@@ -103,7 +103,7 @@ data P a
-- Monad, MonadPlus
instance Applicative P where
- pure = return
+ pure x = Result x Fail
(<*>) = ap
instance MonadPlus P where
@@ -111,8 +111,6 @@ instance MonadPlus P where
mplus = (<|>)
instance Monad P where
- return x = Result x Fail
-
(Get f) >>= k = Get (\c -> f c >>= k)
(Look f) >>= k = Look (\s -> f s >>= k)
Fail >>= _ = Fail
@@ -161,11 +159,10 @@ instance Functor ReadP where
fmap h (R f) = R (\k -> f (k . h))
instance Applicative ReadP where
- pure = return
+ pure x = R (\k -> k x)
(<*>) = ap
instance Monad ReadP where
- return x = R (\k -> k x)
fail _ = R (\_ -> Fail)
R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
diff --git a/libraries/base/Text/ParserCombinators/ReadPrec.hs b/libraries/base/Text/ParserCombinators/ReadPrec.hs
index 027648d9e8..02268364ca 100644
--- a/libraries/base/Text/ParserCombinators/ReadPrec.hs
+++ b/libraries/base/Text/ParserCombinators/ReadPrec.hs
@@ -75,11 +75,10 @@ instance Functor ReadPrec where
fmap h (P f) = P (\n -> fmap h (f n))
instance Applicative ReadPrec where
- pure = return
+ pure x = P (\_ -> pure x)
(<*>) = ap
instance Monad ReadPrec where
- return x = P (\_ -> return x)
fail s = P (\_ -> fail s)
P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n)