summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorAustin Seipp <austin@well-typed.com>2014-04-22 06:09:40 -0500
committerAustin Seipp <austin@well-typed.com>2014-09-09 08:13:27 -0500
commitd94de87252d0fe2ae97341d186b03a2fbe136b04 (patch)
tree1cac19f2786b1d8a1626886cd6373946a3a276b0 /testsuite
parentfdfe6c0e50001add357475a1a3a7627243a28a70 (diff)
downloadhaskell-d94de87252d0fe2ae97341d186b03a2fbe136b04.tar.gz
Make Applicative a superclass of Monad
Summary: This includes pretty much all the changes needed to make `Applicative` a superclass of `Monad` finally. There's mostly reshuffling in the interests of avoid orphans and boot files, but luckily we can resolve all of them, pretty much. The only catch was that Alternative/MonadPlus also had to go into Prelude to avoid this. As a result, we must update the hsc2hs and haddock submodules. Signed-off-by: Austin Seipp <austin@well-typed.com> Test Plan: Build things, they might not explode horribly. Reviewers: hvr, simonmar Subscribers: simonmar Differential Revision: https://phabricator.haskell.org/D13
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/deriving/should_fail/T3621.hs4
-rw-r--r--testsuite/tests/deriving/should_fail/T3621.stderr2
-rw-r--r--testsuite/tests/deriving/should_run/drvrun019.hs2
-rw-r--r--testsuite/tests/ghci/scripts/T4175.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/T7627.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/T8535.stdout3
-rw-r--r--testsuite/tests/ghci/scripts/ghci011.stdout3
-rw-r--r--testsuite/tests/ghci/scripts/ghci020.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/ghci025.stdout5
-rw-r--r--testsuite/tests/ghci/scripts/ghci027.stdout4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4485.hs6
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4485.stderr8
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7729.hs10
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7729.stderr6
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7729a.hs10
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7729a.stderr8
-rw-r--r--testsuite/tests/mdo/should_compile/mdo002.hs8
-rw-r--r--testsuite/tests/parser/should_compile/T7476/T7476.stdout2
-rw-r--r--testsuite/tests/perf/compiler/all.T17
-rw-r--r--testsuite/tests/perf/haddock/all.T6
-rw-r--r--testsuite/tests/polykinds/MonoidsFD.hs6
-rw-r--r--testsuite/tests/polykinds/MonoidsTF.hs6
-rw-r--r--testsuite/tests/rebindable/rebindable2.hs14
-rw-r--r--testsuite/tests/rename/should_compile/T1954.hs2
-rw-r--r--testsuite/tests/rename/should_compile/T7145a.hs1
-rw-r--r--testsuite/tests/rename/should_compile/T7145b.stderr2
-rw-r--r--testsuite/tests/rename/should_fail/T2993.stderr4
-rw-r--r--testsuite/tests/simplCore/should_compile/T8848.stderr6
-rw-r--r--testsuite/tests/simplCore/should_compile/simpl017.hs11
-rw-r--r--testsuite/tests/simplCore/should_compile/simpl017.stderr26
-rw-r--r--testsuite/tests/simplCore/should_run/T3591.hs18
-rw-r--r--testsuite/tests/typecheck/should_compile/T4524.hs13
-rw-r--r--testsuite/tests/typecheck/should_compile/T4969.hs9
-rw-r--r--testsuite/tests/typecheck/should_compile/tc213.hs2
34 files changed, 164 insertions, 64 deletions
diff --git a/testsuite/tests/deriving/should_fail/T3621.hs b/testsuite/tests/deriving/should_fail/T3621.hs
index cd574eab81..36ac195f2b 100644
--- a/testsuite/tests/deriving/should_fail/T3621.hs
+++ b/testsuite/tests/deriving/should_fail/T3621.hs
@@ -14,11 +14,13 @@ newtype T = MkT S deriving( C a )
class (Monad m) => MonadState s m | m -> s where
newtype State s a = State { runState :: s -> (a, s) }
+instance Functor (State s) where {}
+instance Applicative (State s) where {}
instance Monad (State s) where {}
instance MonadState s (State s) where {}
newtype WrappedState s a = WS { runWS :: State s a }
- deriving (Monad, MonadState state)
+ deriving (Functor, Applicative, Monad, MonadState state)
-- deriving (Monad)
deriving instance (MonadState state (State s))
diff --git a/testsuite/tests/deriving/should_fail/T3621.stderr b/testsuite/tests/deriving/should_fail/T3621.stderr
index b70fc33bda..67b949e754 100644
--- a/testsuite/tests/deriving/should_fail/T3621.stderr
+++ b/testsuite/tests/deriving/should_fail/T3621.stderr
@@ -1,5 +1,5 @@
-T3621.hs:21:21:
+T3621.hs:23:43:
No instance for (MonadState state (State s))
arising from the 'deriving' clause of a data type declaration
Possible fix:
diff --git a/testsuite/tests/deriving/should_run/drvrun019.hs b/testsuite/tests/deriving/should_run/drvrun019.hs
index 3fd8ccf025..663fb38cd4 100644
--- a/testsuite/tests/deriving/should_run/drvrun019.hs
+++ b/testsuite/tests/deriving/should_run/drvrun019.hs
@@ -6,7 +6,7 @@
module Main where
newtype Wrap m a = Wrap { unWrap :: m a }
- deriving (Monad, Eq)
+ deriving (Functor, Applicative, Monad, Eq)
foo :: Int -> Wrap IO a -> Wrap IO ()
foo 0 a = return ()
diff --git a/testsuite/tests/ghci/scripts/T4175.stdout b/testsuite/tests/ghci/scripts/T4175.stdout
index 29bca027ce..0cf5e9b5c0 100644
--- a/testsuite/tests/ghci/scripts/T4175.stdout
+++ b/testsuite/tests/ghci/scripts/T4175.stdout
@@ -35,6 +35,7 @@ instance Functor Maybe -- Defined in ‘Data.Maybe’
instance Ord a => Ord (Maybe a) -- Defined in ‘Data.Maybe’
instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
+instance Applicative Maybe -- Defined in ‘Data.Maybe’
type instance A (Maybe a) a = a -- Defined at T4175.hs:9:1
data Int = I# Int# -- Defined in ‘GHC.Types’
instance C Int -- Defined at T4175.hs:18:10
diff --git a/testsuite/tests/ghci/scripts/T7627.stdout b/testsuite/tests/ghci/scripts/T7627.stdout
index 46935eb0ea..9177bbd1e1 100644
--- a/testsuite/tests/ghci/scripts/T7627.stdout
+++ b/testsuite/tests/ghci/scripts/T7627.stdout
@@ -18,6 +18,8 @@ instance Functor ((,) a) -- Defined in ‘GHC.Base’
instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’
instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’
+instance GHC.Base.Monoid a => Applicative ((,) a)
+ -- Defined in ‘GHC.Base’
data (#,#) (a :: OpenKind) (b :: OpenKind) = (#,#) a b
-- Defined in ‘GHC.Prim’
(,) :: a -> b -> (a, b)
diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout
index 69efa29fc0..749a244f1f 100644
--- a/testsuite/tests/ghci/scripts/T8535.stdout
+++ b/testsuite/tests/ghci/scripts/T8535.stdout
@@ -1,4 +1,5 @@
data (->) a b -- Defined in ‘GHC.Prim’
instance Monad ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
-instance Monoid b => Monoid (a -> b) -- Defined in ‘Data.Monoid’
+instance Applicative ((->) a) -- Defined in ‘GHC.Base’
+instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/ghci011.stdout b/testsuite/tests/ghci/scripts/ghci011.stdout
index 239ec07800..6b807f65c2 100644
--- a/testsuite/tests/ghci/scripts/ghci011.stdout
+++ b/testsuite/tests/ghci/scripts/ghci011.stdout
@@ -5,6 +5,7 @@ instance Functor [] -- Defined in ‘GHC.Base’
instance Ord a => Ord [a] -- Defined in ‘GHC.Classes’
instance Read a => Read [a] -- Defined in ‘GHC.Read’
instance Show a => Show [a] -- Defined in ‘GHC.Show’
+instance Applicative [] -- Defined in ‘GHC.Base’
data () = () -- Defined in ‘GHC.Tuple’
instance Bounded () -- Defined in ‘GHC.Enum’
instance Enum () -- Defined in ‘GHC.Enum’
@@ -20,3 +21,5 @@ instance Functor ((,) a) -- Defined in ‘GHC.Base’
instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’
instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’
+instance GHC.Base.Monoid a => Applicative ((,) a)
+ -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout
index 700a212651..bd3a045871 100644
--- a/testsuite/tests/ghci/scripts/ghci020.stdout
+++ b/testsuite/tests/ghci/scripts/ghci020.stdout
@@ -1,3 +1,4 @@
data (->) a b -- Defined in ‘GHC.Prim’
instance Monad ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
+instance Applicative ((->) a) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout
index 0d794be549..c1356de953 100644
--- a/testsuite/tests/ghci/scripts/ghci025.stdout
+++ b/testsuite/tests/ghci/scripts/ghci025.stdout
@@ -14,7 +14,8 @@ 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 Monad m => MonadPlus (m :: * -> *) where
+class (Control.Monad.Alternative m, Monad m) =>
+ MonadPlus (m :: * -> *) where
mzero :: m a
mplus :: m a -> m a -> m a
mplus :: MonadPlus m => forall a. m a -> m a -> m a
@@ -25,7 +26,7 @@ mzero :: MonadPlus m => forall a. m a
fail :: Monad m => forall a. GHC.Base.String -> m a
return :: Monad m => forall a. a -> m a
-- imported via Control.Monad, Prelude, T
-class Monad (m :: * -> *) where
+class GHC.Base.Applicative m => Monad (m :: * -> *) where
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
return :: a -> m a
diff --git a/testsuite/tests/ghci/scripts/ghci027.stdout b/testsuite/tests/ghci/scripts/ghci027.stdout
index 0d722c9d8c..47ec533084 100644
--- a/testsuite/tests/ghci/scripts/ghci027.stdout
+++ b/testsuite/tests/ghci/scripts/ghci027.stdout
@@ -1,8 +1,8 @@
-class GHC.Base.Monad m =>
+class (Control.Monad.Alternative m, GHC.Base.Monad m) =>
Control.Monad.MonadPlus (m :: * -> *) where
...
mplus :: m a -> m a -> m a
-class GHC.Base.Monad m =>
+class (Control.Monad.Alternative m, GHC.Base.Monad m) =>
Control.Monad.MonadPlus (m :: * -> *) where
...
Control.Monad.mplus :: m a -> m a -> m a
diff --git a/testsuite/tests/indexed-types/should_fail/T4485.hs b/testsuite/tests/indexed-types/should_fail/T4485.hs
index d7d4730362..afea7e6c41 100644
--- a/testsuite/tests/indexed-types/should_fail/T4485.hs
+++ b/testsuite/tests/indexed-types/should_fail/T4485.hs
@@ -15,7 +15,7 @@
module XMLGenerator where
newtype XMLGenT m a = XMLGenT (m a)
- deriving (Functor, Monad)
+ deriving (Functor, Applicative, Monad)
class Monad m => XMLGen m where
type XML m
@@ -31,11 +31,15 @@ instance {-# OVERLAPPABLE #-} (XMLGen m, XML m ~ x) => EmbedAsChild m x
data Xml = Xml
data IdentityT m a = IdentityT (m a)
+instance Functor (IdentityT m)
+instance Applicative (IdentityT m)
instance Monad (IdentityT m)
instance XMLGen (IdentityT m) where
type XML (IdentityT m) = Xml
data Identity a = Identity a
+instance Functor Identity
+instance Applicative Identity
instance Monad Identity
instance {-# OVERLAPPING #-} EmbedAsChild (IdentityT IO) (XMLGenT Identity ())
diff --git a/testsuite/tests/indexed-types/should_fail/T4485.stderr b/testsuite/tests/indexed-types/should_fail/T4485.stderr
index 760cdf912d..320d9a5195 100644
--- a/testsuite/tests/indexed-types/should_fail/T4485.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4485.stderr
@@ -1,5 +1,5 @@
-T4485.hs:46:15:
+T4485.hs:50:15:
Overlapping instances for EmbedAsChild
(IdentityT IO) (XMLGenT m0 (XML m0))
arising from a use of ‘asChild’
@@ -9,7 +9,7 @@ T4485.hs:46:15:
-- Defined at T4485.hs:28:30
instance [overlapping] EmbedAsChild
(IdentityT IO) (XMLGenT Identity ())
- -- Defined at T4485.hs:41:30
+ -- Defined at T4485.hs:45:30
(The choice depends on the instantiation of ‘m0’
To pick the first instance above, use IncoherentInstances
when compiling the other instance declarations)
@@ -18,11 +18,11 @@ T4485.hs:46:15:
In an equation for ‘asChild’:
asChild b = asChild $ (genElement "foo")
-T4485.hs:46:26:
+T4485.hs:50:26:
No instance for (XMLGen m0) arising from a use of ‘genElement’
The type variable ‘m0’ is ambiguous
Note: there is a potential instance available:
- instance XMLGen (IdentityT m) -- Defined at T4485.hs:35:10
+ instance XMLGen (IdentityT m) -- Defined at T4485.hs:37:10
In the second argument of ‘($)’, namely ‘(genElement "foo")’
In the expression: asChild $ (genElement "foo")
In an equation for ‘asChild’:
diff --git a/testsuite/tests/indexed-types/should_fail/T7729.hs b/testsuite/tests/indexed-types/should_fail/T7729.hs
index c542cf0550..bce63cd6e1 100644
--- a/testsuite/tests/indexed-types/should_fail/T7729.hs
+++ b/testsuite/tests/indexed-types/should_fail/T7729.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
module T7729 where
+import Control.Monad
class Monad m => PrimMonad m where
type PrimState m
@@ -16,6 +17,13 @@ newtype Rand m a = Rand {
runRand :: Maybe (m ()) -> m a
}
+instance Monad m => Functor (Rand m) where
+ fmap = liftM
+
+instance Monad m => Applicative (Rand m) where
+ pure = return
+ (<*>) = ap
+
instance (Monad m) => Monad (Rand m) where
return = Rand . const . return
(Rand rnd) >>= f = Rand $ \g -> (\x -> runRand (f x) g) =<< rnd g
@@ -25,4 +33,4 @@ instance MonadTrans Rand where
instance MonadPrim m => MonadPrim (Rand m) where
type BasePrimMonad (Rand m) = BasePrimMonad m
- liftPrim = liftPrim . lift \ No newline at end of file
+ liftPrim = liftPrim . lift
diff --git a/testsuite/tests/indexed-types/should_fail/T7729.stderr b/testsuite/tests/indexed-types/should_fail/T7729.stderr
index bb5a900c4c..c8814a412d 100644
--- a/testsuite/tests/indexed-types/should_fail/T7729.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7729.stderr
@@ -1,16 +1,16 @@
-T7729.hs:28:14:
+T7729.hs:36:14:
Could not deduce (BasePrimMonad (Rand m)
~ t0 (BasePrimMonad (Rand m)))
from the context (PrimMonad (BasePrimMonad (Rand m)),
Monad (Rand m),
MonadPrim m)
- bound by the instance declaration at T7729.hs:26:10-42
+ bound by the instance declaration at T7729.hs:34:10-42
The type variable ‘t0’ is ambiguous
Expected type: t0 (BasePrimMonad (Rand m)) a -> Rand m a
Actual type: BasePrimMonad (Rand m) a -> Rand m a
Relevant bindings include
liftPrim :: BasePrimMonad (Rand m) a -> Rand m a
- (bound at T7729.hs:28:3)
+ (bound at T7729.hs:36:3)
In the first argument of ‘(.)’, namely ‘liftPrim’
In the expression: liftPrim . lift
diff --git a/testsuite/tests/indexed-types/should_fail/T7729a.hs b/testsuite/tests/indexed-types/should_fail/T7729a.hs
index 53c163992b..ea36e32bd6 100644
--- a/testsuite/tests/indexed-types/should_fail/T7729a.hs
+++ b/testsuite/tests/indexed-types/should_fail/T7729a.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
module T7729a where
+import Control.Monad
class Monad m => PrimMonad m where
type PrimState m
@@ -16,6 +17,13 @@ newtype Rand m a = Rand {
runRand :: Maybe (m ()) -> m a
}
+instance Monad m => Functor (Rand m) where
+ fmap = liftM
+
+instance Monad m => Applicative (Rand m) where
+ pure = return
+ (<*>) = ap
+
instance (Monad m) => Monad (Rand m) where
return = Rand . const . return
(Rand rnd) >>= f = Rand $ \g -> (\x -> runRand (f x) g) =<< rnd g
@@ -25,4 +33,4 @@ instance MonadTrans Rand where
instance MonadPrim m => MonadPrim (Rand m) where
type BasePrimMonad (Rand m) = BasePrimMonad m
- liftPrim x = liftPrim (lift x) -- This line changed from T7729 \ No newline at end of file
+ liftPrim x = liftPrim (lift x) -- This line changed from T7729
diff --git a/testsuite/tests/indexed-types/should_fail/T7729a.stderr b/testsuite/tests/indexed-types/should_fail/T7729a.stderr
index f90db0c491..907eb1d3b1 100644
--- a/testsuite/tests/indexed-types/should_fail/T7729a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7729a.stderr
@@ -1,17 +1,17 @@
-T7729a.hs:28:26:
+T7729a.hs:36:26:
Could not deduce (BasePrimMonad (Rand m)
~ t0 (BasePrimMonad (Rand m)))
from the context (PrimMonad (BasePrimMonad (Rand m)),
Monad (Rand m),
MonadPrim m)
- bound by the instance declaration at T7729a.hs:26:10-42
+ bound by the instance declaration at T7729a.hs:34:10-42
The type variable ‘t0’ is ambiguous
Expected type: BasePrimMonad (Rand m) a
Actual type: t0 (BasePrimMonad (Rand m)) a
Relevant bindings include
- x :: BasePrimMonad (Rand m) a (bound at T7729a.hs:28:12)
+ x :: BasePrimMonad (Rand m) a (bound at T7729a.hs:36:12)
liftPrim :: BasePrimMonad (Rand m) a -> Rand m a
- (bound at T7729a.hs:28:3)
+ (bound at T7729a.hs:36:3)
In the first argument of ‘liftPrim’, namely ‘(lift x)’
In the expression: liftPrim (lift x)
diff --git a/testsuite/tests/mdo/should_compile/mdo002.hs b/testsuite/tests/mdo/should_compile/mdo002.hs
index dc33595590..432825749d 100644
--- a/testsuite/tests/mdo/should_compile/mdo002.hs
+++ b/testsuite/tests/mdo/should_compile/mdo002.hs
@@ -4,10 +4,18 @@
module Main (main) where
+import Control.Monad
import Control.Monad.Fix
data X a = X a deriving Show
+instance Functor X where
+ fmap f (X a) = X (f a)
+
+instance Applicative X where
+ pure = return
+ (<*>) = ap
+
instance Monad X where
return = X
(X a) >>= f = f a
diff --git a/testsuite/tests/parser/should_compile/T7476/T7476.stdout b/testsuite/tests/parser/should_compile/T7476/T7476.stdout
index d3ac31ba0d..f6e15d592e 100644
--- a/testsuite/tests/parser/should_compile/T7476/T7476.stdout
+++ b/testsuite/tests/parser/should_compile/T7476/T7476.stdout
@@ -1 +1 @@
-import Control.Applicative ( Applicative(pure), (<$>) )
+import Control.Applicative ( (<$>) )
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 16ab036882..e5964a1a8e 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -73,7 +73,7 @@ test('T1969',
# 2013-02-10 322937684 (x86/OSX)
# 2014-01-22 316103268 (x86/Linux)
# 2014-06-29 303300692 (x86/Linux)
- (wordsize(64), 625525224, 5)]),
+ (wordsize(64), 651626680, 5)]),
# 17/11/2009 434845560 (amd64/Linux)
# 08/12/2009 459776680 (amd64/Linux)
# 17/05/2010 519377728 (amd64/Linux)
@@ -90,7 +90,6 @@ test('T1969',
# 18/10/2013 698612512 (x86_64/Linux) fix for #8456
# 10/02/2014 660922376 (x86_64/Linux) call arity analysis
# 17/07/2014 651626680 (x86_64/Linux) roundabout update
-
only_ways(['normal']),
extra_hc_opts('-dcore-lint -static')
@@ -221,7 +220,7 @@ test('T3064',
# expected value: 14 (x86/Linux 28-06-2012):
# 2013-11-13: 18 (x86/Windows, 64bit machine)
# 2014-01-22: 23 (x86/Linux)
- (wordsize(64), 42, 20)]),
+ (wordsize(64), 52, 20)]),
# (amd64/Linux): 18
# (amd64/Linux) 2012-02-07: 26
# (amd64/Linux) 2013-02-12: 23; increased range to 10%
@@ -230,6 +229,7 @@ test('T3064',
# Increased range to 20%. peak-usage varies from 22 to 26,
# depending on whether the old .hi file exists
# (amd64/Linux) 2013-09-11: 37; better arity analysis (weird)
+ # (amd64/Linux) (09/09/2014): 42, AMP changes (larger interfaces, more loading)
compiler_stats_num_field('bytes allocated',
[(wordsize(32), 162457940, 10),
@@ -237,7 +237,7 @@ test('T3064',
# 2012-10-30: 111189536 (x86/Windows)
# 2013-11-13: 146626504 (x86/Windows, 64bit machine)
# 2014-01-22: 162457940 (x86/Linux)
- (wordsize(64), 313638592, 5)]),
+ (wordsize(64), 407416464, 5)]),
# (amd64/Linux) (28/06/2011): 73259544
# (amd64/Linux) (07/02/2013): 224798696
# (amd64/Linux) (02/08/2013): 236404384, increase from roles
@@ -248,6 +248,7 @@ test('T3064',
# (amd64/Linux) (23/05/2014): 324022680, unknown cause
# (amd64/Linux) (2014-07-17): 332702112, general round of updates
# (amd64/Linux) (2014-08-29): 313638592, w/w for INLINABLE things
+ # (amd64/Linux) (09/09/2014): 407416464, AMP changes (larger interfaces, more loading)
compiler_stats_num_field('max_bytes_used',
[(wordsize(32), 11202304, 20),
@@ -255,7 +256,7 @@ test('T3064',
#(some date): 5511604
# 2013-11-13: 7218200 (x86/Windows, 64bit machine)
# 2014-04-04: 11202304 (x86/Windows, 64bit machine)
- (wordsize(64), 19821544, 20)]),
+ (wordsize(64), 24357392, 20)]),
# (amd64/Linux, intree) (28/06/2011): 4032024
# (amd64/Linux, intree) (07/02/2013): 9819288
# (amd64/Linux) (14/02/2013): 8687360
@@ -266,6 +267,7 @@ test('T3064',
# 933cdf15a2d85229d3df04b437da31fdfbf4961f
# (amd64/Linux) (22/11/2013): 16266992, GND via Coercible and counters for constraints solving
# (amd64/Linux) (12/12/2013): 19821544, better One shot analysis
+ # (amd64/Linux) (09/09/2014): 24357392, AMP changes (larger interfaces, more loading)
only_ways(['normal'])
],
compile,
@@ -305,10 +307,11 @@ test('T5631',
[(wordsize(32), 346389856, 10),
# expected value: 392904228 (x86/Linux)
# 2014-04-04: 346389856 (x86 Windows, 64 bit machine)
- (wordsize(64), 690742040, 5)]),
+ (wordsize(64), 739704712, 5)]),
# expected value: 774595008 (amd64/Linux):
# expected value: 735486328 (amd64/Linux) 2012/12/12:
# expected value: 690742040 (amd64/Linux) Call Arity improvements
+ # 2014-09-09: 739704712 (amd64/Linux) AMP changes
only_ways(['normal'])
],
compile,
@@ -403,7 +406,7 @@ test('T5642',
# sample from x86/Linux
# prev: 650000000
# 2014-09-03: 753045568
- (wordsize(64), 1402242360, 10)])
+ (wordsize(64), 1452688392, 10)])
# prev: 1300000000
# 2014-07-17: 1358833928 (general round of updates)
# 2014-08-07: 1402242360 (caused by 1fc60ea)
diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T
index d4dad1dbcb..46cad30564 100644
--- a/testsuite/tests/perf/haddock/all.T
+++ b/testsuite/tests/perf/haddock/all.T
@@ -5,7 +5,7 @@
test('haddock.base',
[unless(in_tree_compiler(), skip)
,stats_num_field('bytes allocated',
- [(wordsize(64), 7946284944, 5)
+ [(wordsize(64), 8354439016, 5)
# 2012-08-14: 5920822352 (amd64/Linux)
# 2012-09-20: 5829972376 (amd64/Linux)
# 2012-10-08: 5902601224 (amd64/Linux)
@@ -18,6 +18,7 @@ test('haddock.base',
# 2014-06-12: 7498123680 (x86_64/Linux)
# 2014-08-05: 7992757384 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs)
# 2014-08-08: 7946284944 (x86_64/Linux - Haddock updates to attoparsec-0.12.1.0)
+ # 2014-09-09: 8354439016 (x86_64/Linux - Applicative/Monad changes)
,(platform('i386-unknown-mingw32'), 3746792812, 5)
# 2013-02-10: 3358693084 (x86/Windows)
# 2013-11-13: 3097751052 (x86/Windows, 64bit machine)
@@ -38,7 +39,7 @@ test('haddock.base',
test('haddock.Cabal',
[unless(in_tree_compiler(), skip)
,stats_num_field('bytes allocated',
- [(wordsize(64), 4267311856, 5)
+ [(wordsize(64), 4660249216, 5)
# 2012-08-14: 3255435248 (amd64/Linux)
# 2012-08-29: 3324606664 (amd64/Linux, new codegen)
# 2012-10-08: 3373401360 (amd64/Linux)
@@ -52,6 +53,7 @@ test('haddock.Cabal',
# 2014-06-29: 4200993768 (amd64/Linux)
# 2014-08-05: 4493770224 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs)
# 2014-08-29: 4267311856 (x86_64/Linux - w/w for INLINABLE things)
+ # 2014-09-09: 4660249216 (x86_64/Linux - Applicative/Monad changes)
,(platform('i386-unknown-mingw32'), 2052220292, 5)
# 2012-10-30: 1733638168 (x86/Windows)
diff --git a/testsuite/tests/polykinds/MonoidsFD.hs b/testsuite/tests/polykinds/MonoidsFD.hs
index 7cf9a599dd..f093d77663 100644
--- a/testsuite/tests/polykinds/MonoidsFD.hs
+++ b/testsuite/tests/polykinds/MonoidsFD.hs
@@ -13,7 +13,7 @@
{-# LANGUAGE UnicodeSyntax #-}
module Main where
-import Control.Monad (Monad(..), join)
+import Control.Monad (Monad(..), join, ap)
import Data.Monoid (Monoid(..))
-- First we define the type class Monoidy:
@@ -85,6 +85,10 @@ instance Monoidy (→) (,) () m ⇒ Monoid m where
mempty = munit ()
mappend = curry mjoin
+instance Applicative Wrapper where
+ pure = return
+ (<*>) = ap
+
-- instance (Functor m, Monoidy NT FC Id m) ⇒ Monad m where
instance Monad Wrapper where
return x = runNT munit $ Id x
diff --git a/testsuite/tests/polykinds/MonoidsTF.hs b/testsuite/tests/polykinds/MonoidsTF.hs
index f289912ec6..9097e53af2 100644
--- a/testsuite/tests/polykinds/MonoidsTF.hs
+++ b/testsuite/tests/polykinds/MonoidsTF.hs
@@ -12,7 +12,7 @@
{-# LANGUAGE TypeFamilies #-}
module Main where
-import Control.Monad (Monad(..), join)
+import Control.Monad (Monad(..), join, ap, liftM)
import Data.Monoid (Monoid(..))
-- First we define the type class Monoidy:
@@ -96,6 +96,10 @@ instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m)
mempty = munit ()
mappend = curry mjoin
+instance Applicative Wrapper where
+ pure = return
+ (<*>) = ap
+
instance Monad Wrapper where
return x = runNT munit $ Id x
x >>= f = runNT mjoin $ FC (f `fmap` x)
diff --git a/testsuite/tests/rebindable/rebindable2.hs b/testsuite/tests/rebindable/rebindable2.hs
index 7b626585ba..2f69ac8f3f 100644
--- a/testsuite/tests/rebindable/rebindable2.hs
+++ b/testsuite/tests/rebindable/rebindable2.hs
@@ -7,16 +7,26 @@ module Main where
import Prelude(String,undefined,Maybe(..),IO,putStrLn,
Integer,(++),Rational, (==), (>=) );
- import Prelude(Monad(..));
+ import Prelude(Monad(..),Applicative(..),Functor(..));
+ import Control.Monad(ap, liftM);
debugFunc :: String -> IO a -> IO a;
debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
- (ioa Prelude.>>= (\a ->
+ (ioa Prelude.>>= (\a ->
(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
));
newtype TM a = MkTM {unTM :: IO a};
+ instance (Functor TM) where
+ {
+ fmap = liftM;
+ };
+ instance (Applicative TM) where
+ {
+ pure = return;
+ (<*>) = ap;
+ };
instance (Monad TM) where
{
return a = MkTM (debugFunc "return" (Prelude.return a));
diff --git a/testsuite/tests/rename/should_compile/T1954.hs b/testsuite/tests/rename/should_compile/T1954.hs
index dfcb551830..210be399df 100644
--- a/testsuite/tests/rename/should_compile/T1954.hs
+++ b/testsuite/tests/rename/should_compile/T1954.hs
@@ -2,7 +2,5 @@
{-# OPTIONS_GHC -Wall -Werror #-}
module Bug(P) where
-import Control.Applicative (Applicative)
-
newtype P a = P (IO a) deriving (Functor, Applicative, Monad)
diff --git a/testsuite/tests/rename/should_compile/T7145a.hs b/testsuite/tests/rename/should_compile/T7145a.hs
index 501915fcc5..8870689687 100644
--- a/testsuite/tests/rename/should_compile/T7145a.hs
+++ b/testsuite/tests/rename/should_compile/T7145a.hs
@@ -1,3 +1,2 @@
module T7145a ( Applicative(pure) ) where
-import Control.Applicative ( Applicative(pure) )
diff --git a/testsuite/tests/rename/should_compile/T7145b.stderr b/testsuite/tests/rename/should_compile/T7145b.stderr
index ed2333e8c4..d5f7c08558 100644
--- a/testsuite/tests/rename/should_compile/T7145b.stderr
+++ b/testsuite/tests/rename/should_compile/T7145b.stderr
@@ -1,2 +1,2 @@
-T7145b.hs:7:1: Warning: Defined but not used: ‘pure’
+T7145b.hs:7:1: Warning: Defined but not used: ‘T7145b.pure’
diff --git a/testsuite/tests/rename/should_fail/T2993.stderr b/testsuite/tests/rename/should_fail/T2993.stderr
index 00679dd1a5..907a03447b 100644
--- a/testsuite/tests/rename/should_fail/T2993.stderr
+++ b/testsuite/tests/rename/should_fail/T2993.stderr
@@ -1,2 +1,4 @@
-T2993.hs:7:13: Not in scope: ‘<$>’
+T2993.hs:7:13:
+ Not in scope: ‘<$>’
+ Perhaps you meant ‘<*>’ (imported from Prelude)
diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr
index ba72af4566..ba77c4695e 100644
--- a/testsuite/tests/simplCore/should_compile/T8848.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8848.stderr
@@ -17,14 +17,12 @@ Rule fired: Class op $p1Applicative
Rule fired: Class op fmap
Rule fired: Class op <*>
Rule fired:
- SPEC/main@main:T8848 Control.Applicative.liftA2 _ _ _ @ (T8848.Shape
- 'T8848.Z)
+ SPEC/main@main:T8848 GHC.Base.liftA2 _ _ _ @ (T8848.Shape 'T8848.Z)
Rule fired: Class op $p1Applicative
Rule fired: Class op fmap
Rule fired: Class op <*>
Rule fired:
- SPEC/main@main:T8848 Control.Applicative.liftA2 _ _ _ @ (T8848.Shape
- 'T8848.Z)
+ SPEC/main@main:T8848 GHC.Base.liftA2 _ _ _ @ (T8848.Shape 'T8848.Z)
Rule fired: Class op $p1Applicative
Rule fired: Class op fmap
Rule fired: Class op <*>
diff --git a/testsuite/tests/simplCore/should_compile/simpl017.hs b/testsuite/tests/simplCore/should_compile/simpl017.hs
index 8c801a44f3..31ba7510d4 100644
--- a/testsuite/tests/simplCore/should_compile/simpl017.hs
+++ b/testsuite/tests/simplCore/should_compile/simpl017.hs
@@ -7,6 +7,7 @@
module M(foo) where
+import Control.Monad
import Control.Monad.ST
import Data.Array.ST
@@ -25,6 +26,16 @@ runE :: E' v m a -> m a
runE (E t) = t
runE (V t _) = t
+instance Monad m => Functor (E' RValue m) where
+ {-# INLINE fmap #-}
+ fmap f x = liftM f x
+
+instance Monad m => Applicative (E' RValue m) where
+ {-# INLINE pure #-}
+ pure x = return x
+ {-# INLINE (<*>) #-}
+ (<*>) = ap
+
instance (Monad m) => Monad (E' RValue m) where
{-# INLINE return #-}
return x = E $ return x
diff --git a/testsuite/tests/simplCore/should_compile/simpl017.stderr b/testsuite/tests/simplCore/should_compile/simpl017.stderr
index 18b0a692ce..5d4dc582e6 100644
--- a/testsuite/tests/simplCore/should_compile/simpl017.stderr
+++ b/testsuite/tests/simplCore/should_compile/simpl017.stderr
@@ -1,37 +1,37 @@
-simpl017.hs:44:12:
+simpl017.hs:55:12:
Couldn't match expected type ‘forall v. [E m i] -> E' v m a’
with actual type ‘[E m i] -> E' v0 m a’
Relevant bindings include
- f :: [E m i] -> E' v0 m a (bound at simpl017.hs:43:9)
- ix :: [E m i] -> m i (bound at simpl017.hs:41:9)
- a :: arr i a (bound at simpl017.hs:39:11)
+ f :: [E m i] -> E' v0 m a (bound at simpl017.hs:54:9)
+ ix :: [E m i] -> m i (bound at simpl017.hs:52:9)
+ a :: arr i a (bound at simpl017.hs:50:11)
liftArray :: arr i a -> E m (forall v. [E m i] -> E' v m a)
- (bound at simpl017.hs:39:1)
+ (bound at simpl017.hs:50:1)
In the first argument of ‘return’, namely ‘f’
In a stmt of a 'do' block: return f
-simpl017.hs:63:5:
+simpl017.hs:74:5:
Couldn't match expected type ‘[E (ST t0) Int] -> E (ST s) Int’
with actual type ‘forall v. [E (ST s) Int] -> E' v (ST s) Int’
Relevant bindings include
a :: forall v. [E (ST s) Int] -> E' v (ST s) Int
- (bound at simpl017.hs:60:5)
- ma :: STArray s Int Int (bound at simpl017.hs:59:5)
- foo :: STArray s Int Int -> ST s Int (bound at simpl017.hs:59:1)
+ (bound at simpl017.hs:71:5)
+ ma :: STArray s Int Int (bound at simpl017.hs:70:5)
+ foo :: STArray s Int Int -> ST s Int (bound at simpl017.hs:70:1)
The function ‘a’ is applied to one argument,
but its type ‘forall v. [E (ST s) Int] -> E' v (ST s) Int’ has none
In the first argument of ‘plus’, namely ‘a [one]’
In a stmt of a 'do' block: a [one] `plus` a [one]
-simpl017.hs:63:19:
+simpl017.hs:74:19:
Couldn't match expected type ‘[E (ST t1) Int] -> E (ST s) Int’
with actual type ‘forall v. [E (ST s) Int] -> E' v (ST s) Int’
Relevant bindings include
a :: forall v. [E (ST s) Int] -> E' v (ST s) Int
- (bound at simpl017.hs:60:5)
- ma :: STArray s Int Int (bound at simpl017.hs:59:5)
- foo :: STArray s Int Int -> ST s Int (bound at simpl017.hs:59:1)
+ (bound at simpl017.hs:71:5)
+ ma :: STArray s Int Int (bound at simpl017.hs:70:5)
+ foo :: STArray s Int Int -> ST s Int (bound at simpl017.hs:70:1)
The function ‘a’ is applied to one argument,
but its type ‘forall v. [E (ST s) Int] -> E' v (ST s) Int’ has none
In the second argument of ‘plus’, namely ‘a [one]’
diff --git a/testsuite/tests/simplCore/should_run/T3591.hs b/testsuite/tests/simplCore/should_run/T3591.hs
index 491ba5fa17..6ec51a14d5 100644
--- a/testsuite/tests/simplCore/should_run/T3591.hs
+++ b/testsuite/tests/simplCore/should_run/T3591.hs
@@ -43,7 +43,7 @@
module Main where
-import Control.Monad (liftM, liftM2, when)
+import Control.Monad (liftM, liftM2, when, ap)
-- import Control.Monad.Identity
import Debug.Trace (trace)
@@ -66,11 +66,16 @@ instance ( Functor a
=> AncestorFunctor a d where
liftFunctor = LeftF . (trace "liftFunctor other" . liftFunctor :: a x -> d' x)
+-------------
+newtype Identity a = Identity { runIdentity :: a }
+instance Functor Identity where
+ fmap = liftM
+instance Applicative Identity where
+ pure = return
+ (<*>) = ap
--------------
-newtype Identity a = Identity { runIdentity :: a }
instance Monad Identity where
return a = Identity a
m >>= k = k (runIdentity m)
@@ -78,6 +83,13 @@ instance Monad Identity where
newtype Trampoline m s r = Trampoline {bounce :: m (TrampolineState m s r)}
data TrampolineState m s r = Done r | Suspend! (s (Trampoline m s r))
+instance (Monad m, Functor s) => Functor (Trampoline m s) where
+ fmap = liftM
+
+instance (Monad m, Functor s) => Applicative (Trampoline m s) where
+ pure = return
+ (<*>) = ap
+
instance (Monad m, Functor s) => Monad (Trampoline m s) where
return x = Trampoline (return (Done x))
t >>= f = Trampoline (bounce t >>= apply f)
diff --git a/testsuite/tests/typecheck/should_compile/T4524.hs b/testsuite/tests/typecheck/should_compile/T4524.hs
index c59ad08b0a..0b2e5387c5 100644
--- a/testsuite/tests/typecheck/should_compile/T4524.hs
+++ b/testsuite/tests/typecheck/should_compile/T4524.hs
@@ -28,7 +28,7 @@
module T4524 where
import Data.Maybe ( mapMaybe )
-import Control.Monad ( MonadPlus, mplus, msum, mzero )
+import Control.Monad (Alternative(..), MonadPlus(..), msum, ap, liftM )
import Unsafe.Coerce (unsafeCoerce)
newtype FileName = FN FilePath deriving ( Eq, Ord )
@@ -157,6 +157,13 @@ unsafeCoerceP1 = unsafeCoerce
data Perhaps a = Unknown | Failed | Succeeded a
+instance Functor Perhaps where
+ fmap = liftM
+
+instance Applicative Perhaps where
+ pure = return
+ (<*>) = ap
+
instance Monad Perhaps where
(Succeeded x) >>= k = k x
Failed >>= _ = Failed
@@ -167,6 +174,10 @@ instance Monad Perhaps where
return = Succeeded
fail _ = Unknown
+instance Alternative Perhaps where
+ (<|>) = mplus
+ empty = mzero
+
instance MonadPlus Perhaps where
mzero = Unknown
Unknown `mplus` ys = ys
diff --git a/testsuite/tests/typecheck/should_compile/T4969.hs b/testsuite/tests/typecheck/should_compile/T4969.hs
index ce2e820f22..2bdd4a7e98 100644
--- a/testsuite/tests/typecheck/should_compile/T4969.hs
+++ b/testsuite/tests/typecheck/should_compile/T4969.hs
@@ -8,7 +8,7 @@
module Q where
-import Control.Monad (foldM)
+import Control.Monad (foldM, liftM, ap)
data NameId = NameId
data Named name a = Named
@@ -79,6 +79,13 @@ instance Monad m => MonadState TCState (TCMT m) where
instance Monad m => MonadTCM (TCMT m) where
liftTCM = undefined
+instance Functor (TCMT m) where
+ fmap = liftM
+
+instance Applicative (TCMT m) where
+ pure = return
+ (<*>) = ap
+
instance Monad (TCMT m) where
return = undefined
(>>=) = undefined
diff --git a/testsuite/tests/typecheck/should_compile/tc213.hs b/testsuite/tests/typecheck/should_compile/tc213.hs
index 1f0b46449a..8034606cfb 100644
--- a/testsuite/tests/typecheck/should_compile/tc213.hs
+++ b/testsuite/tests/typecheck/should_compile/tc213.hs
@@ -5,7 +5,7 @@
-- type signature in t1 and t2
module Foo7 where
-import Control.Monad
+import Control.Monad hiding (empty)
import Control.Monad.ST
import Data.Array.MArray
import Data.Array.ST