Ticket #4280: data-set-performance.dpatch

File data-set-performance.dpatch, 28.6 KB (added by tibbe, 5 years ago)
Line 
13 patches for repository http://darcs.haskell.org/libraries/containers:
2
3Tue Aug 31 14:40:30 CEST 2010  Johan Tibell <[email protected]>
4  * Added a test suite for Data.Set
5 
6  Expression coverage: 74%
7
8Tue Aug 31 14:42:25 CEST 2010  Johan Tibell <[email protected]>
9  * Added benchmarks for Data.Set
10
11Tue Aug 31 14:43:52 CEST 2010  Johan Tibell <[email protected]>
12  * Improved performance of Data.Set
13 
14  Performance improvements are due to manually applying the
15  worker/wrapper transformation and strictifying the keys.
16 
17  Average speed-up is 32% on a 2GHz Core 2 Duo on OS X 10.5.8
18
19New patches:
20
21[Added a test suite for Data.Set
22Johan Tibell <[email protected]>**20100831124030
23 Ignore-this: f430dc302c0fcb8b5d62db2272a1d6f7
24 
25 Expression coverage: 74%
26] {
27hunk ./Data/Set.hs 39
28 
29 module Data.Set  (
30             -- * Set type
31+#if !defined(TESTING)   
32               Set          -- instance Eq,Ord,Show,Read,Data,Typeable
33hunk ./Data/Set.hs 41
34+#else
35+              Set(..)
36+#endif
37 
38             -- * Operators
39             , (\\)
40hunk ./Data/Set.hs 106
41             , showTree
42             , showTreeWith
43             , valid
44+
45+#if defined(TESTING)
46+            -- Internals (for testing)
47+            , bin
48+            , balanced
49+            , join
50+            , merge
51+#endif   
52             ) where
53 
54 import Prelude hiding (filter,foldr,null,map)
55hunk ./Data/Set.hs 552
56   showsPrec p xs = showParen (p > 10) $
57     showString "fromList " . shows (toList xs)
58 
59-{-
60-XXX unused code
61-
62-showSet :: (Show a) => [a] -> ShowS
63-showSet []     
64-  = showString "{}"
65-showSet (x:xs)
66-  = showChar '{' . shows x . showTail xs
67-  where
68-    showTail []       = showChar '}'
69-    showTail (x':xs') = showChar ',' . shows x' . showTail xs'
70--}
71-
72 {--------------------------------------------------------------------
73   Read
74 --------------------------------------------------------------------}
75hunk ./Data/Set.hs 608
76               _  -> trim cmplo cmphi l
77       _  -> trim cmplo cmphi r
78 
79-{-
80-XXX unused code
81-
82-trimMemberLo :: Ord a => a -> (a -> Ordering) -> Set a -> (Bool, Set a)
83-trimMemberLo _  _     Tip = (False,Tip)
84-trimMemberLo lo cmphi t@(Bin _ x l r)
85-  = case compare lo x of
86-      LT -> case cmphi x of
87-              GT -> (member lo t, t)
88-              _  -> trimMemberLo lo cmphi l
89-      GT -> trimMemberLo lo cmphi r
90-      EQ -> (True,trim (compare lo) cmphi r)
91--}
92-
93 {--------------------------------------------------------------------
94   [filterGt x t] filter all values >[x] from tree [t]
95   [filterLt x t] filter all values <[x] from tree [t]
96hunk ./Data/Set.hs 1003
97           Bin sz _ l r -> case (realsize l,realsize r) of
98                             (Just n,Just m)  | n+m+1 == sz  -> Just sz
99                             _                -> Nothing
100-
101-{-
102-{--------------------------------------------------------------------
103-  Testing
104---------------------------------------------------------------------}
105-testTree :: [Int] -> Set Int
106-testTree xs   = fromList xs
107-test1 = testTree [1..20]
108-test2 = testTree [30,29..10]
109-test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
110-
111-{--------------------------------------------------------------------
112-  QuickCheck
113---------------------------------------------------------------------}
114-qcheck prop
115-  = check config prop
116-  where
117-    config = Config
118-      { configMaxTest = 500
119-      , configMaxFail = 5000
120-      , configSize    = \n -> (div n 2 + 3)
121-      , configEvery   = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
122-      }
123-
124-
125-{--------------------------------------------------------------------
126-  Arbitrary, reasonably balanced trees
127---------------------------------------------------------------------}
128-instance (Enum a) => Arbitrary (Set a) where
129-  arbitrary = sized (arbtree 0 maxkey)
130-            where maxkey  = 10000
131-
132-arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a)
133-arbtree lo hi n
134-  | n <= 0        = return Tip
135-  | lo >= hi      = return Tip
136-  | otherwise     = do{ i  <- choose (lo,hi)
137-                      ; m  <- choose (1,30)
138-                      ; let (ml,mr)  | m==(1::Int)= (1,2)
139-                                     | m==2       = (2,1)
140-                                     | m==3       = (1,1)
141-                                     | otherwise  = (2,2)
142-                      ; l  <- arbtree lo (i-1) (n `div` ml)
143-                      ; r  <- arbtree (i+1) hi (n `div` mr)
144-                      ; return (bin (toEnum i) l r)
145-                      } 
146-
147-
148-{--------------------------------------------------------------------
149-  Valid tree's
150---------------------------------------------------------------------}
151-forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property
152-forValid f
153-  = forAll arbitrary $ \t ->
154---    classify (balanced t) "balanced" $
155-    classify (size t == 0) "empty" $
156-    classify (size t > 0  && size t <= 10) "small" $
157-    classify (size t > 10 && size t <= 64) "medium" $
158-    classify (size t > 64) "large" $
159-    balanced t ==> f t
160-
161-forValidIntTree :: Testable a => (Set Int -> a) -> Property
162-forValidIntTree f
163-  = forValid f
164-
165-forValidUnitTree :: Testable a => (Set Int -> a) -> Property
166-forValidUnitTree f
167-  = forValid f
168-
169-
170-prop_Valid
171-  = forValidUnitTree $ \t -> valid t
172-
173-{--------------------------------------------------------------------
174-  Single, Insert, Delete
175---------------------------------------------------------------------}
176-prop_Single :: Int -> Bool
177-prop_Single x
178-  = (insert x empty == singleton x)
179-
180-prop_InsertValid :: Int -> Property
181-prop_InsertValid k
182-  = forValidUnitTree $ \t -> valid (insert k t)
183-
184-prop_InsertDelete :: Int -> Set Int -> Property
185-prop_InsertDelete k t
186-  = not (member k t) ==> delete k (insert k t) == t
187-
188-prop_DeleteValid :: Int -> Property
189-prop_DeleteValid k
190-  = forValidUnitTree $ \t ->
191-    valid (delete k (insert k t))
192-
193-{--------------------------------------------------------------------
194-  Balance
195---------------------------------------------------------------------}
196-prop_Join :: Int -> Property
197-prop_Join x
198-  = forValidUnitTree $ \t ->
199-    let (l,r) = split x t
200-    in valid (join x l r)
201-
202-prop_Merge :: Int -> Property
203-prop_Merge x
204-  = forValidUnitTree $ \t ->
205-    let (l,r) = split x t
206-    in valid (merge l r)
207-
208-
209-{--------------------------------------------------------------------
210-  Union
211---------------------------------------------------------------------}
212-prop_UnionValid :: Property
213-prop_UnionValid
214-  = forValidUnitTree $ \t1 ->
215-    forValidUnitTree $ \t2 ->
216-    valid (union t1 t2)
217-
218-prop_UnionInsert :: Int -> Set Int -> Bool
219-prop_UnionInsert x t
220-  = union t (singleton x) == insert x t
221-
222-prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool
223-prop_UnionAssoc t1 t2 t3
224-  = union t1 (union t2 t3) == union (union t1 t2) t3
225-
226-prop_UnionComm :: Set Int -> Set Int -> Bool
227-prop_UnionComm t1 t2
228-  = (union t1 t2 == union t2 t1)
229-
230-
231-prop_DiffValid
232-  = forValidUnitTree $ \t1 ->
233-    forValidUnitTree $ \t2 ->
234-    valid (difference t1 t2)
235-
236-prop_Diff :: [Int] -> [Int] -> Bool
237-prop_Diff xs ys
238-  =  toAscList (difference (fromList xs) (fromList ys))
239-    == List.sort ((List.\\) (nub xs)  (nub ys))
240-
241-prop_IntValid
242-  = forValidUnitTree $ \t1 ->
243-    forValidUnitTree $ \t2 ->
244-    valid (intersection t1 t2)
245-
246-prop_Int :: [Int] -> [Int] -> Bool
247-prop_Int xs ys
248-  =  toAscList (intersection (fromList xs) (fromList ys))
249-    == List.sort (nub ((List.intersect) (xs)  (ys)))
250-
251-{--------------------------------------------------------------------
252-  Lists
253---------------------------------------------------------------------}
254-prop_Ordered
255-  = forAll (choose (5,100)) $ \n ->
256-    let xs = [0..n::Int]
257-    in fromAscList xs == fromList xs
258-
259-prop_List :: [Int] -> Bool
260-prop_List xs
261-  = (sort (nub xs) == toList (fromList xs))
262--}
263addfile ./tests/Set.hs
264hunk ./tests/Set.hs 1
265+{-# LANGUAGE CPP, ScopedTypeVariables #-}
266+
267+-- QuickCheck properties for Data.Set
268+-- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i..  Set.hs
269+
270+import Data.List (nub,sort)
271+import qualified Data.List as List
272+import Data.Set
273+import Prelude hiding (lookup, null, map ,filter)
274+import Test.QuickCheck
275+
276+main :: IO ()
277+main = do
278+    q $ label "prop_Valid" prop_Valid
279+    q $ label "prop_Single" prop_Single
280+    q $ label "prop_Single" prop_Single
281+    q $ label "prop_InsertValid" prop_InsertValid
282+    q $ label "prop_InsertValid" prop_InsertValid
283+    q $ label "prop_InsertDelete" prop_InsertDelete
284+    q $ label "prop_InsertDelete" prop_InsertDelete
285+    q $ label "prop_DeleteValid" prop_DeleteValid
286+    q $ label "prop_DeleteValid" prop_DeleteValid
287+    q $ label "prop_Join" prop_Join
288+    q $ label "prop_Join" prop_Join
289+    q $ label "prop_Merge" prop_Merge
290+    q $ label "prop_Merge" prop_Merge
291+    q $ label "prop_UnionValid" prop_UnionValid
292+    q $ label "prop_UnionValid" prop_UnionValid
293+    q $ label "prop_UnionInsert" prop_UnionInsert
294+    q $ label "prop_UnionInsert" prop_UnionInsert
295+    q $ label "prop_UnionAssoc" prop_UnionAssoc
296+    q $ label "prop_UnionAssoc" prop_UnionAssoc
297+    q $ label "prop_UnionComm" prop_UnionComm
298+    q $ label "prop_UnionComm" prop_UnionComm
299+    q $ label "prop_DiffValid" prop_DiffValid
300+    q $ label "prop_Diff" prop_Diff
301+    q $ label "prop_Diff" prop_Diff
302+    q $ label "prop_IntValid" prop_IntValid
303+    q $ label "prop_Int" prop_Int
304+    q $ label "prop_Int" prop_Int
305+    q $ label "prop_Ordered" prop_Ordered
306+    q $ label "prop_List" prop_List
307+    q $ label "prop_List" prop_List
308+  where
309+    q :: Testable prop => prop -> IO ()
310+    q = quickCheckWith args
311+
312+{--------------------------------------------------------------------
313+  QuickCheck
314+--------------------------------------------------------------------}
315+
316+args :: Args
317+args = stdArgs { maxSuccess = 500
318+               , maxDiscard = 500
319+               }
320+
321+{--------------------------------------------------------------------
322+  Arbitrary, reasonably balanced trees
323+--------------------------------------------------------------------}
324+instance (Enum a) => Arbitrary (Set a) where
325+    arbitrary = sized (arbtree 0 maxkey)
326+      where maxkey = 10000
327+
328+arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a)
329+arbtree lo hi n
330+    | n <= 0    = return Tip
331+    | lo >= hi  = return Tip
332+    | otherwise = do  i  <- choose (lo,hi)
333+                      m  <- choose (1,30)
334+                      let (ml,mr) | m==(1::Int) = (1,2)
335+                                  | m==2        = (2,1)
336+                                  | m==3        = (1,1)
337+                                  | otherwise   = (2,2)
338+                      l  <- arbtree lo (i-1) (n `div` ml)
339+                      r  <- arbtree (i+1) hi (n `div` mr)
340+                      return (bin (toEnum i) l r)
341+
342+{--------------------------------------------------------------------
343+  Valid tree's
344+--------------------------------------------------------------------}
345+forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property
346+forValid f = forAll arbitrary $ \t ->
347+--    classify (balanced t) "balanced" $
348+    classify (size t == 0) "empty" $
349+    classify (size t > 0  && size t <= 10) "small" $
350+    classify (size t > 10 && size t <= 64) "medium" $
351+    classify (size t > 64) "large" $
352+    balanced t ==> f t
353+
354+forValidUnitTree :: Testable a => (Set Int -> a) -> Property
355+forValidUnitTree f = forValid f
356+
357+prop_Valid :: Property
358+prop_Valid = forValidUnitTree $ \t -> valid t
359+
360+{--------------------------------------------------------------------
361+  Single, Insert, Delete
362+--------------------------------------------------------------------}
363+prop_Single :: Int -> Bool
364+prop_Single x = (insert x empty == singleton x)
365+
366+prop_InsertValid :: Int -> Property
367+prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k t)
368+
369+prop_InsertDelete :: Int -> Set Int -> Property
370+prop_InsertDelete k t = not (member k t) ==> delete k (insert k t) == t
371+
372+prop_DeleteValid :: Int -> Property
373+prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k t))
374+
375+{--------------------------------------------------------------------
376+  Balance
377+--------------------------------------------------------------------}
378+prop_Join :: Int -> Property
379+prop_Join x = forValidUnitTree $ \t ->
380+    let (l,r) = split x t
381+    in valid (join x l r)
382+
383+prop_Merge :: Int -> Property
384+prop_Merge x = forValidUnitTree $ \t ->
385+    let (l,r) = split x t
386+    in valid (merge l r)
387+
388+{--------------------------------------------------------------------
389+  Union
390+--------------------------------------------------------------------}
391+prop_UnionValid :: Property
392+prop_UnionValid
393+  = forValidUnitTree $ \t1 ->
394+    forValidUnitTree $ \t2 ->
395+    valid (union t1 t2)
396+
397+prop_UnionInsert :: Int -> Set Int -> Bool
398+prop_UnionInsert x t = union t (singleton x) == insert x t
399+
400+prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool
401+prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
402+
403+prop_UnionComm :: Set Int -> Set Int -> Bool
404+prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1)
405+
406+prop_DiffValid :: Property
407+prop_DiffValid = forValidUnitTree $ \t1 ->
408+    forValidUnitTree $ \t2 ->
409+    valid (difference t1 t2)
410+
411+prop_Diff :: [Int] -> [Int] -> Bool
412+prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys))
413+                  == List.sort ((List.\\) (nub xs)  (nub ys))
414+
415+prop_IntValid :: Property
416+prop_IntValid = forValidUnitTree $ \t1 ->
417+    forValidUnitTree $ \t2 ->
418+    valid (intersection t1 t2)
419+
420+prop_Int :: [Int] -> [Int] -> Bool
421+prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys))
422+                 == List.sort (nub ((List.intersect) (xs)  (ys)))
423+
424+{--------------------------------------------------------------------
425+  Lists
426+--------------------------------------------------------------------}
427+prop_Ordered :: Property
428+prop_Ordered = forAll (choose (5,100)) $ \n ->
429+    let xs = [0..n::Int]
430+    in fromAscList xs == fromList xs
431+
432+prop_List :: [Int] -> Bool
433+prop_List xs = (sort (nub xs) == toList (fromList xs))
434}
435[Added benchmarks for Data.Set
436Johan Tibell <[email protected]>**20100831124225
437 Ignore-this: fcacf88761034b8c534d936f0b336cc0
438] {
439adddir ./benchmarks
440addfile ./benchmarks/Set.hs
441hunk ./benchmarks/Set.hs 1
442+{-# LANGUAGE BangPatterns #-}
443+
444+-- > ghc -DTESTING --make -O2 -fforce-recomp -i.. Set.hs
445+module Main where
446+
447+import Control.DeepSeq
448+import Control.Exception (evaluate)
449+import Control.Monad.Trans (liftIO)
450+import Criterion.Config
451+import Criterion.Main
452+import Data.List (foldl')
453+import qualified Data.Set as S
454+
455+instance NFData a => NFData (S.Set a) where
456+    rnf S.Tip = ()
457+    rnf (S.Bin _ a l r) = rnf a `seq` rnf l `seq` rnf r
458+
459+main = do
460+    let s = S.fromAscList elems :: S.Set Int
461+        s2 = S.fromAscList [-1, -2 .. -(2^10)] :: S.Set Int
462+    defaultMainWith
463+        defaultConfig
464+        (liftIO . evaluate $ rnf [s, s2])
465+        [ bench "member" $ nf (member elems) s
466+        , bench "insert" $ nf (ins elems) S.empty
467+        , bench "map" $ nf (S.map (+ 1)) s
468+        , bench "filter" $ nf (S.filter ((== 0) . (`mod` 2))) s
469+        , bench "partition" $ nf (S.partition ((== 0) . (`mod` 2))) s
470+        , bench "fold" $ nf (S.fold (:) []) s
471+        , bench "delete" $ nf (del elems) s
472+        , bench "findMin" $ nf S.findMin s
473+        , bench "findMax" $ nf S.findMax s
474+        , bench "deleteMin" $ nf S.deleteMin s
475+        , bench "deleteMax" $ nf S.deleteMax s
476+        , bench "unions" $ nf S.unions [s, s2]
477+        , bench "union" $ nf (S.union s) s2
478+        ]
479+  where
480+    elems = [1..2^10]
481+
482+member :: [Int] -> S.Set Int -> Int
483+member xs s = foldl' (\n x -> if S.member x s then n + 1 else n) 0 xs
484+
485+ins :: [Int] -> S.Set Int -> S.Set Int
486+ins xs s0 = foldl' (\s a -> S.insert a s) s0 xs
487+
488+del :: [Int] -> S.Set Int -> S.Set Int
489+del xs s0 = foldl' (\s k -> S.delete k s) s0 xs
490}
491[Improved performance of Data.Set
492Johan Tibell <[email protected]>**20100831124352
493 Ignore-this: 38a304a0408d29a2956aa9a1fc0ce755
494 
495 Performance improvements are due to manually applying the
496 worker/wrapper transformation and strictifying the keys.
497 
498 Average speed-up is 32% on a 2GHz Core 2 Duo on OS X 10.5.8
499] {
500hunk ./Data/Set.hs 23
501 -- trees of /bounded balance/) as described by:
502 --
503 --    * Stephen Adams, \"/Efficient sets: a balancing act/\",
504---     Journal of Functional Programming 3(4):553-562, October 1993,
505---     <http://www.swiss.ai.mit.edu/~adams/BB/>.
506+--      Journal of Functional Programming 3(4):553-562, October 1993,
507+--      <http://www.swiss.ai.mit.edu/~adams/BB/>.
508 --
509 --    * J. Nievergelt and E.M. Reingold,
510hunk ./Data/Set.hs 27
511---     \"/Binary search trees of bounded balance/\",
512---     SIAM journal of computing 2(1), March 1973.
513+--      \"/Binary search trees of bounded balance/\",
514+--      SIAM journal of computing 2(1), March 1973.
515 --
516 -- Note that the implementation is /left-biased/ -- the elements of a
517 -- first argument are always preferred to the second, for example in
518hunk ./Data/Set.hs 63
519             , delete
520             
521             -- * Combine
522-            , union, unions
523+            , union
524+            , unions
525             , difference
526             , intersection
527             
528hunk ./Data/Set.hs 75
529             , splitMember
530 
531             -- * Map
532-           , map
533-           , mapMonotonic
534+            , map
535+            , mapMonotonic
536 
537             -- * Fold
538             , fold
539hunk ./Data/Set.hs 146
540 -- | /O(n+m)/. See 'difference'.
541 (\\) :: Ord a => Set a -> Set a -> Set a
542 m1 \\ m2 = difference m1 m2
543+{-# INLINE (\\) #-}
544 
545 {--------------------------------------------------------------------
546   Sets are size balanced trees
547hunk ./Data/Set.hs 189
548 --------------------------------------------------------------------}
549 -- | /O(1)/. Is this the empty set?
550 null :: Set a -> Bool
551-null t
552-  = case t of
553-      Tip    -> True
554-      Bin {} -> False
555+null Tip      = True
556+null (Bin {}) = False
557+{-# INLINE null #-}
558 
559 -- | /O(1)/. The number of elements in the set.
560 size :: Set a -> Int
561hunk ./Data/Set.hs 195
562-size t
563-  = case t of
564-      Tip          -> 0
565-      Bin sz _ _ _ -> sz
566+size = go
567+  where
568+    go Tip            = 0
569+    go (Bin sz _ _ _) = sz
570+{-# INLINE size #-}
571 
572 -- | /O(log n)/. Is the element in the set?
573 member :: Ord a => a -> Set a -> Bool
574hunk ./Data/Set.hs 203
575-member x t
576-  = case t of
577-      Tip -> False
578-      Bin _ y l r
579-          -> case compare x y of
580-               LT -> member x l
581-               GT -> member x r
582-               EQ -> True       
583-
584+member x = x `seq` go
585+  where
586+    go Tip = False
587+    go (Bin _ y l r) = case compare x y of
588+        LT -> go l
589+        GT -> go r
590+        EQ -> True       
591+{-# INLINE member #-}
592+       
593 -- | /O(log n)/. Is the element not in the set?
594 notMember :: Ord a => a -> Set a -> Bool
595hunk ./Data/Set.hs 214
596-notMember x t = not $ member x t
597+notMember a t = not $ member a t
598+{-# INLINE notMember #-}
599 
600 {--------------------------------------------------------------------
601   Construction
602hunk ./Data/Set.hs 222
603 --------------------------------------------------------------------}
604 -- | /O(1)/. The empty set.
605 empty  :: Set a
606-empty
607-  = Tip
608+empty = Tip
609+{-# INLINE empty #-}
610 
611 -- | /O(1)/. Create a singleton set.
612 singleton :: a -> Set a
613hunk ./Data/Set.hs 227
614-singleton x
615-  = Bin 1 x Tip Tip
616+singleton x = Bin 1 x Tip Tip
617+{-# INLINE singleton #-}
618 
619 {--------------------------------------------------------------------
620   Insertion, Deletion
621hunk ./Data/Set.hs 237
622 -- If the set already contains an element equal to the given value,
623 -- it is replaced with the new value.
624 insert :: Ord a => a -> Set a -> Set a
625-insert x t
626-  = case t of
627-      Tip -> singleton x
628-      Bin sz y l r
629-          -> case compare x y of
630-               LT -> balance y (insert x l) r
631-               GT -> balance y l (insert x r)
632-               EQ -> Bin sz x l r
633-
634+insert x = x `seq` go
635+  where
636+    go Tip = singleton x
637+    go (Bin sz y l r) = case compare x y of
638+        LT -> balance y (go l) r
639+        GT -> balance y l (go r)
640+        EQ -> Bin sz x l r
641+{-# INLINE insert #-}
642 
643 -- | /O(log n)/. Delete an element from a set.
644 delete :: Ord a => a -> Set a -> Set a
645hunk ./Data/Set.hs 248
646-delete x t
647-  = case t of
648-      Tip -> Tip
649-      Bin _ y l r
650-          -> case compare x y of
651-               LT -> balance y (delete x l) r
652-               GT -> balance y l (delete x r)
653-               EQ -> glue l r
654+delete x = x `seq` go
655+  where
656+    go Tip = Tip
657+    go (Bin _ y l r) = case compare x y of
658+        LT -> balance y (go l) r
659+        GT -> balance y l (go r)
660+        EQ -> glue l r
661+{-# INLINE delete #-}
662 
663 {--------------------------------------------------------------------
664   Subset
665hunk ./Data/Set.hs 308
666 deleteMax (Bin _ x l r)   = balance x l (deleteMax r)
667 deleteMax Tip             = Tip
668 
669-
670 {--------------------------------------------------------------------
671   Union.
672 --------------------------------------------------------------------}
673hunk ./Data/Set.hs 313
674 -- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@).
675 unions :: Ord a => [Set a] -> Set a
676-unions ts
677-  = foldlStrict union empty ts
678-
679+unions = foldlStrict union empty
680+{-# INLINE unions #-}
681 
682 -- | /O(n+m)/. The union of two sets, preferring the first set when
683 -- equal elements are encountered.
684hunk ./Data/Set.hs 324
685 union Tip t2  = t2
686 union t1 Tip  = t1
687 union t1 t2 = hedgeUnion (const LT) (const GT) t1 t2
688+{-# INLINE union #-}
689 
690 hedgeUnion :: Ord a
691            => (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a -> Set a
692hunk ./Data/Set.hs 347
693 difference Tip _   = Tip
694 difference t1 Tip  = t1
695 difference t1 t2   = hedgeDiff (const LT) (const GT) t1 t2
696+{-# INLINE difference #-}
697 
698 hedgeDiff :: Ord a
699           => (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a -> Set a
700hunk ./Data/Set.hs 397
701 --------------------------------------------------------------------}
702 -- | /O(n)/. Filter all elements that satisfy the predicate.
703 filter :: Ord a => (a -> Bool) -> Set a -> Set a
704-filter _ Tip = Tip
705-filter p (Bin _ x l r)
706-  | p x       = join x (filter p l) (filter p r)
707-  | otherwise = merge (filter p l) (filter p r)
708+filter p = go
709+  where
710+    go Tip = Tip
711+    go (Bin _ x l r)
712+        | p x       = join x (go l) (go r)
713+        | otherwise = merge (go l) (go r)
714+{-# INLINE filter #-}
715 
716 -- | /O(n)/. Partition the set into two sets, one with all elements that satisfy
717 -- the predicate and one with all elements that don't satisfy the predicate.
718hunk ./Data/Set.hs 409
719 -- See also 'split'.
720 partition :: Ord a => (a -> Bool) -> Set a -> (Set a,Set a)
721-partition _ Tip = (Tip,Tip)
722-partition p (Bin _ x l r)
723-  | p x       = (join x l1 r1,merge l2 r2)
724-  | otherwise = (merge l1 r1,join x l2 r2)
725+partition p = go
726   where
727hunk ./Data/Set.hs 411
728-    (l1,l2) = partition p l
729-    (r1,r2) = partition p r
730+    go Tip = (Tip, Tip)
731+    go (Bin _ x l r) = case (go l, go r) of
732+        ((l1, l2), (r1, r2))
733+            | p x       -> (join x l1 r1, merge l2 r2)
734+            | otherwise -> (merge l1 r1, join x l2 r2)
735+{-# INLINE partition #-}
736 
737 {----------------------------------------------------------------------
738   Map
739hunk ./Data/Set.hs 430
740 
741 map :: (Ord a, Ord b) => (a->b) -> Set a -> Set b
742 map f = fromList . List.map f . toList
743+{-# INLINE map #-}
744 
745 -- | /O(n)/. The
746 --
747hunk ./Data/Set.hs 443
748 -- >     where ls = toList s
749 
750 mapMonotonic :: (a->b) -> Set a -> Set b
751-mapMonotonic _ Tip = Tip
752-mapMonotonic f (Bin sz x l r) =
753-    Bin sz (f x) (mapMonotonic f l) (mapMonotonic f r)
754-
755+mapMonotonic f = go
756+  where
757+    go Tip = Tip
758+    go (Bin sz x l r) = Bin sz (f x) (go l) (go r)
759+{-# INLINE mapMonotonic #-}
760 
761 {--------------------------------------------------------------------
762   Fold
763hunk ./Data/Set.hs 454
764 --------------------------------------------------------------------}
765 -- | /O(n)/. Fold over the elements of a set in an unspecified order.
766 fold :: (a -> b -> b) -> b -> Set a -> b
767-fold f z s
768-  = foldr f z s
769+fold = foldr
770+{-# INLINE fold #-}
771 
772 -- | /O(n)/. Post-order fold.
773 foldr :: (a -> b -> b) -> b -> Set a -> b
774hunk ./Data/Set.hs 459
775-foldr _ z Tip           = z
776-foldr f z (Bin _ x l r) = foldr f (f x (foldr f z r)) l
777+foldr f = go
778+  where
779+    go z Tip           = z
780+    go z (Bin _ x l r) = go (f x (go z r)) l
781+{-# INLINE foldr #-}
782 
783 {--------------------------------------------------------------------
784   List variations
785hunk ./Data/Set.hs 470
786 --------------------------------------------------------------------}
787 -- | /O(n)/. The elements of a set.
788 elems :: Set a -> [a]
789-elems s
790-  = toList s
791+elems = toList
792+{-# INLINE elems #-}
793 
794 {--------------------------------------------------------------------
795   Lists
796hunk ./Data/Set.hs 478
797 --------------------------------------------------------------------}
798 -- | /O(n)/. Convert the set to a list of elements.
799 toList :: Set a -> [a]
800-toList s
801-  = toAscList s
802+toList = toAscList
803+{-# INLINE toList #-}
804 
805 -- | /O(n)/. Convert the set to an ascending list of elements.
806 toAscList :: Set a -> [a]
807hunk ./Data/Set.hs 483
808-toAscList t   
809-  = foldr (:) [] t
810-
811+toAscList = foldr (:) []
812+{-# INLINE toAscList #-}
813 
814 -- | /O(n*log n)/. Create a set from a list of elements.
815 fromList :: Ord a => [a] -> Set a
816hunk ./Data/Set.hs 488
817-fromList xs
818-  = foldlStrict ins empty xs
819+fromList = foldlStrict ins empty
820   where
821     ins t x = insert x t
822hunk ./Data/Set.hs 491
823+{-# INLINE fromList #-}
824 
825 {--------------------------------------------------------------------
826   Building trees from ascending/descending lists can be done in linear time.
827hunk ./Data/Set.hs 629
828       LT -> join x (filterGt cmp l) r
829       GT -> filterGt cmp r
830       EQ -> r
831+{-# INLINE filterGt #-}
832       
833 filterLt :: (a -> Ordering) -> Set a -> Set a
834 filterLt _ Tip = Tip
835hunk ./Data/Set.hs 638
836       LT -> filterLt cmp l
837       GT -> join x l (filterLt cmp r)
838       EQ -> l
839-
840+{-# INLINE filterLt #-}
841 
842 {--------------------------------------------------------------------
843   Split
844hunk ./Data/Set.hs 880
845   Utilities
846 --------------------------------------------------------------------}
847 foldlStrict :: (a -> b -> a) -> a -> [b] -> a
848-foldlStrict f z xs
849-  = case xs of
850-      []     -> z
851-      (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
852-
853+foldlStrict f = go
854+  where
855+    go z []     = z
856+    go z (x:xs) = z `seq` go (f z x) xs
857+{-# INLINE foldlStrict #-}
858 
859 {--------------------------------------------------------------------
860   Debugging
861}
862
863Context:
864
865[Set Data.Map's delta to 4; fixes #4242
866Ian Lynagh <[email protected]>**20100815131954]
867[Add a test for #4242
868Ian Lynagh <[email protected]>**20100815131856]
869[Add a local type signature
870[email protected]**20100730124447
871 Ignore-this: b581d3f2c80a7a860456d589960f12f2
872]
873[Add type signature in local where clause
874[email protected]**20100727151709
875 Ignore-this: 5929c4156500b25b280eb414b508c508
876]
877[Fix Data.Sequence's breakr, and add a test for it; fixes trac #4157
878Ian Lynagh <[email protected]>**20100704140627]
879[Fix proposal #4109: Make Data.Map.insertWith's strictness consistent
880Ian Lynagh <[email protected]>**20100615133055]
881[Tweak layout to work with the alternative layout rule
882Ian Lynagh <[email protected]>**20091129154519]
883[Disable building Data.Sequence (and dependents) for nhc98.
884[email protected]**20091124025653
885 There is some subtlety of polymorphically recursive datatypes and
886 type-class defaulting that nhc98's type system barfs over.
887]
888[Fix another instance of non-ghc breakage.
889[email protected]**20091123092637]
890[Add #ifdef around ghc-only (<$) as member of Functor class.
891[email protected]**20091123085155]
892[Fix broken code in non-GHC branch of an ifdef.
893[email protected]**20091123084824]
894[doc bugfix: correct description of index argument
895Ross Paterson <[email protected]>**20091028105532
896 Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9
897 
898 As noted by iaefai on the libraries list.
899 
900 Please merge to STABLE.
901]
902[Bump version to 0.3.0.0
903Ian Lynagh <[email protected]>**20090920141847]
904[update base dependency
905Ross Paterson <[email protected]>**20090916073125
906 Ignore-this: ad382ffc6c6a18c15364e6c072f19edb
907 
908 The package uses mkNoRepType and Data.Functor, which were not in the
909 stable branch of base-4.
910]
911[add fast version of <$ for Seq
912Ross Paterson <[email protected]>**20090916072812
913 Ignore-this: 5a39a7d31d39760ed589790b1118d240
914]
915[new methods for Data.Sequence (proposal #3271)
916Ross Paterson <[email protected]>**20090915173324
917 Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7
918 
919 Adds a lot of new methods to Data.Sequence, mostly paralleling those
920 in Data.List.  Several of these are significantly faster than versions
921 implemented with the previous public interface.  In particular, replicate
922 takes O(log n) time and space instead of O(n).
923 (by Louis Wasserman)
924]
925[Fix "Cabal check" warnings
926Ian Lynagh <[email protected]>**20090811215900]
927[TAG 2009-06-25
928Ian Lynagh <[email protected]>**20090625160202]
929Patch bundle hash:
930b73422ae705452c11a8537f62057117e73c9c6f0