diff options
| -rw-r--r-- | compiler/prelude/PrelRules.hs | 10 | ||||
| -rw-r--r-- | compiler/simplCore/CoreMonad.hs | 14 | ||||
| -rw-r--r-- | compiler/types/Unify.hs | 12 | ||||
| -rw-r--r-- | compiler/utils/IOEnv.hs | 14 | ||||
| -rw-r--r-- | compiler/utils/MonadUtils.hs | 6 | ||||
| -rw-r--r-- | libraries/base/Control/Arrow.hs | 4 | ||||
| -rw-r--r-- | libraries/base/Data/Semigroup.hs | 4 | ||||
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 4 | ||||
| -rw-r--r-- | libraries/base/Text/ParserCombinators/ReadP.hs | 12 | ||||
| -rw-r--r-- | libraries/base/Text/ParserCombinators/ReadPrec.hs | 8 |
10 files changed, 32 insertions, 56 deletions
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 2a174b13fc..13e271bc66 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -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 diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index 4958474a9d..9f80a17869 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -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 diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index c4c95bfd73..f5f0f084d3 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -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 diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index 4470420a64..6c081ea3d0 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -1,4 +1,4 @@ -{-# 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 diff --git a/compiler/utils/MonadUtils.hs b/compiler/utils/MonadUtils.hs index 36eb574e78..af4f0253db 100644 --- a/compiler/utils/MonadUtils.hs +++ b/compiler/utils/MonadUtils.hs @@ -1,3 +1,4 @@ +{-# 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 diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs index 3417f30cc1..9fc2ee5c90 100644 --- a/libraries/base/Control/Arrow.hs +++ b/libraries/base/Control/Arrow.hs @@ -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'. diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index 6fa0cd85d6..518e215661 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -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)) diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index e1d894a8c1..2a5164b798 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -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. diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs index 6c340e4597..8b84acf24e 100644 --- a/libraries/base/Text/ParserCombinators/ReadP.hs +++ b/libraries/base/Text/ParserCombinators/ReadP.hs @@ -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 diff --git a/libraries/base/Text/ParserCombinators/ReadPrec.hs b/libraries/base/Text/ParserCombinators/ReadPrec.hs index 136b8aed00..2a9c1d0fe8 100644 --- a/libraries/base/Text/ParserCombinators/ReadPrec.hs +++ b/libraries/base/Text/ParserCombinators/ReadPrec.hs @@ -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 |