X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FFoldable.hs;h=354bd8b270a655fe565fa5884b80e48280b8b4f7;hb=HEAD;hp=f2baddf805583498b4f4975833de95f7ba30cec4;hpb=e2723a042968e1e947a038bf472a5aefb121376f;p=ghc-base.git

diff --git a/Data/Foldable.hs b/Data/Foldable.hs
index f2baddf..354bd8b 100644
--- a/Data/Foldable.hs
+++ b/Data/Foldable.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Foldable
@@ -17,43 +19,43 @@
 -- 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,
@@ -72,6 +74,14 @@ import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem
 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'.
@@ -82,93 +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
+    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
@@ -215,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