Mon Apr 26 12:14:03 CDT 2010  wasserman.louis@gmail.com
  * foldrWithKey, foldlWithKey, improved Foldable instances, and folding rewrite rules in Data.Map, Data.Set, Data.IntMap, and Data.IntSet

New patches:

[foldrWithKey, foldlWithKey, improved Foldable instances, and folding rewrite rules in Data.Map, Data.Set, Data.IntMap, and Data.IntSet
wasserman.louis@gmail.com**20100426171403
 Ignore-this: 919e894a4b84562fcc05c0757f2a891f
] {
hunk ./Data/IntMap.hs 104
             -- ** Fold
             , fold
             , foldWithKey
+            , foldrWithKey
+            , foldlWithKey
 
             -- * Conversion
             , elems
hunk ./Data/IntMap.hs 170
 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
 import Data.Bits 
 import qualified Data.IntSet as IntSet
+import qualified Data.List as List
 import Data.Monoid (Monoid(..))
 import Data.Maybe (fromMaybe)
 import Data.Typeable
hunk ./Data/IntMap.hs 174
-import Data.Foldable (Foldable(foldMap))
+import Data.Foldable (Foldable(foldMap,foldr,foldl))
 import Data.Traversable (Traversable(traverse))
 import Control.Applicative (Applicative(pure,(<*>)),(<$>))
 import Control.Monad ( liftM )
hunk ./Data/IntMap.hs 192
 #endif
 
 #if __GLASGOW_HASKELL__ >= 503
-import GHC.Exts ( Word(..), Int(..), shiftRL# )
+import GHC.Exts ( Word(..), Int(..), shiftRL#, build )
 #elif __GLASGOW_HASKELL__
 import Word
hunk ./Data/IntMap.hs 195
-import GlaExts ( Word(..), Int(..), shiftRL# )
+import GlaExts ( Word(..), Int(..), shiftRL#, build )
 #else
 import Data.Word
 #endif
hunk ./Data/IntMap.hs 260
     foldMap _ Nil = mempty
     foldMap f (Tip _k v) = f v
     foldMap f (Bin _ _ l r) = foldMap f l `mappend` foldMap f r
+    foldr f = foldrWithKey (const f)
+    foldl f = foldlWithKey (const . f)
 
 instance Traversable IntMap where
     traverse _ Nil = pure Nil
hunk ./Data/IntMap.hs 1367
 
 foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
 foldWithKey f z t
-  = foldr f z t
+  = foldrWithKey f z t
 
hunk ./Data/IntMap.hs 1369
-foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b
-foldr f z t
+-- | /O(n)/. Fold the keys and values in the map, such that
+-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
+-- For example,
+--
+-- > keys map = foldrWithKey (\k x ks -> k:ks) [] map
+--
+-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
+-- > foldrWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
+foldrWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
+foldrWithKey f z t 
   = case t of
       Bin 0 m l r | m < 0 -> foldr' f (foldr' f z l) r  -- put negative numbers before.
       Bin _ _ _ _ -> foldr' f z t
hunk ./Data/IntMap.hs 1385
       Tip k x     -> f k x z
       Nil         -> z
 
+-- | /O(n)/.  Fold the keys and values in the map, such that
+-- @'foldlWithKey' f z == 'Prelude.foldl' ('uncurry' . f) z . 'toAscList'@.
+foldlWithKey :: (b -> Key -> a -> b) -> b -> IntMap a -> b
+foldlWithKey f z t
+  = case t of
+      Bin 0 m l r | m < 0 -> foldl' f (foldl' f z r) l
+      Bin _ _ _ _ -> foldl' f z t
+      Tip k x     -> f z k x
+      Nil         -> z
+
 foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
 foldr' f z t
   = case t of
hunk ./Data/IntMap.hs 1402
       Tip k x     -> f k x z
       Nil         -> z
 
-
+foldl' :: (b -> Key -> a -> b) -> b -> IntMap a -> b
+foldl' f z t
+  = case t of
+      Bin _ _ l r -> foldl' f (foldl' f z l) r
+      Tip k x     -> f z k x
+      Nil         -> z
 
 {--------------------------------------------------------------------
   List variations 
hunk ./Data/IntMap.hs 1412
 --------------------------------------------------------------------}
+{-# INLINE elems #-}
 -- | /O(n)/.
 -- Return all elements of the map in the ascending order of their keys.
 --
hunk ./Data/IntMap.hs 1420
 -- > elems empty == []
 
 elems :: IntMap a -> [a]
-elems m
-  = foldWithKey (\_ x xs -> x:xs) [] m
+elems = fmap snd . toAscList
 
hunk ./Data/IntMap.hs 1422
+{-# INLINE keys #-}
 -- | /O(n)/. Return all keys of the map in ascending order.
 --
 -- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
hunk ./Data/IntMap.hs 1429
 -- > keys empty == []
 
 keys  :: IntMap a -> [Key]
-keys m
-  = foldWithKey (\k _ ks -> k:ks) [] m
+keys = fmap fst . toAscList
 
 -- | /O(n*min(n,W))/. The set of all keys of the map.
 --
hunk ./Data/IntMap.hs 1439
 keysSet :: IntMap a -> IntSet.IntSet
 keysSet m = IntSet.fromDistinctAscList (keys m)
 
-
+{-# INLINE assocs #-}
 -- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
 --
 -- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
hunk ./Data/IntMap.hs 1453
 {--------------------------------------------------------------------
   Lists 
 --------------------------------------------------------------------}
+{-# INLINE toList #-}
 -- | /O(n)/. Convert the map to a list of key\/value pairs.
 --
 -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
hunk ./Data/IntMap.hs 1461
 
 toList :: IntMap a -> [(Key,a)]
 toList t
-  = foldWithKey (\k x xs -> (k,x):xs) [] t
+  = toAscList t
 
hunk ./Data/IntMap.hs 1463
+{-# NOINLINE toAscList #-}
 -- | /O(n)/. Convert the map to a list of key\/value pairs where the
 -- keys are in ascending order.
 --
hunk ./Data/IntMap.hs 1470
 -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
 
 toAscList :: IntMap a -> [(Key,a)]
-toAscList t   
-  = -- NOTE: the following algorithm only works for big-endian trees
-    let (pos,neg) = span (\(k,_) -> k >=0) (foldr (\k x xs -> (k,x):xs) [] t) in neg ++ pos
+toAscList t = foldrWithKey (curry (:)) [] t
+--   = -- NOTE: the following algorithm only works for big-endian trees
+--     let (pos,neg) = span (\(k,_) -> k >=0) (foldrWithKey (\k x xs -> (k,x):xs) [] t) in neg ++ pos
+--     QuickCheck indicates that these are equivalent, and really, if foldrWithKey doesn't fold negative
+--     to positive, then that's a problem with foldrWithKey, not with toAscList...
 
 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
 --
hunk ./Data/IntMap.hs 1602
 --------------------------------------------------------------------}
 
 instance Ord a => Ord (IntMap a) where
-    compare m1 m2 = compare (toList m1) (toList m2)
+    compare m1 m2 = foldr mappend (size m1 `compare` size m2) 
+    	(zipWith cmp (toList m1) (toList m2))
+	where	cmp (k1, a1) (k2, a2) = compare k1 k2 `mappend` cmp' a1 a2
+		{-# NOINLINE cmp' #-}
+		cmp' = compare
 
 {--------------------------------------------------------------------
   Functor 
hunk ./Data/IntMap.hs 1955
 
 -}
 
+{-# RULES
+	"Data.IntMap.toAscList" [~1] toAscList = \ t -> build (\ c n -> foldrWithKey (curry c) n t);
+	#-}
hunk ./Data/IntSet.hs 126
 #endif
 
 #if __GLASGOW_HASKELL__ >= 503
-import GHC.Exts ( Word(..), Int(..), shiftRL# )
+import GHC.Exts ( Word(..), Int(..), shiftRL#, build )
 #elif __GLASGOW_HASKELL__
 import Word
hunk ./Data/IntSet.hs 129
-import GlaExts ( Word(..), Int(..), shiftRL# )
+import GlaExts ( Word(..), Int(..), shiftRL#, build )
 #else
 import Data.Word
 #endif
hunk ./Data/IntSet.hs 642
 {--------------------------------------------------------------------
   Fold
 --------------------------------------------------------------------}
--- | /O(n)/. Fold over the elements of a set in an unspecified order.
+-- | /O(n)/. Fold over the elements of a set in ascending order.
 --
 -- > sum set   == fold (+) 0 set
 -- > elems set == fold (:) [] set
hunk ./Data/IntSet.hs 647
 fold :: (Int -> b -> b) -> b -> IntSet -> b
-fold f z t
-  = case t of
-      Bin 0 m l r | m < 0 -> foldr f (foldr f z l) r  
-      -- put negative numbers before.
-      Bin _ _ _ _ -> foldr f z t
-      Tip x       -> f x z
-      Nil         -> z
+fold f z t = foldr f z t
 
hunk ./Data/IntSet.hs 649
+-- | /O(n)/.  Right fold over the elements of a set in ascending order.
 foldr :: (Int -> b -> b) -> b -> IntSet -> b
 foldr f z t
   = case t of
hunk ./Data/IntSet.hs 653
-      Bin _ _ l r -> foldr f (foldr f z r) l
+      Bin 0 m l r | m < 0 -> foldr0 f (foldr0 f z l) r  
+      -- put negative numbers before.
+      Bin _ _ _ _ -> foldr0 f z t
       Tip x       -> f x z
       Nil         -> z
hunk ./Data/IntSet.hs 658
+
+foldr0 :: (Int -> b -> b) -> b -> IntSet -> b
+foldr0 _ z Nil = z
+foldr0 f z (Tip x) = x `f` z
+foldr0 f z (Bin _ _ l r) = foldr0 f (foldr0 f z r) l
+
+-- | /O(n)/.  Left fold over the elements of a set in ascending order.
+foldl :: (b -> Int -> b) -> b -> IntSet -> b 
+foldl f z t = case t of
+	Bin 0 m l r | m < 0 -> foldl0 f (foldl0 f z r) l
+	Bin _ _ _ _	-> foldl0 f z t
+	Tip x 		-> f z x
+	Nil		-> z
+
+foldl0 :: (b -> Int -> b) -> b -> IntSet -> b
+foldl0 _ z Nil = z
+foldl0 f z (Tip x) = z `f` x
+foldl0 f z (Bin _ _ l r) = foldl0 f (foldl0 f z l) r
           
 {--------------------------------------------------------------------
   List variations 
hunk ./Data/IntSet.hs 680
 --------------------------------------------------------------------}
+{-# INLINE elems #-}
 -- | /O(n)/. The elements of a set. (For sets, this is equivalent to toList)
 elems :: IntSet -> [Int]
 elems s
hunk ./Data/IntSet.hs 689
 {--------------------------------------------------------------------
   Lists 
 --------------------------------------------------------------------}
+{-# INLINE toList #-}
 -- | /O(n)/. Convert the set to a list of elements.
 toList :: IntSet -> [Int]
hunk ./Data/IntSet.hs 692
-toList t
-  = fold (:) [] t
-
+toList t = toAscList t
+  
+{-# NOINLINE toAscList #-}
 -- | /O(n)/. Convert the set to an ascending list of elements.
 toAscList :: IntSet -> [Int]
hunk ./Data/IntSet.hs 697
-toAscList t = toList t
+toAscList t = fold (:) [] t
 
 -- | /O(n*min(n,W))/. Create a set from a list of integers.
 fromList :: [Int] -> IntSet
hunk ./Data/IntSet.hs 1132
   c = union a b
 -}
 
+{-# RULES
+	"Data.Set.toAscList" toAscList = \ s -> build (\ c n -> foldr c n s);
+	#-}
hunk ./Data/Map.hs 177
             , valid
             ) where
 
-import Prelude hiding (lookup,map,filter,null)
+import Prelude hiding (lookup,map,filter,null,foldr,foldl)
 import qualified Data.Set as Set
 import qualified Data.List as List
 import Data.Monoid (Monoid(..))
hunk ./Data/Map.hs 183
 import Control.Applicative (Applicative(..), (<$>))
 import Data.Traversable (Traversable(traverse))
-import Data.Foldable (Foldable(foldMap))
+import Data.Foldable (Foldable(foldr, foldl, foldMap))
 #ifndef __GLASGOW_HASKELL__
 import Data.Typeable ( Typeable, typeOf, typeOfDefault
                      , Typeable1, typeOf1, typeOf1Default)
hunk ./Data/Map.hs 201
 #if __GLASGOW_HASKELL__
 import Text.Read
 import Data.Data (Data(..), mkNoRepType, gcast2)
+import qualified GHC.Exts as GHC (build)
 #endif
 
 {--------------------------------------------------------------------
hunk ./Data/Map.hs 1463
 {--------------------------------------------------------------------
   List variations 
 --------------------------------------------------------------------}
+
+{-# INLINE elems #-}
 -- | /O(n)/.
 -- Return all elements of the map in the ascending order of their keys.
 --
hunk ./Data/Map.hs 1475
 elems m
   = [x | (_,x) <- assocs m]
 
+{-# INLINE keys #-}
 -- | /O(n)/. Return all keys of the map in ascending order.
 --
 -- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
hunk ./Data/Map.hs 1493
 keysSet :: Map k a -> Set.Set k
 keysSet m = Set.fromDistinctAscList (keys m)
 
+{-# INLINE assocs #-}
 -- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
 --
 -- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
hunk ./Data/Map.hs 1542
   where
     ins t (k,x) = insertWithKey f k x t
 
+{-# INLINE toList #-}
 -- | /O(n)/. Convert to a list of key\/value pairs.
 --
 -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
hunk ./Data/Map.hs 1551
 toList :: Map k a -> [(k,a)]
 toList t      = toAscList t
 
+{-# NOINLINE toAscList #-}
 -- | /O(n)/. Convert to an ascending list.
 --
 -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
hunk ./Data/Map.hs 1559
 toAscList :: Map k a -> [(k,a)]
 toAscList t   = foldrWithKey (\k x xs -> (k,x):xs) [] t
 
+{-# NOINLINE toDescList #-}
 -- | /O(n)/. Convert to a descending list.
 toDescList :: Map k a -> [(k,a)]
 toDescList t  = foldlWithKey (\xs k x -> (k,x):xs) [] t
hunk ./Data/Map.hs 1957
   and it is certainly the simplest :-)
 --------------------------------------------------------------------}
 instance (Eq k,Eq a) => Eq (Map k a) where
-  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)
+  t1 == t2  = (size t1 == size t2) && List.and (zipWith (==) (toAscList t1) (toAscList t2))
 
 {--------------------------------------------------------------------
   Ord 
hunk ./Data/Map.hs 1964
 --------------------------------------------------------------------}
 
 instance (Ord k, Ord v) => Ord (Map k v) where
-    compare m1 m2 = compare (toAscList m1) (toAscList m2)
+    compare m1 m2 = foldr mappend (compare (size m1) (size m2)) (zipWith cmp (toAscList m1) (toAscList m2))
+    	where	cmp (k1, a1) (k2, a2) = cmp1 k1 k2 `mappend` cmp2 a1 a2
+    		{-# NOINLINE cmp1 #-}
+		cmp1 = compare
+		{-# NOINLINE cmp2 #-}
+		cmp2 = compare
 
 {--------------------------------------------------------------------
   Functor
hunk ./Data/Map.hs 1975
 --------------------------------------------------------------------}
 instance Functor (Map k) where
-  fmap f m  = map f m
+  fmap = map
 
 instance Traversable (Map k) where
   traverse _ Tip = pure Tip
hunk ./Data/Map.hs 1986
   foldMap _f Tip = mempty
   foldMap f (Bin _s _k v l r)
     = foldMap f l `mappend` f v `mappend` foldMap f r
+  foldr f = foldrWithKey (const f)
+  foldl f = foldlWithKey (const . f)
 
 {--------------------------------------------------------------------
   Read
hunk ./Data/Map.hs 2363
   = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
 -}
 
+{-# RULES
+	"Data.Map.toAscList" [~1] toAscList = \ t -> GHC.build (\ c n -> foldrWithKey (curry c) n t);
+	"Data.Map.toDescList" [~1] toDescList = \ t -> GHC.build (\ c n -> foldlWithKey (\ z k a -> (k, a) `c` z) n t);
+	#-}
hunk ./Data/Set.hs 104
             , valid
             ) where
 
-import Prelude hiding (filter,foldr,null,map)
+import Prelude hiding (filter,foldr,foldl,null,map)
 import qualified Data.List as List
 import Data.Monoid (Monoid(..))
hunk ./Data/Set.hs 107
-import Data.Foldable (Foldable(foldMap))
+import Data.Foldable (Foldable(foldMap, foldr, foldl))
+import qualified Data.Foldable as Fold
 #ifndef __GLASGOW_HASKELL__
 import Data.Typeable (Typeable, typeOf, typeOfDefault)
 #endif
hunk ./Data/Set.hs 114
 import Data.Typeable (Typeable1(..), TyCon, mkTyCon, mkTyConApp)
 
+#ifdef __GLASGOW_HASKELL__
+import qualified GHC.Exts as GHC (build)
+#endif
+
 {-
 -- just for testing
 import QuickCheck 
hunk ./Data/Set.hs 156
 instance Foldable Set where
     foldMap _ Tip = mempty
     foldMap f (Bin _s k l r) = foldMap f l `mappend` f k `mappend` foldMap f r
+    foldr _ z Tip = z
+    foldr f z (Bin _s k l r) = foldr f (k `f` foldr f z r) l
+    foldl _ z Tip = z
+    foldl f z (Bin _s k l r) = foldl f (foldl f z l `f` k) r
 
 #if __GLASGOW_HASKELL__
 
hunk ./Data/Set.hs 441
 {--------------------------------------------------------------------
   Fold
 --------------------------------------------------------------------}
--- | /O(n)/. Fold over the elements of a set in an unspecified order.
+-- | /O(n)/. Fold over the elements of a set in ascending order.  Equivalent to @'foldr' f z ('toAscList' s)@.
 fold :: (a -> b -> b) -> b -> Set a -> b
 fold f z s
   = foldr f z s
hunk ./Data/Set.hs 446
 
--- | /O(n)/. Post-order fold.
-foldr :: (a -> b -> b) -> b -> Set a -> b
-foldr _ z Tip           = z
-foldr f z (Bin _ x l r) = foldr f (f x (foldr f z r)) l
-
 {--------------------------------------------------------------------
   List variations 
 --------------------------------------------------------------------}
hunk ./Data/Set.hs 449
+{-# INLINE elems #-}
 -- | /O(n)/. The elements of a set.
 elems :: Set a -> [a]
 elems s
hunk ./Data/Set.hs 458
 {--------------------------------------------------------------------
   Lists 
 --------------------------------------------------------------------}
+{-# INLINE toList #-}
 -- | /O(n)/. Convert the set to a list of elements.
 toList :: Set a -> [a]
 toList s
hunk ./Data/Set.hs 464
   = toAscList s
 
+{-# NOINLINE toAscList #-}
 -- | /O(n)/. Convert the set to an ascending list of elements.
 toAscList :: Set a -> [a]
hunk ./Data/Set.hs 467
-toAscList t   
-  = foldr (:) [] t
-
+toAscList s = foldr (:) [] s
 
 -- | /O(n*log n)/. Create a set from a list of elements.
 fromList :: Ord a => [a] -> Set a 
hunk ./Data/Set.hs 1187
   = (sort (nub xs) == toList (fromList xs))
 -}
 
+{-# RULES
+	"Data.Set.toAscList" [~1] toAscList = \ s -> GHC.build (\ c n -> foldr c n s);
+	#-}
}

Context:

[Tweak layout to work with the alternative layout rule
Ian Lynagh <igloo@earth.li>**20091129154519] 
[Disable building Data.Sequence (and dependents) for nhc98.
Malcolm.Wallace@cs.york.ac.uk**20091124025653
 There is some subtlety of polymorphically recursive datatypes and
 type-class defaulting that nhc98's type system barfs over.
] 
[Fix another instance of non-ghc breakage.
Malcolm.Wallace@cs.york.ac.uk**20091123092637] 
[Add #ifdef around ghc-only (<$) as member of Functor class.
Malcolm.Wallace@cs.york.ac.uk**20091123085155] 
[Fix broken code in non-GHC branch of an ifdef.
Malcolm.Wallace@cs.york.ac.uk**20091123084824] 
[doc bugfix: correct description of index argument
Ross Paterson <ross@soi.city.ac.uk>**20091028105532
 Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9
 
 As noted by iaefai on the libraries list.
 
 Please merge to STABLE.
] 
[Bump version to 0.3.0.0
Ian Lynagh <igloo@earth.li>**20090920141847] 
[update base dependency
Ross Paterson <ross@soi.city.ac.uk>**20090916073125
 Ignore-this: ad382ffc6c6a18c15364e6c072f19edb
 
 The package uses mkNoRepType and Data.Functor, which were not in the
 stable branch of base-4.
] 
[add fast version of <$ for Seq
Ross Paterson <ross@soi.city.ac.uk>**20090916072812
 Ignore-this: 5a39a7d31d39760ed589790b1118d240
] 
[new methods for Data.Sequence (proposal #3271)
Ross Paterson <ross@soi.city.ac.uk>**20090915173324
 Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7
 
 Adds a lot of new methods to Data.Sequence, mostly paralleling those
 in Data.List.  Several of these are significantly faster than versions
 implemented with the previous public interface.  In particular, replicate
 takes O(log n) time and space instead of O(n).
 (by Louis Wasserman)
] 
[Fix "Cabal check" warnings
Ian Lynagh <igloo@earth.li>**20090811215900] 
[TAG 2009-06-25
Ian Lynagh <igloo@earth.li>**20090625160202] 
Patch bundle hash:
08a98eb815a2c9f632cd01e3423689f10fc562e4