diff options
| -rw-r--r-- | libraries/base/Control/Monad/Zip.hs | 6 | ||||
| -rw-r--r-- | libraries/base/Data/Bifoldable.hs | 428 | ||||
| -rw-r--r-- | libraries/base/Data/Bitraversable.hs | 228 | ||||
| -rw-r--r-- | libraries/base/Data/Data.hs | 28 | ||||
| -rw-r--r-- | libraries/base/Data/Foldable.hs | 64 | ||||
| -rw-r--r-- | libraries/base/Data/Functor/Identity.hs | 34 | ||||
| -rw-r--r-- | libraries/base/Data/Functor/Utils.hs | 106 | ||||
| -rw-r--r-- | libraries/base/Data/Semigroup.hs | 31 | ||||
| -rw-r--r-- | libraries/base/Data/String.hs | 10 | ||||
| -rw-r--r-- | libraries/base/Data/Traversable.hs | 50 | ||||
| -rw-r--r-- | libraries/base/base.cabal | 3 | ||||
| -rw-r--r-- | libraries/base/changelog.md | 3 | ||||
| -rw-r--r-- | testsuite/tests/annotations/should_fail/annfail10.stderr | 4 | ||||
| -rw-r--r-- | testsuite/tests/perf/compiler/all.T | 3 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T10971b.stderr | 8 |
15 files changed, 847 insertions, 159 deletions
diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs index f102ff06ad..5b670085d4 100644 --- a/libraries/base/Control/Monad/Zip.hs +++ b/libraries/base/Control/Monad/Zip.hs @@ -19,6 +19,7 @@ module Control.Monad.Zip where import Control.Monad (liftM, liftM2) +import Data.Functor.Identity import Data.Monoid import Data.Proxy import GHC.Generics @@ -59,6 +60,11 @@ instance MonadZip [] where munzip = unzip -- | @since 4.8.0.0 +instance MonadZip Identity where + mzipWith = liftM2 + munzip (Identity (a, b)) = (Identity a, Identity b) + +-- | @since 4.8.0.0 instance MonadZip Dual where -- Cannot use coerce, it's unsafe mzipWith = liftM2 diff --git a/libraries/base/Data/Bifoldable.hs b/libraries/base/Data/Bifoldable.hs new file mode 100644 index 0000000000..11a1c25df5 --- /dev/null +++ b/libraries/base/Data/Bifoldable.hs @@ -0,0 +1,428 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Bifoldable +-- Copyright : (C) 2011-2016 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- @since 4.10.0.0 +---------------------------------------------------------------------------- +module Data.Bifoldable + ( Bifoldable(..) + , bifoldr' + , bifoldr1 + , bifoldrM + , bifoldl' + , bifoldl1 + , bifoldlM + , bitraverse_ + , bifor_ + , bimapM_ + , biforM_ + , bimsum + , bisequenceA_ + , bisequence_ + , biasum + , biList + , binull + , bilength + , bielem + , bimaximum + , biminimum + , bisum + , biproduct + , biconcat + , biconcatMap + , biand + , bior + , biany + , biall + , bimaximumBy + , biminimumBy + , binotElem + , bifind + ) where + +import Control.Applicative +import Data.Functor.Utils (Max(..), Min(..), (#.)) +import Data.Maybe (fromMaybe) +import Data.Monoid +import GHC.Generics (K1(..)) + +-- | 'Bifoldable' identifies foldable structures with two different varieties +-- of elements (as opposed to 'Foldable', which has one variety of element). +-- Common examples are 'Either' and '(,)': +-- +-- > instance Bifoldable Either where +-- > bifoldMap f _ (Left a) = f a +-- > bifoldMap _ g (Right b) = g b +-- > +-- > instance Bifoldable (,) where +-- > bifoldr f g z (a, b) = f a (g b z) +-- +-- A minimal 'Bifoldable' definition consists of either 'bifoldMap' or +-- 'bifoldr'. When defining more than this minimal set, one should ensure +-- that the following identities hold: +-- +-- @ +-- 'bifold' ≡ 'bifoldMap' 'id' 'id' +-- 'bifoldMap' f g ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty' +-- 'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' (Endo . f) (Endo . g) t) z +-- @ +-- +-- If the type is also a 'Bifunctor' instance, it should satisfy: +-- +-- > 'bifoldMap' f g ≡ 'bifold' . 'bimap' f g +-- +-- which implies that +-- +-- > 'bifoldMap' f g . 'bimap' h i ≡ 'bifoldMap' (f . h) (g . i) +-- +-- @since 4.10.0.0 +class Bifoldable p where + {-# MINIMAL bifoldr | bifoldMap #-} + + -- | Combines the elements of a structure using a monoid. + -- + -- @'bifold' ≡ 'bifoldMap' 'id' 'id'@ + -- + -- @since 4.10.0.0 + bifold :: Monoid m => p m m -> m + bifold = bifoldMap id id + + -- | Combines the elements of a structure, given ways of mapping them to a + -- common monoid. + -- + -- @'bifoldMap' f g + -- ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@ + -- + -- @since 4.10.0.0 + bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m + bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty + + -- | Combines the elements of a structure in a right associative manner. + -- Given a hypothetical function @toEitherList :: p a b -> [Either a b]@ + -- yielding a list of all elements of a structure in order, the following + -- would hold: + -- + -- @'bifoldr' f g z ≡ 'foldr' ('either' f g) z . toEitherList@ + -- + -- @since 4.10.0.0 + bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c + bifoldr f g z t = appEndo (bifoldMap (Endo #. f) (Endo #. g) t) z + + -- | Combines the elments of a structure in a left associative manner. Given + -- a hypothetical function @toEitherList :: p a b -> [Either a b]@ yielding a + -- list of all elements of a structure in order, the following would hold: + -- + -- @'bifoldl' f g z + -- ≡ 'foldl' (\acc -> 'either' (f acc) (g acc)) z . toEitherList@ + -- + -- Note that if you want an efficient left-fold, you probably want to use + -- 'bifoldl'' instead of 'bifoldl'. The reason is that the latter does not + -- force the "inner" results, resulting in a thunk chain which then must be + -- evaluated from the outside-in. + -- + -- @since 4.10.0.0 + bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c + bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f) + (Dual . Endo . flip g) t)) z + +-- | @since 4.10.0.0 +instance Bifoldable (,) where + bifoldMap f g ~(a, b) = f a `mappend` g b + +-- | @since 4.10.0.0 +instance Bifoldable Const where + bifoldMap f _ (Const a) = f a + +-- | @since 4.10.0.0 +instance Bifoldable (K1 i) where + bifoldMap f _ (K1 c) = f c + +-- | @since 4.10.0.0 +instance Bifoldable ((,,) x) where + bifoldMap f g ~(_,a,b) = f a `mappend` g b + +-- | @since 4.10.0.0 +instance Bifoldable ((,,,) x y) where + bifoldMap f g ~(_,_,a,b) = f a `mappend` g b + +-- | @since 4.10.0.0 +instance Bifoldable ((,,,,) x y z) where + bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b + +-- | @since 4.10.0.0 +instance Bifoldable ((,,,,,) x y z w) where + bifoldMap f g ~(_,_,_,_,a,b) = f a `mappend` g b + +-- | @since 4.10.0.0 +instance Bifoldable ((,,,,,,) x y z w v) where + bifoldMap f g ~(_,_,_,_,_,a,b) = f a `mappend` g b + +-- | @since 4.10.0.0 +instance Bifoldable Either where + bifoldMap f _ (Left a) = f a + bifoldMap _ g (Right b) = g b + +-- | As 'bifoldr', but strict in the result of the reduction functions at each +-- step. +-- +-- @since 4.10.0.0 +bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c +bifoldr' f g z0 xs = bifoldl f' g' id xs z0 where + f' k x z = k $! f x z + g' k x z = k $! g x z + +-- | A variant of 'bifoldr' that has no base case, +-- and thus may only be applied to non-empty structures. +-- +-- @since 4.10.0.0 +bifoldr1 :: Bifoldable t => (a -> a -> a) -> t a a -> a +bifoldr1 f xs = fromMaybe (error "bifoldr1: empty structure") + (bifoldr mbf mbf Nothing xs) + where + mbf x m = Just (case m of + Nothing -> x + Just y -> f x y) + +-- | Right associative monadic bifold over a structure. +-- +-- @since 4.10.0.0 +bifoldrM :: (Bifoldable t, Monad m) + => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c +bifoldrM f g z0 xs = bifoldl f' g' return xs z0 where + f' k x z = f x z >>= k + g' k x z = g x z >>= k + +-- | As 'bifoldl', but strict in the result of the reduction functions at each +-- step. +-- +-- This ensures that each step of the bifold is forced to weak head normal form +-- before being applied, avoiding the collection of thunks that would otherwise +-- occur. This is often what you want to strictly reduce a finite structure to +-- a single, monolithic result (e.g., 'bilength'). +-- +-- @since 4.10.0.0 +bifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a +bifoldl' f g z0 xs = bifoldr f' g' id xs z0 where + f' x k z = k $! f z x + g' x k z = k $! g z x + +-- | A variant of 'bifoldl' that has no base case, +-- and thus may only be applied to non-empty structures. +-- +-- @since 4.10.0.0 +bifoldl1 :: Bifoldable t => (a -> a -> a) -> t a a -> a +bifoldl1 f xs = fromMaybe (error "bifoldl1: empty structure") + (bifoldl mbf mbf Nothing xs) + where + mbf m y = Just (case m of + Nothing -> y + Just x -> f x y) + +-- | Left associative monadic bifold over a structure. +-- +-- @since 4.10.0.0 +bifoldlM :: (Bifoldable t, Monad m) + => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a +bifoldlM f g z0 xs = bifoldr f' g' return xs z0 where + f' x k z = f z x >>= k + g' x k z = g z x >>= k + +-- | Map each element of a structure using one of two actions, evaluate these +-- actions from left to right, and ignore the results. For a version that +-- doesn't ignore the results, see 'Data.Bitraversable.bitraverse'. +-- +-- @since 4.10.0.0 +bitraverse_ :: (Bifoldable t, Applicative f) + => (a -> f c) -> (b -> f d) -> t a b -> f () +bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ()) + +-- | As 'bitraverse_', but with the structure as the primary argument. For a +-- version that doesn't ignore the results, see 'Data.Bitraversable.bifor'. +-- +-- >>> > bifor_ ('a', "bc") print (print . reverse) +-- 'a' +-- "cb" +-- +-- @since 4.10.0.0 +bifor_ :: (Bifoldable t, Applicative f) + => t a b -> (a -> f c) -> (b -> f d) -> f () +bifor_ t f g = bitraverse_ f g t + +-- | Alias for 'bitraverse_'. +-- +-- @since 4.10.0.0 +bimapM_ :: (Bifoldable t, Applicative f) + => (a -> f c) -> (b -> f d) -> t a b -> f () +bimapM_ = bitraverse_ + +-- | Alias for 'bifor_'. +-- +-- @since 4.10.0.0 +biforM_ :: (Bifoldable t, Applicative f) + => t a b -> (a -> f c) -> (b -> f d) -> f () +biforM_ = bifor_ + +-- | Alias for 'bisequence_'. +-- +-- @since 4.10.0.0 +bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f () +bisequenceA_ = bisequence_ + +-- | Evaluate each action in the structure from left to right, and ignore the +-- results. For a version that doesn't ignore the results, see +-- 'Data.Bitraversable.bisequence'. +-- +-- @since 4.10.0.0 +bisequence_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f () +bisequence_ = bifoldr (*>) (*>) (pure ()) + +-- | The sum of a collection of actions, generalizing 'biconcat'. +-- +-- @since 4.10.0.0 +biasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a +biasum = bifoldr (<|>) (<|>) empty + +-- | Alias for 'biasum'. +-- +-- @since 4.10.0.0 +bimsum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a +bimsum = biasum + +-- | Collects the list of elements of a structure, from left to right. +-- +-- @since 4.10.0.0 +biList :: Bifoldable t => t a a -> [a] +biList = bifoldr (:) (:) [] + +-- | Test whether the structure is empty. +-- +-- @since 4.10.0.0 +binull :: Bifoldable t => t a b -> Bool +binull = bifoldr (\_ _ -> False) (\_ _ -> False) True + +-- | Returns the size/length of a finite structure as an 'Int'. +-- +-- @since 4.10.0.0 +bilength :: Bifoldable t => t a b -> Int +bilength = bifoldl' (\c _ -> c+1) (\c _ -> c+1) 0 + +-- | Does the element occur in the structure? +-- +-- @since 4.10.0.0 +bielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool +bielem x = biany (== x) (== x) + +-- | Reduces a structure of lists to the concatenation of those lists. +-- +-- @since 4.10.0.0 +biconcat :: Bifoldable t => t [a] [a] -> [a] +biconcat = bifold + +-- | The largest element of a non-empty structure. +-- +-- @since 4.10.0.0 +bimaximum :: forall t a. (Bifoldable t, Ord a) => t a a -> a +bimaximum = fromMaybe (error "bimaximum: empty structure") . + getMax . bifoldMap mj mj + where mj = Max #. (Just :: a -> Maybe a) + +-- | The least element of a non-empty structure. +-- +-- @since 4.10.0.0 +biminimum :: forall t a. (Bifoldable t, Ord a) => t a a -> a +biminimum = fromMaybe (error "biminimum: empty structure") . + getMin . bifoldMap mj mj + where mj = Min #. (Just :: a -> Maybe a) + +-- | The 'bisum' function computes the sum of the numbers of a structure. +-- +-- @since 4.10.0.0 +bisum :: (Bifoldable t, Num a) => t a a -> a +bisum = getSum #. bifoldMap Sum Sum + +-- | The 'biproduct' function computes the product of the numbers of a +-- structure. +-- +-- @since 4.10.0.0 +biproduct :: (Bifoldable t, Num a) => t a a -> a +biproduct = getProduct #. bifoldMap Product Product + +-- | Given a means of mapping the elements of a structure to lists, computes the +-- concatenation of all such lists in order. +-- +-- @since 4.10.0.0 +biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c] +biconcatMap = bifoldMap + +-- | 'biand' returns the conjunction of a container of Bools. For the +-- result to be 'True', the container must be finite; 'False', however, +-- results from a 'False' value finitely far from the left end. +-- +-- @since 4.10.0.0 +biand :: Bifoldable t => t Bool Bool -> Bool +biand = getAll #. bifoldMap All All + +-- | 'bior' returns the disjunction of a container of Bools. For the +-- result to be 'False', the container must be finite; 'True', however, +-- results from a 'True' value finitely far from the left end. +-- +-- @since 4.10.0.0 +bior :: Bifoldable t => t Bool Bool -> Bool +bior = getAny #. bifoldMap Any Any + +-- | Determines whether any element of the structure satisfies its appropriate +-- predicate argument. +-- +-- @since 4.10.0.0 +biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool +biany p q = getAny #. bifoldMap (Any . p) (Any . q) + +-- | Determines whether all elements of the structure satisfy their appropriate +-- predicate argument. +-- +-- @since 4.10.0.0 +biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool +biall p q = getAll #. bifoldMap (All . p) (All . q) + +-- | The largest element of a non-empty structure with respect to the +-- given comparison function. +-- +-- @since 4.10.0.0 +bimaximumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a +bimaximumBy cmp = bifoldr1 max' + where max' x y = case cmp x y of + GT -> x + _ -> y + +-- | The least element of a non-empty structure with respect to the +-- given comparison function. +-- +-- @since 4.10.0.0 +biminimumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a +biminimumBy cmp = bifoldr1 min' + where min' x y = case cmp x y of + GT -> y + _ -> x + +-- | 'binotElem' is the negation of 'bielem'. +-- +-- @since 4.10.0.0 +binotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool +binotElem x = not . bielem x + +-- | The 'bifind' function takes a predicate and a structure and returns +-- the leftmost element of the structure matching the predicate, or +-- 'Nothing' if there is no such element. +-- +-- @since 4.10.0.0 +bifind :: Bifoldable t => (a -> Bool) -> t a a -> Maybe a +bifind p = getFirst . bifoldMap finder finder + where finder x = First (if p x then Just x else Nothing) diff --git a/libraries/base/Data/Bitraversable.hs b/libraries/base/Data/Bitraversable.hs new file mode 100644 index 0000000000..7e64bb55a1 --- /dev/null +++ b/libraries/base/Data/Bitraversable.hs @@ -0,0 +1,228 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Bitraversable +-- Copyright : (C) 2011-2016 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- @since 4.10.0.0 +---------------------------------------------------------------------------- +module Data.Bitraversable + ( Bitraversable(..) + , bisequenceA + , bisequence + , bimapM + , bifor + , biforM + , bimapAccumL + , bimapAccumR + , bimapDefault + , bifoldMapDefault + ) where + +import Control.Applicative +import Data.Bifunctor +import Data.Bifoldable +import Data.Functor.Identity (Identity(..)) +import Data.Functor.Utils (StateL(..), StateR(..)) +import GHC.Generics (K1(..)) + +-- | 'Bitraversable' identifies bifunctorial data structures whose elements can +-- be traversed in order, performing 'Applicative' or 'Monad' actions at each +-- element, and collecting a result structure with the same shape. +-- +-- As opposed to 'Traversable' data structures, which have one variety of +-- element on which an action can be performed, 'Bitraversable' data structures +-- have two such varieties of elements. +-- +-- A definition of 'traverse' must satisfy the following laws: +-- +-- [/naturality/] +-- @'bitraverse' (t . f) (t . g) ≡ t . 'bitraverse' f g@ +-- for every applicative transformation @t@ +-- +-- [/identity/] +-- @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'@ +-- +-- [/composition/] +-- @'Compose' . 'fmap' ('bitraverse' g1 g2) . 'bitraverse' f1 f2 +-- ≡ 'traverse' ('Compose' . 'fmap' g1 . f1) ('Compose' . 'fmap' g2 . f2)@ +-- +-- where an /applicative transformation/ is a function +-- +-- @t :: ('Applicative' f, 'Applicative' g) => f a -> g a@ +-- +-- preserving the 'Applicative' operations: +-- +-- @ +-- t ('pure' x) = 'pure' x +-- t (f '<*>' x) = t f '<*>' t x +-- @ +-- +-- and the identity functor 'Identity' and composition functors 'Compose' are +-- defined as +-- +-- > newtype Identity a = Identity { runIdentity :: a } +-- > +-- > instance Functor Identity where +-- > fmap f (Identity x) = Identity (f x) +-- > +-- > instance Applicative Identity where +-- > pure = Identity +-- > Identity f <*> Identity x = Identity (f x) +-- > +-- > newtype Compose f g a = Compose (f (g a)) +-- > +-- > instance (Functor f, Functor g) => Functor (Compose f g) where +-- > fmap f (Compose x) = Compose (fmap (fmap f) x) +-- > +-- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where +-- > pure = Compose . pure . pure +-- > Compose f <*> Compose x = Compose ((<*>) <$> f <*> x) +-- +-- Some simple examples are 'Either' and '(,)': +-- +-- > instance Bitraversable Either where +-- > bitraverse f _ (Left x) = Left <$> f x +-- > bitraverse _ g (Right y) = Right <$> g y +-- > +-- > instance Bitraversable (,) where +-- > bitraverse f g (x, y) = (,) <$> f x <*> g y +-- +-- 'Bitraversable' relates to its superclasses in the following ways: +-- +-- @ +-- 'bimap' f g ≡ 'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g) +-- 'bifoldMap' f g = 'getConst' . 'bitraverse' ('Const' . f) ('Const' . g) +-- @ +-- +-- These are available as 'bimapDefault' and 'bifoldMapDefault' respectively. +-- +-- @since 4.10.0.0 +class (Bifunctor t, Bifoldable t) => Bitraversable t where + -- | Evaluates the relevant functions at each element in the structure, + -- running the action, and builds a new structure with the same shape, using + -- the results produced from sequencing the actions. + -- + -- @'bitraverse' f g ≡ 'bisequenceA' . 'bimap' f g@ + -- + -- For a version that ignores the results, see 'bitraverse_'. + -- + -- @since 4.10.0.0 + bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) + bitraverse f g = bisequenceA . bimap f g + +-- | Alias for 'bisequence'. +-- +-- @since 4.10.0.0 +bisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) +bisequenceA = bisequence + +-- | Alias for 'bitraverse'. +-- +-- @since 4.10.0.0 +bimapM :: (Bitraversable t, Applicative f) + => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) +bimapM = bitraverse + +-- | Sequences all the actions in a structure, building a new structure with +-- the same shape using the results of the actions. For a version that ignores +-- the results, see 'sequence_'. +-- +-- @'bisequence' ≡ 'bitraverse' 'id' 'id'@ +-- +-- @since 4.10.0.0 +bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) +bisequence = bitraverse id id + +-- | @since 4.10.0.0 +instance Bitraversable (,) where + bitraverse f g ~(a, b) = (,) <$> f a <*> g b + +-- | @since 4.10.0.0 +instance Bitraversable ((,,) x) where + bitraverse f g ~(x, a, b) = (,,) x <$> f a <*> g b + +-- | @since 4.10.0.0 +instance Bitraversable ((,,,) x y) where + bitraverse f g ~(x, y, a, b) = (,,,) x y <$> f a <*> g b + +-- | @since 4.10.0.0 +instance Bitraversable ((,,,,) x y z) where + bitraverse f g ~(x, y, z, a, b) = (,,,,) x y z <$> f a <*> g b + +-- | @since 4.10.0.0 +instance Bitraversable ((,,,,,) x y z w) where + bitraverse f g ~(x, y, z, w, a, b) = (,,,,,) x y z w <$> f a <*> g b + +-- | @since 4.10.0.0 +instance Bitraversable ((,,,,,,) x y z w v) where + bitraverse f g ~(x, y, z, w, v, a, b) = (,,,,,,) x y z w v <$> f a <*> g b + +-- | @since 4.10.0.0 +instance Bitraversable Either where + bitraverse f _ (Left a) = Left <$> f a + bitraverse _ g (Right b) = Right <$> g b + +-- | @since 4.10.0.0 +instance Bitraversable Const where + bitraverse f _ (Const a) = Const <$> f a + +-- | @since 4.10.0.0 +instance Bitraversable (K1 i) where + bitraverse f _ (K1 c) = K1 <$> f c + +-- | 'bifor' is 'bitraverse' with the structure as the first argument. For a +-- version that ignores the results, see 'bifor_'. +-- +-- @since 4.10.0.0 +bifor :: (Bitraversable t, Applicative f) + => t a b -> (a -> f c) -> (b -> f d) -> f (t c d) +bifor t f g = bitraverse f g t + +-- | Alias for 'bifor'. +-- +-- @since 4.10.0.0 +biforM :: (Bitraversable t, Applicative f) + => t a b -> (a -> f c) -> (b -> f d) -> f (t c d) +biforM = bifor + +-- | The 'bimapAccumL' function behaves like a combination of 'bimap' and +-- 'bifoldl'; it traverses a structure from left to right, threading a state +-- of type @a@ and using the given actions to compute new elements for the +-- structure. +-- +-- @since 4.10.0.0 +bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) + -> a -> t b d -> (a, t c e) +bimapAccumL f g s t + = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s + +-- | The 'bimapAccumR' function behaves like a combination of 'bimap' and +-- 'bifoldl'; it traverses a structure from right to left, threading a state +-- of type @a@ and using the given actions to compute new elements for the +-- structure. +-- +-- @since 4.10.0.0 +bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) + -> a -> t b d -> (a, t c e) +bimapAccumR f g s t + = runStateR (bitraverse (StateR . flip f) (StateR . flip g) t) s + +-- | A default definition of 'bimap' in terms of the 'Bitraversable' +-- operations. +-- +-- @since 4.10.0.0 +bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d +bimapDefault f g = runIdentity . bitraverse (Identity . f) (Identity . g) + +-- | A default definition of 'bifoldMap' in terms of the 'Bitraversable' +-- operations. +-- +-- @since 4.10.0.0 +bifoldMapDefault :: (Bitraversable t, Monoid m) + => (a -> m) -> (b -> m) -> t a b -> m +bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g) diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 32e3832401..0e40b1759d 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -129,6 +129,7 @@ import GHC.Show import Text.Read( reads ) -- Imports for the instances +import Data.Functor.Identity -- So we can give Data instance for Identity import Data.Int -- So we can give Data instance for Int8, ... import Data.Type.Coercion import Data.Word -- So we can give Data instance for Word8, ... @@ -310,14 +311,14 @@ class Typeable a => Data a where -- isomorphism pair as injection and projection. gmapT :: (forall b. Data b => b -> b) -> a -> a - -- Use an identity datatype constructor ID (see below) + -- Use the Identity datatype constructor -- to instantiate the type constructor c in the type of gfoldl, - -- and perform injections ID and projections unID accordingly. + -- and perform injections Identity and projections runIdentity accordingly. -- - gmapT f x0 = unID (gfoldl k ID x0) + gmapT f x0 = runIdentity (gfoldl k Identity x0) where - k :: Data d => ID (d->b) -> d -> ID b - k (ID c) x = ID (c (f x)) + k :: Data d => Identity (d->b) -> d -> Identity b + k (Identity c) x = Identity (c (f x)) -- | A generic query with a left-associative binary operator @@ -423,10 +424,6 @@ was transformed successfully. ) --- | The identity type constructor needed for the definition of gmapT -newtype ID x = ID { unID :: x } - - -- | The constant type constructor needed for the definition of gmapQl newtype CONST c a = CONST { unCONST :: c } @@ -461,13 +458,13 @@ fromConstrB :: Data a => (forall d. Data d => d) -> Constr -> a -fromConstrB f = unID . gunfold k z +fromConstrB f = runIdentity . gunfold k z where - k :: forall b r. Data b => ID (b -> r) -> ID r - k c = ID (unID c f) + k :: forall b r. Data b => Identity (b -> r) -> Identity r + k c = Identity (runIdentity c f) - z :: forall r. r -> ID r - z = ID + z :: forall r. r -> Identity r + z = Identity -- | Monadic variation on 'fromConstrB' @@ -1200,6 +1197,9 @@ deriving instance (a ~ b, Data a) => Data (a :~: b) -- | @since 4.7.0.0 deriving instance (Coercible a b, Data a, Data b) => Data (Coercion a b) +-- | @since 4.9.0.0 +deriving instance Data a => Data (Identity a) + -- | @since 4.7.0.0 deriving instance Data Version diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 7443117cac..6ad549f0fe 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -54,6 +54,7 @@ module Data.Foldable ( import Data.Bool import Data.Either import Data.Eq +import Data.Functor.Utils (Max(..), Min(..), (#.)) import qualified GHC.List as List import Data.Maybe import Data.Monoid @@ -406,37 +407,6 @@ instance Foldable First where instance Foldable Last where foldMap f = foldMap f . getLast --- We don't export Max and Min because, as Edward Kmett pointed out to me, --- there are two reasonable ways to define them. One way is to use Maybe, as we --- do here; the other way is to impose a Bounded constraint on the Monoid --- instance. We may eventually want to add both versions, but we don't want to --- trample on anyone's toes by imposing Max = MaxMaybe. - -newtype Max a = Max {getMax :: Maybe a} -newtype Min a = Min {getMin :: Maybe a} - --- | @since 4.8.0.0 -instance Ord a => Monoid (Max a) where - mempty = Max Nothing - - {-# INLINE mappend #-} - m `mappend` Max Nothing = m - Max Nothing `mappend` n = n - (Max m@(Just x)) `mappend` (Max n@(Just y)) - | x >= y = Max m - | otherwise = Max n - --- | @since 4.8.0.0 -instance Ord a => Monoid (Min a) where - mempty = Min Nothing - - {-# INLINE mappend #-} - m `mappend` Min Nothing = m - Min Nothing `mappend` n = n - (Min m@(Just x)) `mappend` (Min n@(Just y)) - | x <= y = Min m - | otherwise = Min n - -- Instances for GHC.Generics -- | @since 4.9.0.0 instance Foldable U1 where @@ -603,35 +573,3 @@ notElem x = not . elem x -- 'Nothing' if there is no such element. find :: Foldable t => (a -> Bool) -> t a -> Maybe a find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing)) - --- See Note [Function coercion] -(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c) -(#.) _f = coerce -{-# INLINE (#.) #-} - -{- -Note [Function coercion] -~~~~~~~~~~~~~~~~~~~~~~~~ - -Several functions here use (#.) instead of (.) to avoid potential efficiency -problems relating to #7542. The problem, in a nutshell: - -If N is a newtype constructor, then N x will always have the same -representation as x (something similar applies for a newtype deconstructor). -However, if f is a function, - -N . f = \x -> N (f x) - -This looks almost the same as f, but the eta expansion lifts it--the lhs could -be _|_, but the rhs never is. This can lead to very inefficient code. Thus we -steal a technique from Shachaf and Edward Kmett and adapt it to the current -(rather clean) setting. Instead of using N . f, we use N .## f, which is -just - -coerce f `asTypeOf` (N . f) - -That is, we just *pretend* that f has the right type, and thanks to the safety -of coerce, the type checker guarantees that nothing really goes wrong. We still -have to be a bit careful, though: remember that #. completely ignores the -*value* of its left operand. --} diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs index 1adfaebeff..492ba84600 100644 --- a/libraries/base/Data/Functor/Identity.hs +++ b/libraries/base/Data/Functor/Identity.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- @@ -35,24 +36,30 @@ module Data.Functor.Identity ( ) where import Control.Monad.Fix -import Control.Monad.Zip import Data.Bits (Bits, FiniteBits) import Data.Coerce -import Data.Data (Data) import Data.Foldable -import Data.Ix (Ix) -import Data.Semigroup (Semigroup) -import Data.String (IsString) +import Data.Functor.Utils ((#.)) import Foreign.Storable (Storable) +import GHC.Arr (Ix) +import GHC.Base ( Applicative(..), Eq(..), Functor(..), Monad(..) + , Monoid, Ord(..), ($), (.) ) +import GHC.Enum (Bounded, Enum) +import GHC.Float (Floating, RealFloat) import GHC.Generics (Generic, Generic1) +import GHC.Num (Num) +import GHC.Read (Read(..), lex, readParen) +import GHC.Real (Fractional, Integral, Real, RealFrac) +import GHC.Show (Show(..), showParen, showString) +import GHC.Types (Bool(..)) -- | Identity functor and monad. (a non-strict monad) -- -- @since 4.8.0.0 newtype Identity a = Identity { runIdentity :: a } - deriving ( Bits, Bounded, Data, Enum, Eq, FiniteBits, Floating, Fractional - , Generic, Generic1, Integral, IsString, Ix, Monoid, Num, Ord - , Real, RealFrac, RealFloat , Semigroup, Storable, Traversable) + deriving ( Bits, Bounded, Enum, Eq, FiniteBits, Floating, Fractional + , Generic, Generic1, Integral, Ix, Monoid, Num, Ord + , Real, RealFrac, RealFloat, Storable) -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed @@ -108,14 +115,3 @@ instance Monad Identity where -- | @since 4.8.0.0 instance MonadFix Identity where mfix f = Identity (fix (runIdentity . f)) - --- | @since 4.8.0.0 -instance MonadZip Identity where - mzipWith = coerce - munzip = coerce - --- | Internal (non-exported) 'Coercible' helper for 'elem' --- --- See Note [Function coercion] in "Data.Foldable" for more details. -(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c -(#.) _f = coerce diff --git a/libraries/base/Data/Functor/Utils.hs b/libraries/base/Data/Functor/Utils.hs new file mode 100644 index 0000000000..e24d235894 --- /dev/null +++ b/libraries/base/Data/Functor/Utils.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- This is a non-exposed internal module. +-- +-- This code contains utility function and data structures that are used +-- to improve the efficiency of several instances in the Data.* namespace. +----------------------------------------------------------------------------- +module Data.Functor.Utils where + +import Data.Coerce (Coercible, coerce) +import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..) + , ($), otherwise ) + +-- We don't expose Max and Min because, as Edward Kmett pointed out to me, +-- there are two reasonable ways to define them. One way is to use Maybe, as we +-- do here; the other way is to impose a Bounded constraint on the Monoid +-- instance. We may eventually want to add both versions, but we don't want to +-- trample on anyone's toes by imposing Max = MaxMaybe. + +newtype Max a = Max {getMax :: Maybe a} +newtype Min a = Min {getMin :: Maybe a} + +-- | @since 4.8.0.0 +instance Ord a => Monoid (Max a) where + mempty = Max Nothing + + {-# INLINE mappend #-} + m `mappend` Max Nothing = m + Max Nothing `mappend` n = n + (Max m@(Just x)) `mappend` (Max n@(Just y)) + | x >= y = Max m + | otherwise = Max n + +-- | @since 4.8.0.0 +instance Ord a => Monoid (Min a) where + mempty = Min Nothing + + {-# INLINE mappend #-} + m `mappend` Min Nothing = m + Min Nothing `mappend` n = n + (Min m@(Just x)) `mappend` (Min n@(Just y)) + | x <= y = Min m + | otherwise = Min n + +-- left-to-right state transformer +newtype StateL s a = StateL { runStateL :: s -> (s, a) } + +-- | @since 4.0 +instance Functor (StateL s) where + fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v) + +-- | @since 4.0 +instance Applicative (StateL s) where + pure x = StateL (\ s -> (s, x)) + StateL kf <*> StateL kv = StateL $ \ s -> + let (s', f) = kf s + (s'', v) = kv s' + in (s'', f v) + +-- right-to-left state transformer +newtype StateR s a = StateR { runStateR :: s -> (s, a) } + +-- | @since 4.0 +instance Functor (StateR s) where + fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v) + +-- | @since 4.0 +instance Applicative (StateR s) where + pure x = StateR (\ s -> (s, x)) + StateR kf <*> StateR kv = StateR $ \ s -> + let (s', v) = kv s + (s'', f) = kf s' + in (s'', f v) + +-- See Note [Function coercion] +(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c) +(#.) _f = coerce +{-# INLINE (#.) #-} + +{- +Note [Function coercion] +~~~~~~~~~~~~~~~~~~~~~~~ + +Several functions here use (#.) instead of (.) to avoid potential efficiency +problems relating to #7542. The problem, in a nutshell: + +If N is a newtype constructor, then N x will always have the same +representation as x (something similar applies for a newtype deconstructor). +However, if f is a function, + +N . f = \x -> N (f x) + +This looks almost the same as f, but the eta expansion lifts it--the lhs could +be _|_, but the rhs never is. This can lead to very inefficient code. Thus we +steal a technique from Shachaf and Edward Kmett and adapt it to the current +(rather clean) setting. Instead of using N . f, we use N #. f, which is +just + +coerce f `asTypeOf` (N . f) + +That is, we just *pretend* that f has the right type, and thanks to the safety +of coerce, the type checker guarantees that nothing really goes wrong. We still +have to be a bit careful, though: remember that #. completely ignores the +*value* of its left operand. +-} diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index 24237a7877..63d42854c0 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- | @@ -70,9 +71,12 @@ import Prelude hiding (foldr1) import Control.Applicative import Control.Monad import Control.Monad.Fix +import Data.Bifoldable import Data.Bifunctor +import Data.Bitraversable import Data.Coerce import Data.Data +import Data.Functor.Identity import Data.List.NonEmpty import Data.Monoid (All (..), Any (..), Dual (..), Endo (..), Product (..), Sum (..)) @@ -280,6 +284,11 @@ stimesIdempotent n x | otherwise = x -- | @since 4.9.0.0 +instance Semigroup a => Semigroup (Identity a) where + (<>) = coerce ((<>) :: a -> a -> a) + stimes n (Identity a) = Identity (stimes n a) + +-- | @since 4.9.0.0 instance Semigroup a => Semigroup (Const a b) where (<>) = coerce ((<>) :: a -> a -> a) stimes n (Const a) = Const (stimes n a) @@ -474,6 +483,12 @@ instance Ord a => Ord (Arg a b) where instance Bifunctor Arg where bimap f g (Arg a b) = Arg (f a) (g b) +instance Bifoldable Arg where + bifoldMap f g (Arg a b) = f a `mappend` g b + +instance Bitraversable Arg where + bitraverse f g (Arg a b) = Arg <$> f a <*> g b + -- | Use @'Option' ('First' a)@ to get the behavior of -- 'Data.Monoid.First' from "Data.Monoid". newtype First a = First { getFirst :: a } deriving diff --git a/libraries/base/Data/String.hs b/libraries/base/Data/String.hs index db2f510b6a..e9f34a82a9 100644 --- a/libraries/base/Data/String.hs +++ b/libraries/base/Data/String.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- @@ -29,6 +32,7 @@ module Data.String ( import GHC.Base import Data.Functor.Const (Const (Const)) +import Data.Functor.Identity (Identity (Identity)) import Data.List (lines, words, unlines, unwords) -- | Class for string-like datastructures; used by the overloaded string @@ -83,5 +87,5 @@ instance (a ~ Char) => IsString [a] where fromString xs = xs -- | @since 4.9.0.0 -instance IsString a => IsString (Const a b) where - fromString = Const . fromString +deriving instance IsString a => IsString (Const a b) +deriving instance IsString a => IsString (Identity a) diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index 72e2dfd57f..6f503b7dbe 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -56,6 +56,8 @@ import Control.Applicative ( Const(..), ZipList(..) ) import Data.Either ( Either(..) ) import Data.Foldable ( Foldable ) import Data.Functor +import Data.Functor.Identity ( Identity(..) ) +import Data.Functor.Utils ( StateL(..), StateR(..) ) import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) ) import Data.Proxy ( Proxy(..) ) @@ -240,6 +242,8 @@ instance Traversable Last where instance Traversable ZipList where traverse f (ZipList x) = ZipList <$> traverse f x +deriving instance Traversable Identity + -- Instances for GHC.Generics -- | @since 4.9.0.0 instance Traversable U1 where @@ -281,21 +285,6 @@ forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) {-# INLINE forM #-} forM = flip mapM --- left-to-right state transformer -newtype StateL s a = StateL { runStateL :: s -> (s, a) } - --- | @since 4.0 -instance Functor (StateL s) where - fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v) - --- | @since 4.0 -instance Applicative (StateL s) where - pure x = StateL (\ s -> (s, x)) - StateL kf <*> StateL kv = StateL $ \ s -> - let (s', f) = kf s - (s'', v) = kv s' - in (s'', f v) - -- |The 'mapAccumL' function behaves like a combination of 'fmap' -- and 'foldl'; it applies a function to each element of a structure, -- passing an accumulating parameter from left to right, and returning @@ -303,21 +292,6 @@ instance Applicative (StateL s) where mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s --- right-to-left state transformer -newtype StateR s a = StateR { runStateR :: s -> (s, a) } - --- | @since 4.0 -instance Functor (StateR s) where - fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v) - --- | @since 4.0 -instance Applicative (StateR s) where - pure x = StateR (\ s -> (s, x)) - StateR kf <*> StateR kv = StateR $ \ s -> - let (s', v) = kv s - (s'', f) = kf s' - in (s'', f v) - -- |The 'mapAccumR' function behaves like a combination of 'fmap' -- and 'foldr'; it applies a function to each element of a structure, -- passing an accumulating parameter from right to left, and returning @@ -331,23 +305,9 @@ mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s -- 'sequenceA' will result in infinite recursion.) fmapDefault :: Traversable t => (a -> b) -> t a -> t b {-# INLINE fmapDefault #-} -fmapDefault f = getId . traverse (Id . f) +fmapDefault f = runIdentity . traverse (Identity . f) -- | This function may be used as a value for `Data.Foldable.foldMap` -- in a `Foldable` instance. foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m foldMapDefault f = getConst . traverse (Const . f) - --- local instances - -newtype Id a = Id { getId :: a } - --- | @since 2.01 -instance Functor Id where - fmap f (Id x) = Id (f x) - --- | @since 2.01 -instance Applicative Id where - pure = Id - Id f <*> Id x = Id (f x) - diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index e068bbc9a1..cf122f7f9e 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -130,7 +130,9 @@ Library Control.Monad.ST.Strict Control.Monad.ST.Unsafe Control.Monad.Zip + Data.Bifoldable Data.Bifunctor + Data.Bitraversable Data.Bits Data.Bool Data.Char @@ -307,6 +309,7 @@ Library other-modules: Control.Monad.ST.Imp Control.Monad.ST.Lazy.Imp + Data.Functor.Utils Data.OldList Foreign.ForeignPtr.Imp System.Environment.ExecutablePath diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 4cb2533e74..3b44ded468 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -9,6 +9,9 @@ * `Generic1`, as well as the associated datatypes and typeclasses in `GHC.Generics`, are now poly-kinded (#10604) + * `New modules `Data.Bifoldable` and `Data.Bitraversable` (previously defined + in the `bifunctors` package) (#10448) + ## 4.9.0.0 *TBA* * Bundled with GHC 8.0 diff --git a/testsuite/tests/annotations/should_fail/annfail10.stderr b/testsuite/tests/annotations/should_fail/annfail10.stderr index b5f5a16fdf..6782f27228 100644 --- a/testsuite/tests/annotations/should_fail/annfail10.stderr +++ b/testsuite/tests/annotations/should_fail/annfail10.stderr @@ -10,7 +10,7 @@ annfail10.hs:9:1: error: instance Data.Data.Data Ordering -- Defined in ‘Data.Data’ instance Data.Data.Data Integer -- Defined in ‘Data.Data’ ...plus 15 others - ...plus 38 instances involving out-of-scope types + ...plus 39 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the annotation: {-# ANN f 1 #-} @@ -23,6 +23,6 @@ annfail10.hs:9:11: error: instance Num Double -- Defined in ‘GHC.Float’ instance Num Float -- Defined in ‘GHC.Float’ ...plus two others - ...plus 12 instances involving out-of-scope types + ...plus 13 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the annotation: {-# ANN f 1 #-} diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 7435a3330f..a09499915a 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -776,9 +776,10 @@ test('T9961', test('T9233', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 1066246248, 5), + [(wordsize(64), 984268712, 5), # 2015-08-04 999826288 initial value # 2016-04-14 1066246248 Final demand analyzer run + # 2016-06-18 984268712 shuffling around of Data.Functor.Identity (wordsize(32), 515672240, 5) # Put in your value here if you hit this # 2016-04-06 515672240 (x86/Linux) initial value ]), diff --git a/testsuite/tests/typecheck/should_fail/T10971b.stderr b/testsuite/tests/typecheck/should_fail/T10971b.stderr index d072c2552b..2e63617464 100644 --- a/testsuite/tests/typecheck/should_fail/T10971b.stderr +++ b/testsuite/tests/typecheck/should_fail/T10971b.stderr @@ -11,7 +11,7 @@ T10971b.hs:4:11: error: instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ ...plus one other - ...plus 24 instances involving out-of-scope types + ...plus 25 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: length x In the expression: \ x -> length x @@ -29,7 +29,7 @@ T10971b.hs:5:13: error: instance Traversable Maybe -- Defined in ‘Data.Traversable’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ ...plus one other - ...plus 24 instances involving out-of-scope types + ...plus 25 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: fmapDefault f x In the expression: \ f x -> fmapDefault f x @@ -47,7 +47,7 @@ T10971b.hs:6:14: error: instance Traversable Maybe -- Defined in ‘Data.Traversable’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ ...plus one other - ...plus 24 instances involving out-of-scope types + ...plus 25 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: fmapDefault f x In the expression: (fmapDefault f x, length x) @@ -65,7 +65,7 @@ T10971b.hs:6:31: error: instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ ...plus one other - ...plus 24 instances involving out-of-scope types + ...plus 25 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: length x In the expression: (fmapDefault f x, length x) |