1 files changed, 2 insertions, 202 deletions
diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs
index 4e77479e15..0e31c8e954 100644
--- a/libraries/base/Control/Applicative.hs
+++ b/libraries/base/Control/Applicative.hs
@@ -48,191 +48,14 @@ module Control.Applicative (
 
 import Prelude hiding (id,(.))
 
+import GHC.Base (liftA, liftA2, liftA3, (<**>))
 import Control.Category
 import Control.Arrow
-import Control.Monad (liftM, ap, MonadPlus(..))
-import Control.Monad.ST.Safe (ST)
-import qualified Control.Monad.ST.Lazy.Safe as Lazy (ST)
+import Control.Monad (liftM, ap, MonadPlus(..), Alternative(..))
 import Data.Functor ((<$>), (<$))
 import Data.Monoid (Monoid(..))
-import Data.Proxy
-
-import Text.ParserCombinators.ReadP (ReadP)
-import Text.ParserCombinators.ReadPrec (ReadPrec)
-
-import GHC.Conc (STM, retry, orElse)
 import GHC.Generics
 
-infixl 3 <|>
-infixl 4 <*>, <*, *>, <**>
-
--- | A functor with application, providing operations to
---
--- * embed pure expressions ('pure'), and
---
--- * sequence computations and combine their results ('<*>').
---
--- A minimal complete definition must include implementations of these
--- functions satisfying the following laws:
---
--- [/identity/]
---
---      @'pure' 'id' '<*>' v = v@
---
--- [/composition/]
---
---      @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@
---
--- [/homomorphism/]
---
---      @'pure' f '<*>' 'pure' x = 'pure' (f x)@
---
--- [/interchange/]
---
---      @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@
---
--- The other methods have the following default definitions, which may
--- be overridden with equivalent specialized implementations:
---
---   * @u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v@
---
---   * @u '<*' v = 'pure' 'const' '<*>' u '<*>' v@
---
--- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy
---
---   * @'fmap' f x = 'pure' f '<*>' x@
---
--- If @f@ is also a 'Monad', it should satisfy
---
---   * @'pure' = 'return'@
---
---   * @('<*>') = 'ap'@
---
--- (which implies that 'pure' and '<*>' satisfy the applicative functor laws).
-
-class Functor f => Applicative f where
-    -- | Lift a value.
-    pure :: a -> f a
-
-    -- | Sequential application.
-    (<*>) :: f (a -> b) -> f a -> f b
-
-    -- | Sequence actions, discarding the value of the first argument.
-    (*>) :: f a -> f b -> f b
-    (*>) = liftA2 (const id)
-
-    -- | Sequence actions, discarding the value of the second argument.
-    (<*) :: f a -> f b -> f a
-    (<*) = liftA2 const
-
--- | 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 = (:) <$> v <*> many_v
-
-    -- | Zero or more.
-    many :: f a -> f [a]
-    many v = many_v
-      where
-        many_v = some_v <|> pure []
-        some_v = (:) <$> v <*> many_v
-
--- instances for Prelude types
-
-instance Applicative Maybe where
-    pure = return
-    (<*>) = ap
-
-instance Alternative Maybe where
-    empty = Nothing
-    Nothing <|> r = r
-    l       <|> _ = l
-
-instance Applicative [] where
-    pure = return
-    (<*>) = ap
-
-instance Alternative [] where
-    empty = []
-    (<|>) = (++)
-
-instance Applicative IO where
-    pure = return
-    (<*>) = ap
-
-instance Applicative (ST s) where
-    pure = return
-    (<*>) = ap
-
-instance Applicative (Lazy.ST s) where
-    pure = return
-    (<*>) = ap
-
-instance Applicative STM where
-    pure = return
-    (<*>) = ap
-
-instance Alternative STM where
-    empty = retry
-    (<|>) = orElse
-
-instance Applicative ((->) a) where
-    pure = const
-    (<*>) f g x = f x (g x)
-
-instance Monoid a => Applicative ((,) a) where
-    pure x = (mempty, x)
-    (u, f) <*> (v, x) = (u `mappend` v, f x)
-
-instance Applicative (Either e) where
-    pure          = Right
-    Left  e <*> _ = Left e
-    Right f <*> r = fmap f r
-
-instance Applicative ReadP where
-    pure = return
-    (<*>) = ap
-
-instance Alternative ReadP where
-    empty = mzero
-    (<|>) = mplus
-
-instance Applicative ReadPrec where
-    pure = return
-    (<*>) = ap
-
-instance Alternative ReadPrec where
-    empty = mzero
-    (<|>) = mplus
-
-instance Arrow a => Applicative (ArrowMonad a) where
-   pure x = ArrowMonad (arr (const x))
-   ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id))
-
-instance ArrowPlus a => Alternative (ArrowMonad a) where
-   empty = ArrowMonad zeroArrow
-   ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y)
-
--- new instances
-
 newtype Const a b = Const { getConst :: a }
                   deriving (Generic, Generic1)
 
@@ -295,31 +118,8 @@ instance Applicative ZipList where
     pure x = ZipList (repeat x)
     ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)
 
-instance Applicative Proxy where
-    pure _ = Proxy
-    {-# INLINE pure #-}
-    _ <*> _ = Proxy
-    {-# INLINE (<*>) #-}
-
 -- extra functions
 
--- | A variant of '<*>' with the arguments reversed.
-(<**>) :: Applicative f => f a -> f (a -> b) -> f b
-(<**>) = liftA2 (flip ($))
-
--- | Lift a function to actions.
--- This function may be used as a value for `fmap` in a `Functor` instance.
-liftA :: Applicative f => (a -> b) -> f a -> f b
-liftA f a = pure f <*> a
-
--- | Lift a binary function to actions.
-liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
-liftA2 f a b = f <$> a <*> b
-
--- | Lift a ternary function to actions.
-liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
-liftA3 f a b c = f <$> a <*> b <*> c
-
 -- | One or none.
 optional :: Alternative f => f a -> f (Maybe a)
 optional v = Just <$> v <|> pure Nothing