Commit dafeb51f authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Canonicalise `MonadPlus` instances

This refactoring exploits the fact that since AMP, in most cases,
`instance MonadPlus` can be automatically derived from the respective
`Alternative` instance.  This is because `MonadPlus`'s default method
implementations are fully defined in terms of `Alternative(empty, (<>))`.
parent 8afeaad9
......@@ -656,13 +656,11 @@ instance MonadFail.MonadFail RuleM where
#endif
instance Alternative RuleM where
empty = mzero
(<|>) = mplus
empty = RuleM $ \_ _ _ -> Nothing
RuleM f1 <|> RuleM f2 = RuleM $ \dflags iu args ->
f1 dflags iu args <|> f2 dflags iu args
instance MonadPlus RuleM where
mzero = RuleM $ \_ _ _ -> Nothing
mplus (RuleM f1) (RuleM f2) = RuleM $ \dflags iu args ->
f1 dflags iu args `mplus` f2 dflags iu args
instance MonadPlus RuleM
instance HasDynFlags RuleM where
getDynFlags = RuleM $ \dflags _ _ -> Just dflags
......
......@@ -4,7 +4,7 @@
\section[CoreMonad]{The core pipeline monad}
-}
{-# LANGUAGE CPP, UndecidableInstances #-}
{-# LANGUAGE CPP #-}
module CoreMonad (
-- * Configuration of the core-to-core passes
......@@ -570,15 +570,11 @@ instance Applicative CoreM where
(<*>) = ap
m *> k = m >>= \_ -> k
instance MonadPlus IO => Alternative CoreM where
empty = mzero
(<|>) = mplus
instance Alternative CoreM where
empty = CoreM (const Control.Applicative.empty)
m <|> n = CoreM (\rs -> unCoreM m rs <|> unCoreM n rs)
-- For use if the user has imported Control.Monad.Error from MTL
-- Requires UndecidableInstances
instance MonadPlus IO => MonadPlus CoreM where
mzero = CoreM (const mzero)
m `mplus` n = CoreM (\rs -> unCoreM m rs `mplus` unCoreM n rs)
instance MonadPlus CoreM
instance MonadUnique CoreM where
getUniqueSupplyM = do
......
......@@ -390,9 +390,7 @@ instance Alternative UnifyResultM where
_ <|> b@(MaybeApart {}) = b
SurelyApart <|> SurelyApart = SurelyApart
instance MonadPlus UnifyResultM where
mzero = Control.Applicative.empty
mplus = (<|>)
instance MonadPlus UnifyResultM
-- | @tcUnifyTysFG bind_tv tys1 tys2@ attepts to find a substitution @s@ (whose
-- domain elements all respond 'BindMe' to @bind_tv@) such that
......@@ -912,16 +910,14 @@ instance Monad UM where
do { (state', v) <- unUM m env state
; unUM (k v) env state' })
-- need this instance because of a use of 'guard' above
instance Alternative UM where
empty = UM (\_ _ -> mzero)
empty = UM (\_ _ -> Control.Applicative.empty)
m1 <|> m2 = UM (\env state ->
unUM m1 env state <|>
unUM m2 env state)
-- need this instance because of a use of 'guard' above
instance MonadPlus UM where
mzero = Control.Applicative.empty
mplus = (<|>)
instance MonadPlus UM
#if __GLASGOW_HASKELL__ > 710
instance MonadFail.MonadFail UM where
......
{-# LANGUAGE DeriveDataTypeable, UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
--
......@@ -177,15 +177,11 @@ uninterruptibleMaskM_ (IOEnv m) = IOEnv (\ env -> uninterruptibleMask_ (m env))
-- Alternative/MonadPlus
----------------------------------------------------------------------
instance MonadPlus IO => Alternative (IOEnv env) where
empty = mzero
(<|>) = mplus
instance Alternative (IOEnv env) where
empty = IOEnv (const empty)
m <|> n = IOEnv (\env -> unIOEnv m env <|> unIOEnv n env)
-- For use if the user has imported Control.Monad.Error from MTL
-- Requires UndecidableInstances
instance MonadPlus IO => MonadPlus (IOEnv env) where
mzero = IOEnv (const mzero)
m `mplus` n = IOEnv (\env -> unIOEnv m env `mplus` unIOEnv n env)
instance MonadPlus (IOEnv env)
----------------------------------------------------------------------
-- Accessing input/output
......
{-# LANGUAGE CPP #-}
-- | Utilities related to Monad and Applicative classes
-- Mostly for backwards compatability.
......@@ -30,11 +31,12 @@ module MonadUtils
import Maybes
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import Control.Monad.IO.Class
import Prelude -- avoid redundant import warning due to AMP
#if __GLASGOW_HASKELL__ < 800
import Control.Monad.Trans.Error () -- for orphan `instance MonadPlus IO`
#endif
-------------------------------------------------------------------------------
-- Lift combinators
......
......@@ -321,9 +321,7 @@ instance ArrowPlus a => Alternative (ArrowMonad a) where
empty = ArrowMonad zeroArrow
ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y)
instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a) where
mzero = ArrowMonad zeroArrow
ArrowMonad x `mplus` ArrowMonad y = ArrowMonad (x <+> y)
instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a)
-- | Any instance of 'ArrowApply' can be made into an instance of
-- 'ArrowChoice' by defining 'left' = 'leftApp'.
......
......@@ -592,9 +592,7 @@ instance Alternative Option where
Option Nothing <|> b = b
a <|> _ = a
instance MonadPlus Option where
mzero = Option Nothing
mplus = (<|>)
instance MonadPlus Option
instance MonadFix Option where
mfix f = Option (mfix (getOption . f))
......
......@@ -659,9 +659,7 @@ instance Alternative STM where
empty = retry
(<|>) = orElse
instance MonadPlus STM where
mzero = empty
mplus = (<|>)
instance MonadPlus STM
-- | Unsafely performs IO in the STM monad. Beware: this is a highly
-- dangerous thing to do.
......
......@@ -108,9 +108,7 @@ instance Applicative P where
pure x = Result x Fail
(<*>) = ap
instance MonadPlus P where
mzero = empty
mplus = (<|>)
instance MonadPlus P
instance Monad P where
(Get f) >>= k = Get (\c -> f c >>= k)
......@@ -175,12 +173,10 @@ instance MonadFail ReadP where
fail _ = R (\_ -> Fail)
instance Alternative ReadP where
empty = mzero
(<|>) = mplus
empty = pfail
(<|>) = (+++)
instance MonadPlus ReadP where
mzero = pfail
mplus = (+++)
instance MonadPlus ReadP
-- ---------------------------------------------------------------------------
-- Operations over P
......
......@@ -87,13 +87,11 @@ instance Monad ReadPrec where
instance MonadFail.MonadFail ReadPrec where
fail s = P (\_ -> fail s)
instance MonadPlus ReadPrec where
mzero = pfail
mplus = (+++)
instance MonadPlus ReadPrec
instance Alternative ReadPrec where
empty = mzero
(<|>) = mplus
empty = pfail
(<|>) = (+++)
-- precedences
type Prec = Int
......
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