X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FFoldable.hs;h=354bd8b270a655fe565fa5884b80e48280b8b4f7;hb=7a97ec4b12e1fbec5505f82032cf4dc435b5a60c;hp=7c34b77f64ae5dfb7cc7ed2a48b203778d979b17;hpb=afe7ed8026edd943550b05f4895c99601207fea5;p=ghc-base.git diff --git a/Data/Foldable.hs b/Data/Foldable.hs index 7c34b77..354bd8b 100644 --- a/Data/Foldable.hs +++ b/Data/Foldable.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Foldable -- Copyright : Ross Paterson 2005 -- License : BSD-style (see the LICENSE file in the distribution) -- --- Maintainer : ross@soi.city.ac.uk +-- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- @@ -17,59 +19,69 @@ -- for this module. module Data.Foldable ( - -- * Folds - Foldable(..), - -- ** Special biased folds - foldr', - foldl', - foldrM, - foldlM, - -- ** Folding actions - -- *** Applicative actions - traverse_, - for_, - sequenceA_, - asum, - -- *** Monadic actions - mapM_, - forM_, - sequence_, - msum, - -- ** Specialized folds - toList, - concat, - concatMap, - and, - or, - any, - all, - sum, - product, - maximum, - maximumBy, - minimum, - minimumBy, - -- ** Searches - elem, - notElem, - find - ) where + -- * Folds + Foldable(..), + -- ** Special biased folds + foldr', + foldl', + foldrM, + foldlM, + -- ** Folding actions + -- *** Applicative actions + traverse_, + for_, + sequenceA_, + asum, + -- *** Monadic actions + mapM_, + forM_, + sequence_, + msum, + -- ** Specialized folds + toList, + concat, + concatMap, + and, + or, + any, + all, + sum, + product, + maximum, + maximumBy, + minimum, + minimumBy, + -- ** Searches + elem, + notElem, + find + ) where import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_, - elem, notElem, concat, concatMap, and, or, any, all, - sum, product, maximum, minimum) + elem, notElem, concat, concatMap, and, or, any, all, + sum, product, maximum, minimum) import qualified Prelude (foldl, foldr, foldl1, foldr1) -import Control.Arrow (ArrowZero(..)) import Control.Applicative import Control.Monad (MonadPlus(..)) import Data.Maybe (fromMaybe, listToMaybe) import Data.Monoid -import Data.Array + +#ifdef __NHC__ +import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem +#endif #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) #endif +#if defined(__GLASGOW_HASKELL__) +import GHC.Arr +#elif defined(__HUGS__) +import Hugs.Array +#elif defined(__NHC__) +import Array +#endif + -- | Data structures that can be folded. -- -- Minimal complete definition: 'foldMap' or 'foldr'. @@ -80,96 +92,106 @@ import GHC.Exts (build) -- -- a suitable instance would be -- --- > instance Foldable Tree +-- > instance Foldable Tree where -- > foldMap f Empty = mempty -- > foldMap f (Leaf x) = f x -- > foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r -- -- This is suitable even for abstract types, as the monoid is assumed --- to satisfy the monoid laws. +-- to satisfy the monoid laws. Alternatively, one could define @foldr@: +-- +-- > instance Foldable Tree where +-- > foldr f z Empty = z +-- > foldr f z (Leaf x) = f x z +-- > foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l -- class Foldable t where - -- | Combine the elements of a structure using a monoid. - fold :: Monoid m => t m -> m - fold = foldMap id - - -- | Map each element of the structure to a monoid, - -- and combine the results. - foldMap :: Monoid m => (a -> m) -> t a -> m - foldMap f = foldr (mappend . f) mempty - - -- | Right-associative fold of a structure. - -- - -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@ - foldr :: (a -> b -> b) -> b -> t a -> b - foldr f z t = appEndo (foldMap (Endo . f) t) z - - -- | Left-associative fold of a structure. - -- - -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@ - foldl :: (a -> b -> a) -> a -> t b -> a - foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z - - -- | A variant of 'foldr' that has no base case, - -- and thus may only be applied to non-empty structures. - -- - -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@ - foldr1 :: (a -> a -> a) -> t a -> a - foldr1 f xs = fromMaybe (error "foldr1: empty structure") - (foldr mf Nothing xs) - where mf x Nothing = Just x - mf x (Just y) = Just (f x y) - - -- | A variant of 'foldl' that has no base case, - -- and thus may only be applied to non-empty structures. - -- - -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@ - foldl1 :: (a -> a -> a) -> t a -> a - foldl1 f xs = fromMaybe (error "foldl1: empty structure") - (foldl mf Nothing xs) - where mf Nothing y = Just y - mf (Just x) y = Just (f x y) + -- | Combine the elements of a structure using a monoid. + fold :: Monoid m => t m -> m + fold = foldMap id + + -- | Map each element of the structure to a monoid, + -- and combine the results. + foldMap :: Monoid m => (a -> m) -> t a -> m + foldMap f = foldr (mappend . f) mempty + + -- | Right-associative fold of a structure. + -- + -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@ + foldr :: (a -> b -> b) -> b -> t a -> b + foldr f z t = appEndo (foldMap (Endo . f) t) z + + -- | Left-associative fold of a structure. + -- + -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@ + foldl :: (a -> b -> a) -> a -> t b -> a + foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z + + -- | A variant of 'foldr' that has no base case, + -- and thus may only be applied to non-empty structures. + -- + -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@ + foldr1 :: (a -> a -> a) -> t a -> a + foldr1 f xs = fromMaybe (error "foldr1: empty structure") + (foldr mf Nothing xs) + where + mf x Nothing = Just x + mf x (Just y) = Just (f x y) + + -- | A variant of 'foldl' that has no base case, + -- and thus may only be applied to non-empty structures. + -- + -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@ + foldl1 :: (a -> a -> a) -> t a -> a + foldl1 f xs = fromMaybe (error "foldl1: empty structure") + (foldl mf Nothing xs) + where + mf Nothing y = Just y + mf (Just x) y = Just (f x y) -- instances for Prelude types instance Foldable Maybe where - foldr f z Nothing = z - foldr f z (Just x) = f x z + foldr _ z Nothing = z + foldr f z (Just x) = f x z - foldl f z Nothing = z - foldl f z (Just x) = f z x + foldl _ z Nothing = z + foldl f z (Just x) = f z x instance Foldable [] where - foldr = Prelude.foldr - foldl = Prelude.foldl - foldr1 = Prelude.foldr1 - foldl1 = Prelude.foldl1 + foldr = Prelude.foldr + foldl = Prelude.foldl + foldr1 = Prelude.foldr1 + foldl1 = Prelude.foldl1 instance Ix i => Foldable (Array i) where - foldr f z = Prelude.foldr f z . elems + foldr f z = Prelude.foldr f z . elems + foldl f z = Prelude.foldl f z . elems + foldr1 f = Prelude.foldr1 f . elems + foldl1 f = Prelude.foldl1 f . elems -- | Fold over the elements of a structure, -- associating to the right, but strictly. foldr' :: Foldable t => (a -> b -> b) -> b -> t a -> b -foldr' f z xs = foldl f' id xs z +foldr' f z0 xs = foldl f' id xs z0 where f' k x z = k $! f x z -- | Monadic fold over the elements of a structure, -- associating to the right, i.e. from right to left. foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b -foldrM f z xs = foldl f' return xs z +foldrM f z0 xs = foldl f' return xs z0 where f' k x z = f x z >>= k -- | Fold over the elements of a structure, -- associating to the left, but strictly. foldl' :: Foldable t => (a -> b -> a) -> a -> t b -> a -foldl' f z xs = foldr f' id xs z +foldl' f z0 xs = foldr f' id xs z0 where f' x k z = k $! f z x -- | Monadic fold over the elements of a structure, -- associating to the left, i.e. from left to right. foldlM :: (Foldable t, Monad m) => (a -> b -> m a) -> a -> t b -> m a -foldlM f z xs = foldr f' return xs z +foldlM f z0 xs = foldr f' return xs z0 where f' x k z = f z x >>= k -- | Map each element of a structure to an action, evaluate @@ -182,7 +204,7 @@ for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f () {-# INLINE for_ #-} for_ = flip traverse_ --- | Map each element of a structure to an monadic action, evaluate +-- | Map each element of a structure to a monadic action, evaluate -- these actions from left to right, and ignore the results. mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ f = foldr ((>>) . f) (return ()) @@ -216,6 +238,7 @@ msum = foldr mplus mzero -- | List of elements of a structure. toList :: Foldable t => t a -> [a] +{-# INLINE toList #-} #ifdef __GLASGOW_HASKELL__ toList t = build (\ c n -> foldr c n t) #else @@ -268,8 +291,8 @@ maximum = foldr1 max maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a maximumBy cmp = foldr1 max' where max' x y = case cmp x y of - GT -> x - _ -> y + GT -> x + _ -> y -- | The least element of a non-empty structure. minimum :: (Foldable t, Ord a) => t a -> a @@ -280,8 +303,8 @@ minimum = foldr1 min minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a minimumBy cmp = foldr1 min' where min' x y = case cmp x y of - GT -> y - _ -> x + GT -> y + _ -> x -- | Does the element occur in the structure? elem :: (Foldable t, Eq a) => a -> t a -> Bool