From 8b53db138ad2d4682fba381b7df078e7fa3fc7de Mon Sep 17 00:00:00 2001
From: Joachim Breitner <mail@joachim-breitner.de>
Date: Wed, 21 Sep 2011 20:17:17 +0200
Subject: [PATCH] Implement list fusion for {Int,}{MapSet}
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

I am not fully convinced that it works well with the INLINEABLE pragmas,
but it won’t do harm this way either.
---
 Data/IntMap/Base.hs | 13 +++++++++++--
 Data/IntSet.hs      | 16 +++++++++++++---
 Data/Map/Base.hs    | 17 ++++++++++++++---
 Data/Set.hs         | 16 +++++++++++++---
 4 files changed, 51 insertions(+), 11 deletions(-)

diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index 065beb986..0927f3593 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -192,7 +192,7 @@ import Data.Data (Data(..), mkNoRepType)
 #endif
 
 #if __GLASGOW_HASKELL__
-import GHC.Exts ( Word(..), Int(..), shiftRL# )
+import GHC.Exts ( Word(..), Int(..), shiftRL#, build )
 #else
 import Data.Word
 #endif
@@ -1481,6 +1481,7 @@ keysSet m = IntSet.fromDistinctAscList (keys m)
 
 
 -- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
+-- Subject to list Fusion.
 --
 -- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
 -- > assocs empty == []
@@ -1493,7 +1494,8 @@ assocs m
 {--------------------------------------------------------------------
   Lists
 --------------------------------------------------------------------}
--- | /O(n)/. Convert the map to a list of key\/value pairs.
+-- | /O(n)/. Convert the map to a list of key\/value pairs. Subject to list
+-- fusion.
 --
 -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
 -- > toList empty == []
@@ -1502,6 +1504,13 @@ toList :: IntMap a -> [(Key,a)]
 toList
   = foldrWithKey (\k x xs -> (k,x):xs) []
 
+#if __GLASGOW_HASKELL__ >= 503
+-- List fusion for the above two functions
+{-# RULES "IntMap/toList" forall im . toList im = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n im) #-}
+{-# RULES "IntMap/assocs" forall im . assocs im = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n im) #-}
+#endif
+
+
 -- | /O(n)/. Convert the map to a list of key\/value pairs where the
 -- keys are in ascending order.
 --
diff --git a/Data/IntSet.hs b/Data/IntSet.hs
index 58b12d4f9..b4f388fb9 100644
--- a/Data/IntSet.hs
+++ b/Data/IntSet.hs
@@ -151,7 +151,7 @@ import Data.Data (Data(..), mkNoRepType)
 #endif
 
 #if __GLASGOW_HASKELL__
-import GHC.Exts ( Word(..), Int(..) )
+import GHC.Exts ( Word(..), Int(..), build )
 import GHC.Prim ( uncheckedShiftL#, uncheckedShiftRL#, indexInt8OffAddr# )
 #else
 import Data.Word
@@ -758,6 +758,7 @@ foldl' f z t =
   List variations
 --------------------------------------------------------------------}
 -- | /O(n)/. The elements of a set. (For sets, this is equivalent to toList.)
+-- Subject to list fusion
 elems :: IntSet -> [Int]
 elems t
   = toAscList t
@@ -765,15 +766,24 @@ elems t
 {--------------------------------------------------------------------
   Lists
 --------------------------------------------------------------------}
--- | /O(n)/. Convert the set to a list of elements.
+-- | /O(n)/. Convert the set to a list of elements. Subject to list fusion.
 toList :: IntSet -> [Int]
 toList t
   = toAscList t
 
--- | /O(n)/. Convert the set to an ascending list of elements.
+-- | /O(n)/. Convert the set to an ascending list of elements. Subject to list
+-- fusion.
 toAscList :: IntSet -> [Int]
 toAscList t = foldr (:) [] t
 
+#if __GLASGOW_HASKELL__ >= 503
+-- List fusion for the above three functions
+{-# RULES "IntSet/toList" forall is . toList is = build (\c n -> foldr c n is) #-}
+{-# RULES "IntSet/toAscList" forall is . toAscList is = build (\c n -> foldr c n is) #-}
+{-# RULES "IntSet/elems" forall is . elems is = build (\c n -> foldr c n is) #-}
+#endif
+
+
 -- | /O(n*min(n,W))/. Create a set from a list of integers.
 fromList :: [Int] -> IntSet
 fromList xs
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index 1e6096fee..df6acc556 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -228,6 +228,9 @@ import Data.Typeable
 import Control.DeepSeq (NFData(rnf))
 
 #if __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts ( build )
+#endif
 import Text.Read
 import Data.Data
 #endif
@@ -1817,7 +1820,7 @@ fromListWithKey f xs
 {-# INLINABLE fromListWithKey #-}
 #endif
 
--- | /O(n)/. Convert to a list of key\/value pairs.
+-- | /O(n)/. Convert to a list of key\/value pairs. Subject to list fusion.
 --
 -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
 -- > toList empty == []
@@ -1828,7 +1831,7 @@ toList t      = toAscList t
 {-# INLINABLE toList #-}
 #endif
 
--- | /O(n)/. Convert to an ascending list.
+-- | /O(n)/. Convert to an ascending list. Subject to list fusion.
 --
 -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
 
@@ -1838,13 +1841,21 @@ toAscList t   = foldrWithKey (\k x xs -> (k,x):xs) [] t
 {-# INLINABLE toAscList #-}
 #endif
 
--- | /O(n)/. Convert to a descending list.
+-- | /O(n)/. Convert to a descending list. Subject to list fusion.
 toDescList :: Map k a -> [(k,a)]
 toDescList t  = foldlWithKey (\xs k x -> (k,x):xs) [] t
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE toDescList #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 503
+-- List fusion for the above four functions
+{-# RULES "Map/assocs" forall m . assocs m = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n m) #-}
+{-# RULES "Map/toList" forall m . toList m = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n m) #-}
+{-# RULES "Map/toAscList" forall m . toAscList m = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n m) #-}
+{-# RULES "Map/toDescList" forall m . toDescList m = build (\c n -> foldlWithKey (\xs k x -> c (k,x) xs) n m) #-}
+#endif
+
 {--------------------------------------------------------------------
   Building trees from ascending/descending lists can be done in linear time.
 
diff --git a/Data/Set.hs b/Data/Set.hs
index daab0c633..1ae2ca616 100644
--- a/Data/Set.hs
+++ b/Data/Set.hs
@@ -158,6 +158,9 @@ import qualified List
 #if __GLASGOW_HASKELL__
 import Text.Read
 import Data.Data
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts ( build )
+#endif
 #endif
 
 -- Use macros to define strictness of functions.
@@ -618,7 +621,7 @@ foldl' f = go
 {--------------------------------------------------------------------
   List variations
 --------------------------------------------------------------------}
--- | /O(n)/. The elements of a set.
+-- | /O(n)/. The elements of a set. Subject to list fusion.
 elems :: Set a -> [a]
 elems = toList
 #if __GLASGOW_HASKELL__ >= 700
@@ -628,20 +631,27 @@ elems = toList
 {--------------------------------------------------------------------
   Lists
 --------------------------------------------------------------------}
--- | /O(n)/. Convert the set to a list of elements.
+-- | /O(n)/. Convert the set to a list of elements. Subject to list fusion.
 toList :: Set a -> [a]
 toList = toAscList
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE toList #-}
 #endif
 
--- | /O(n)/. Convert the set to an ascending list of elements.
+-- | /O(n)/. Convert the set to an ascending list of elements. Subject to list fusion.
 toAscList :: Set a -> [a]
 toAscList = foldr (:) []
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE toAscList #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 503
+-- List fusion for the above three functions
+{-# RULES "Set/toList" forall s . toList s = build (\c n -> foldr c n s) #-}
+{-# RULES "Set/toAscList" forall s . toAscList s = build (\c n -> foldr c n s) #-}
+{-# RULES "Set/elems" forall s . elems s = build (\c n -> foldr c n s) #-}
+#endif
+
 -- | /O(n*log n)/. Create a set from a list of elements.
 fromList :: Ord a => [a] -> Set a
 fromList = foldlStrict ins empty