diff options
author | Austin Seipp <austin@well-typed.com> | 2014-04-22 06:09:40 -0500 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2014-09-09 08:13:27 -0500 |
commit | d94de87252d0fe2ae97341d186b03a2fbe136b04 (patch) | |
tree | 1cac19f2786b1d8a1626886cd6373946a3a276b0 /testsuite | |
parent | fdfe6c0e50001add357475a1a3a7627243a28a70 (diff) | |
download | haskell-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')
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 |