Ticket #4279: _o2-_fregs_graph-is-a-uniform-10_-improvements-for-intmap.dpatch

File _o2-_fregs_graph-is-a-uniform-10_-improvements-for-intmap.dpatch, 88.1 KB (added by dons, 5 years ago)
Line 
14 patches for repository http://darcs.haskell.org/packages/containers:
2
3Tue Aug 31 11:29:56 CEST 2010  Don Stewart <[email protected]>
4  * -O2 -fregs-graph is a uniform 10% improvements for IntMap
5
6Tue Aug 31 11:32:02 CEST 2010  Don Stewart <[email protected]>
7  * Add comprehensive testsuite for IntMap
8
9Tue Aug 31 11:33:16 CEST 2010  Don Stewart <[email protected]>
10  * Performance improvements for Data.IntMap (worker/wrapper and inlining)
11
12Tue Aug 31 11:34:46 CEST 2010  Don Stewart <[email protected]>
13  * Missing MagicHash for IntSet
14
15New patches:
16
17[-O2 -fregs-graph is a uniform 10% improvements for IntMap
18Don Stewart <[email protected]>**20100831092956
19 Ignore-this: 2372cf4be945fe7939d0af94e32c567f
20] hunk ./containers.cabal 24
21 
22 Library {
23     build-depends: base >= 4.2 && < 6, array
24+    ghc-options: -O2
25+    if impl(ghc>6.10)
26+        Ghc-Options: -fregs-graph
27     exposed-modules:
28         Data.IntMap
29         Data.IntSet
30[Add comprehensive testsuite for IntMap
31Don Stewart <[email protected]>**20100831093202
32 Ignore-this: d455fedbc615e5b63ac488e605550557
33] {
34addfile ./tests/intmap-properties.hs
35hunk ./tests/intmap-properties.hs 1
36+{-# LANGUAGE ScopedTypeVariables #-}
37+{-# LANGUAGE CPP #-}
38+--
39+-- QuickCheck properties for Data.IntMap
40+-- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i..  intmap-properties.hs
41+
42+import Data.IntMap
43+import Data.Monoid
44+import Data.Maybe hiding (mapMaybe)
45+import Data.Ord
46+import Data.Function
47+import Test.QuickCheck
48+import Text.Show.Functions
49+import Prelude hiding (lookup, null, map ,filter)
50+import qualified Prelude (map, filter)
51+import qualified Data.List as List
52+
53+import Control.Applicative ((<$>),(<*>))
54+import Data.List (nub,sort)
55+import qualified Data.List as L ((\\),intersect)
56+import qualified Data.IntSet
57+import Data.Maybe (isJust,fromJust)
58+import Prelude hiding (lookup,map,filter,null)
59+import qualified Prelude as P (map)
60+import Test.Framework (defaultMain, testGroup, Test)
61+import Test.Framework.Providers.HUnit
62+import Test.Framework.Providers.QuickCheck2
63+import Test.HUnit hiding (Test, Testable)
64+import Test.QuickCheck
65+
66+type Map = IntMap
67+
68+main = do
69+--    q $ label   "prop_Valid"            prop_Valid
70+    q $ label   "prop_Single"           prop_Single
71+--    q $ label   "prop_InsertValid"      prop_InsertValid
72+    q $ label   "prop_InsertDelete"     prop_InsertDelete
73+--    q $ label   "prop_DeleteValid"      prop_DeleteValid
74+--    q $ label   "prop_Join"             prop_Join
75+--    q $ label   "prop_Merge"            prop_Merge
76+--    q $ label   "prop_UnionValid"       prop_UnionValid
77+    q $ label   "prop_UnionInsert"      prop_UnionInsert
78+    q $ label   "prop_UnionAssoc"       prop_UnionAssoc
79+    q $ label   "prop_UnionComm"        prop_UnionComm
80+--    q $ label   "prop_UnionWithValid"   prop_UnionWithValid
81+    q $ label   "prop_UnionWith"        prop_UnionWith
82+--    q $ label   "prop_DiffValid"        prop_DiffValid
83+    q $ label   "prop_Diff"             prop_Diff
84+    q $ label   "prop_Diff2"            prop_Diff2
85+--    q $ label   "prop_IntValid"         prop_IntValid
86+    q $ label   "prop_Int"              prop_Int
87+    q $ label   "prop_Ordered"          prop_Ordered
88+    q $ label   "prop_List"             prop_List
89+
90+    -- new tests
91+    q $ label   "prop_index"            prop_index
92+    q $ label   "prop_null"             prop_null
93+    q $ label   "prop_member"           prop_member
94+    q $ label   "prop_notmember"        prop_notmember
95+    q $ label   "prop_findWithDefault"  prop_findWithDefault
96+--    q $ label   "prop_findIndex"        prop_findIndex
97+    q $ label   "prop_findMin"          prop_findMin
98+    q $ label   "prop_findMax"          prop_findMax
99+    q $ label   "prop_filter"           prop_filter
100+    q $ label   "prop_partition"        prop_partition
101+    q $ label   "prop_map"              prop_map
102+    q $ label   "prop_fmap"              prop_fmap
103+--    q $ label   "prop_mapkeys"          prop_mapkeys
104+--    q $ label   "prop_foldr"            prop_foldr
105+--    q $ label   "prop_foldl"            prop_foldl
106+--    q $ label   "prop_foldl'"           prop_foldl'
107+    q $ label   "prop_fold"           prop_fold
108+    q $ label   "prop_folWithKeyd"           prop_foldWithKey
109+
110+    defaultMain tests
111+
112+  where
113+    q :: Testable prop => prop -> IO ()
114+    q = quickCheckWith args
115+
116+
117+{--------------------------------------------------------------------
118+  Testing
119+--------------------------------------------------------------------}
120+testTree xs   = fromList [(x,"*") | x <- xs]
121+test1 = testTree [1..20]
122+test2 = testTree [30,29..10]
123+test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
124+
125+
126+{--------------------------------------------------------------------
127+  QuickCheck
128+--------------------------------------------------------------------}
129+
130+args = stdArgs {
131+                 maxSuccess = 500
132+               , maxDiscard = 500
133+               }
134+
135+{-
136+qcheck prop
137+  = check config prop
138+  where
139+    config = Config
140+      { configMaxTest = 500
141+      , configMaxFail = 5000
142+      , configSize    = \n -> (div n 2 + 3)
143+      , configEvery   = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
144+      }
145+-}
146+
147+
148+{--------------------------------------------------------------------
149+  Arbitrary, reasonably balanced trees
150+--------------------------------------------------------------------}
151+-- instance (Arbitrary a) => Arbitrary (IntMap a) where
152+--   arbitrary = sized (arbtree 0 maxkey)
153+--             where maxkey  = 10^5
154+
155+instance Arbitrary a => Arbitrary (IntMap a) where
156+  arbitrary = do{ ks <- arbitrary
157+                ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks
158+                ; return (fromList xs)
159+                }
160+
161+
162+{-
163+--
164+-- requires access to internals
165+--
166+
167+arbtree :: (Arbitrary a) => Int -> Int -> Int -> Gen (IntMap a)
168+arbtree lo hi n
169+  | n <= 0        = return empty
170+  | lo >= hi      = return empty
171+  | otherwise     = do{ x  <- arbitrary
172+                      ; i  <- choose (lo,hi)
173+                      ; m  <- choose (1,70)
174+                      ; let (ml,mr)  | m==(1::Int)= (1,2)
175+                                     | m==2       = (2,1)
176+                                     | m==3       = (1,1)
177+                                     | otherwise  = (2,2)
178+                      ; l  <- arbtree lo (i-1) (n `div` ml)
179+                      ; r  <- arbtree (i+1) hi (n `div` mr)
180+                      ; return (unions [singleton (toEnum i) x, l, r ])
181+                      } 
182+-}
183+
184+
185+{--------------------------------------------------------------------
186+  Valid tree's
187+--------------------------------------------------------------------}
188+forValid :: (Show a,Arbitrary a,Testable b) => (Map a -> b) -> Property
189+forValid f
190+  = forAll arbitrary $ \t ->
191+--    classify (balanced t) "balanced" $
192+    classify (size t == 0) "empty" $
193+    classify (size t > 0  && size t <= 10) "small" $
194+    classify (size t > 10 && size t <= 64) "medium" $
195+    classify (size t > 64) "large" $
196+    {-balanced t ==>-} f t
197+
198+forValidIntTree :: Testable a => (Map Int -> a) -> Property
199+forValidIntTree f
200+  = forValid f
201+
202+forValidUnitTree :: Testable a => (Map () -> a) -> Property
203+forValidUnitTree f
204+  = forValid f
205+
206+
207+-- prop_Valid
208+--   = forValidUnitTree $ \t -> valid t
209+
210+{--------------------------------------------------------------------
211+  Single, Insert, Delete
212+--------------------------------------------------------------------}
213+prop_Single :: Int -> Int -> Bool
214+prop_Single k x
215+  = (insert k x empty == singleton k x)
216+
217+-- prop_InsertValid :: Int -> Property
218+-- prop_InsertValid k
219+--   = forValidUnitTree $ \t -> valid (insert k () t)
220+
221+prop_InsertDelete :: Int -> Map () -> Property
222+prop_InsertDelete k t
223+  = (lookup k t == Nothing) ==> delete k (insert k () t) == t
224+
225+-- prop_DeleteValid :: Int -> Property
226+-- prop_DeleteValid k
227+--  = forValidUnitTree $ \t ->
228+--    valid (delete k (insert k () t))
229+
230+{--------------------------------------------------------------------
231+  Balance
232+--------------------------------------------------------------------}
233+
234+{-
235+prop_Join :: Int -> Property
236+prop_Join k
237+  = forValidUnitTree $ \t ->
238+    let (l,r) = split k t
239+    in valid (join k () l r)
240+-}
241+
242+{-
243+prop_Merge :: Int -> Property
244+prop_Merge k
245+  = forValidUnitTree $ \t ->
246+    let (l,r) = split k t
247+    in valid (merge l r)
248+-}
249+
250+
251+{--------------------------------------------------------------------
252+  Union
253+--------------------------------------------------------------------}
254+
255+{-
256+prop_UnionValid :: Property
257+prop_UnionValid
258+  = forValidUnitTree $ \t1 ->
259+    forValidUnitTree $ \t2 ->
260+    valid (union t1 t2)
261+-}
262+
263+prop_UnionInsert :: Int -> Int -> Map Int -> Bool
264+prop_UnionInsert k x t
265+  = union (singleton k x) t == insert k x t
266+
267+prop_UnionAssoc :: Map Int -> Map Int -> Map Int -> Bool
268+prop_UnionAssoc t1 t2 t3
269+  = union t1 (union t2 t3) == union (union t1 t2) t3
270+
271+prop_UnionComm :: Map Int -> Map Int -> Bool
272+prop_UnionComm t1 t2
273+  = (union t1 t2 == unionWith (\x y -> y) t2 t1)
274+
275+{-
276+prop_UnionWithValid
277+  = forValidIntTree $ \t1 ->
278+    forValidIntTree $ \t2 ->
279+    valid (unionWithKey (\k x y -> x+y) t1 t2)
280+-}
281+
282+prop_UnionWith :: [(Int,Int)] -> [(Int,Int)] -> Bool
283+prop_UnionWith xs ys
284+  = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
285+    == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
286+
287+{-
288+prop_DiffValid
289+  = forValidUnitTree $ \t1 ->
290+    forValidUnitTree $ \t2 ->
291+    valid (difference t1 t2)
292+-}
293+
294+prop_Diff :: [(Int,Int)] -> [(Int,Int)] -> Bool
295+prop_Diff xs ys
296+  =  List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
297+    == List.sort ((List.\\) (List.nub (Prelude.map fst xs))  (List.nub (Prelude.map fst ys)))
298+
299+prop_Diff2 :: [(Int,Int)] -> [(Int,Int)] -> Bool
300+prop_Diff2 xs ys
301+  =  List.sort (keys ((\\) (fromListWith (+) xs) (fromListWith (+) ys)))
302+    == List.sort ((List.\\) (List.nub (Prelude.map fst xs))  (List.nub (Prelude.map fst ys)))
303+
304+{-
305+prop_IntValid
306+  = forValidUnitTree $ \t1 ->
307+    forValidUnitTree $ \t2 ->
308+    valid (intersection t1 t2)
309+-}
310+
311+prop_Int :: [(Int,Int)] -> [(Int,Int)] -> Bool
312+prop_Int xs ys
313+  =  List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
314+    == List.sort (List.nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
315+
316+{--------------------------------------------------------------------
317+  Lists
318+--------------------------------------------------------------------}
319+prop_Ordered
320+  = forAll (choose (5,100)) $ \n ->
321+    let xs = [(x,()) | x <- [0..n::Int]]
322+    in fromAscList xs == fromList xs
323+
324+prop_List :: [Int] -> Bool
325+prop_List xs
326+  = (List.sort (List.nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
327+
328+------------------------------------------------------------------------
329+-- New tests: compare against the list model (after nub on keys)
330+
331+prop_index = \(xs :: [Int]) ->  length xs > 0  ==>
332+        let m  = fromList (zip xs xs)
333+        in xs == [ m ! i | i <- xs ]
334+
335+prop_null (m :: Data.IntMap.IntMap Int) = Data.IntMap.null m == (size m == 0)
336+
337+prop_member (xs :: [Int]) n =
338+        let m  = fromList (zip xs xs)
339+        in (n `elem` xs) == (n `member` m)
340+
341+prop_notmember (xs :: [Int]) n =
342+        let m  = fromList (zip xs xs)
343+        in (n `notElem` xs) == (n `notMember` m)
344+
345+prop_findWithDefault = \(ys :: [(Int, Int)]) ->  length ys > 0  ==>
346+        let m  = fromList xs
347+            xs = List.nubBy ((==) `on` fst) ys
348+        in
349+           and [ findWithDefault 0 i m == j | (i,j) <- xs ]
350+
351+-- prop_findIndex = \(ys :: [(Int, Int)]) ->  length ys > 0  ==>
352+--         let m  = fromList ys
353+--         in findIndex (fst (head ys)) m `seq` True
354+
355+-- prop_lookupIndex = \(ys :: [(Int, Int)]) ->  length ys > 0  ==>
356+--         let m  = fromList ys
357+--         in isJust (lookupIndex (fst (head ys)) m)
358+
359+prop_findMin = \(ys :: [(Int, Int)]) ->  length ys > 0  ==>
360+        let m  = fromList ys
361+            xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
362+        in findMin m == List.minimumBy (comparing fst) xs
363+   
364+prop_findMax = \(ys :: [(Int, Int)]) ->  length ys > 0  ==>
365+        let m  = fromList ys
366+            xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
367+        in findMax m == List.maximumBy (comparing fst) xs
368+   
369+prop_filter  = \p (ys :: [(Int, Int)]) ->  length ys > 0  ==>
370+    let m = fromList ys
371+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
372+    in
373+        Data.IntMap.filter p m == fromList (List.filter (p . snd) xs)
374+
375+prop_partition = \p (ys :: [(Int, Int)]) ->  length ys > 0  ==>
376+    let m = fromList ys
377+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
378+    in
379+        Data.IntMap.partition p m == let (a,b) = (List.partition (p . snd) xs) in (fromList a, fromList b)
380+
381+prop_map (f :: Int -> Int) (ys :: [(Int, Int)]) =
382+    let m = fromList ys
383+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
384+    in
385+        Data.IntMap.map f m == fromList [ (a, f b) | (a,b) <- xs ]
386+
387+prop_fmap (f :: Int -> Int) (ys :: [(Int, Int)]) =
388+    let m = fromList ys
389+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
390+    in
391+        fmap f m == fromList [ (a, f b) | (a,b) <- xs ]
392+
393+{-
394+
395+-- mapkeys is hard, as we have to consider collisions of the index space.
396+
397+prop_mapkeys (f :: Int -> Int) (ys :: [(Int, Int)]) =
398+    let m = fromList ys
399+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
400+    in
401+        Data.Map.mapKeys f m ==
402+        (fromList $
403+            {-List.nubBy ((==) `on` fst) $ reverse-} [ (f a, b) | (a,b) <- xs ])
404+-}
405+
406+
407+{-
408+prop_foldr (n :: Int) (ys :: [(Int, Int)]) =
409+    let m = fromList ys
410+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
411+    in
412+        fold (+) n m == List.foldr (+) n (List.map snd xs)
413+  where
414+    fold k = Data.IntMap.foldrWithKey (\_ x' z' -> k x' z')
415+-}
416+
417+{-
418+prop_foldl (n :: Int) (ys :: [(Int, Int)]) =
419+    let m = fromList ys
420+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
421+    in
422+        Data.IntMap.foldlWithKey (\a _ b -> a + b) n m == List.foldl (+) n (List.map snd xs)
423+-}
424+
425+
426+
427+{-
428+prop_foldl' (n :: Int) (ys :: [(Int, Int)]) =
429+    let m = fromList ys
430+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
431+    in
432+        Data.IntMap.foldlWithKey' (\a _ b -> a + b) n m == List.foldl' (+) n (List.map snd xs)
433+-}
434+
435+
436+prop_fold (n :: Int) (ys :: [(Int, Int)]) =
437+    let m = fromList ys
438+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
439+    in
440+        Data.IntMap.fold (+) n m == List.foldr (+) n (List.map snd xs)
441+
442+prop_foldWithKey (n :: Int) (ys :: [(Int, Int)]) =
443+    let m = fromList ys
444+        xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
445+    in
446+        Data.IntMap.foldWithKey (const (+)) n m == List.foldr (+) n (List.map snd xs)
447+
448+------------------------------------------------------------------------
449+
450+type UMap = Map ()
451+type IMap = Map Int
452+type SMap = Map String
453+
454+----------------------------------------------------------------
455+
456+tests :: [Test]
457+tests = [ testGroup "Test Case" [
458+--               testCase "ticket4242" test_ticket4242
459+               testCase "index"      test_index
460+             , testCase "size"       test_size
461+             , testCase "size2"      test_size2
462+             , testCase "member"     test_member
463+             , testCase "notMember"  test_notMember
464+             , testCase "lookup"     test_lookup
465+             , testCase "findWithDefault"     test_findWithDefault
466+             , testCase "empty" test_empty
467+             , testCase "mempty" test_mempty
468+             , testCase "singleton" test_singleton
469+             , testCase "insert" test_insert
470+             , testCase "insertWith" test_insertWith
471+    --         , testCase "insertWith'" test_insertWith'
472+    --         , testCase "insertWithKey" test_insertWithKey
473+    --         , testCase "insertWithKey'" test_insertWithKey'
474+             , testCase "insertLookupWithKey" test_insertLookupWithKey
475+    --         , testCase "insertLookupWithKey'" test_insertLookupWithKey'
476+             , testCase "delete" test_delete
477+             , testCase "adjust" test_adjust
478+             , testCase "adjustWithKey" test_adjustWithKey
479+             , testCase "update" test_update
480+             , testCase "updateWithKey" test_updateWithKey
481+             , testCase "updateLookupWithKey" test_updateLookupWithKey
482+             , testCase "alter" test_alter
483+             , testCase "union" test_union
484+             , testCase "mappend" test_mappend
485+             , testCase "unionWith" test_unionWith
486+             , testCase "unionWithKey" test_unionWithKey
487+             , testCase "unions" test_unions
488+             , testCase "mconcat" test_mconcat
489+             , testCase "unionsWith" test_unionsWith
490+             , testCase "difference" test_difference
491+             , testCase "differenceWith" test_differenceWith
492+             , testCase "differenceWithKey" test_differenceWithKey
493+             , testCase "intersection" test_intersection
494+             , testCase "intersectionWith" test_intersectionWith
495+             , testCase "intersectionWithKey" test_intersectionWithKey
496+             , testCase "map" test_map
497+             , testCase "mapWithKey" test_mapWithKey
498+             , testCase "mapAccum" test_mapAccum
499+             , testCase "mapAccumWithKey" test_mapAccumWithKey
500+             , testCase "mapAccumRWithKey" test_mapAccumRWithKey
501+--             , testCase "mapKeys" test_mapKeys
502+--             , testCase "mapKeysWith" test_mapKeysWith
503+--             , testCase "mapKeysMonotonic" test_mapKeysMonotonic
504+             , testCase "fold" test_fold
505+             , testCase "foldWithKey" test_foldWithKey
506+             , testCase "elems" test_elems
507+             , testCase "keys" test_keys
508+             , testCase "keysSet" test_keysSet
509+             , testCase "associative" test_assocs
510+             , testCase "toList" test_toList
511+             , testCase "fromList" test_fromList
512+             , testCase "fromListWith" test_fromListWith
513+             , testCase "fromListWithKey" test_fromListWithKey
514+             , testCase "toAscList" test_toAscList
515+       --      , testCase "toDescList" test_toDescList
516+             , testCase "showTree" test_showTree
517+         --    , testCase "showTree'" test_showTree'
518+             , testCase "fromAscList" test_fromAscList
519+             , testCase "fromAscListWith" test_fromAscListWith
520+             , testCase "fromAscListWithKey" test_fromAscListWithKey
521+             , testCase "fromDistinctAscList" test_fromDistinctAscList
522+             , testCase "filter" test_filter
523+             , testCase "filterWithKey" test_filteWithKey
524+             , testCase "partition" test_partition
525+             , testCase "partitionWithKey" test_partitionWithKey
526+             , testCase "mapMaybe" test_mapMaybe
527+             , testCase "mapMaybeWithKey" test_mapMaybeWithKey
528+             , testCase "mapEither" test_mapEither
529+             , testCase "mapEitherWithKey" test_mapEitherWithKey
530+             , testCase "split" test_split
531+             , testCase "splitLookup" test_splitLookup
532+             , testCase "isSubmapOfBy" test_isSubmapOfBy
533+             , testCase "isSubmapOf" test_isSubmapOf
534+             , testCase "isProperSubmapOfBy" test_isProperSubmapOfBy
535+             , testCase "isProperSubmapOf" test_isProperSubmapOf
536+--             , testCase "lookupIndex" test_lookupIndex
537+--             , testCase "findIndex" test_findIndex
538+--             , testCase "elemAt" test_elemAt
539+--             , testCase "updateAt" test_updateAt
540+--             , testCase "deleteAt" test_deleteAt
541+             , testCase "findMin" test_findMin
542+             , testCase "findMax" test_findMax
543+             , testCase "deleteMin" test_deleteMin
544+             , testCase "deleteMax" test_deleteMax
545+       --      , testCase "deleteFindMin" test_deleteFindMin
546+       --      , testCase "deleteFindMax" test_deleteFindMax
547+       --      , testCase "updateMin" test_updateMin
548+      --       , testCase "updateMax" test_updateMax
549+      --       , testCase "updateMinWithKey" test_updateMinWithKey
550+      --       , testCase "updateMaxWithKey" test_updateMaxWithKey
551+             , testCase "minView" test_minView
552+             , testCase "maxView" test_maxView
553+             , testCase "minViewWithKey" test_minViewWithKey
554+             , testCase "maxViewWithKey" test_maxViewWithKey
555+--             , testCase "valid" test_valid
556+             ]
557+        , testGroup "Property Test" [
558+    --           testProperty "fromList"             prop_fromList
559+               testProperty "insert to singleton"  prop_singleton
560+    --         , testProperty "insert"               prop_insert
561+             , testProperty "insert then lookup"   prop_lookup
562+    --         , testProperty "insert then delete"   prop_insertDelete
563+    --         , testProperty "insert then delete2"  prop_insertDelete2
564+             , testProperty "delete non member"    prop_deleteNonMember
565+    --         , testProperty "deleteMin"            prop_deleteMin
566+    --         , testProperty "deleteMax"            prop_deleteMax
567+    --         , testProperty "split"                prop_split
568+    --         , testProperty "split then join"      prop_join
569+    --         , testProperty "split then merge"     prop_merge
570+    --         , testProperty "union"                prop_union
571+             , testProperty "union model"          prop_unionModel
572+             , testProperty "union singleton"      prop_unionSingleton
573+             , testProperty "union associative"    prop_unionAssoc
574+             , testProperty "fromAscList"          prop_ordered
575+             , testProperty "fromList then toList" prop_list
576+             , testProperty "unionWith"            prop_unionWith
577+    --         , testProperty "unionWith2"           prop_unionWith2
578+             , testProperty "union sum"            prop_unionSum
579+    --         , testProperty "difference"           prop_difference
580+             , testProperty "difference model"     prop_differenceModel
581+    --         , testProperty "intersection"         prop_intersection
582+             , testProperty "intersection model"   prop_intersectionModel
583+    --         , testProperty "alter"                prop_alter
584+             ]
585+        ]
586+
587+
588+----------------------------------------------------------------
589+-- Unit tests
590+----------------------------------------------------------------
591+
592+-- test_ticket4242 :: Assertion
593+-- test_ticket4242 = (valid $ deleteMin $ deleteMin $ fromList [ (i, ()) | i <- [0,2,5,1,6,4,8,9,7,11,10,3] :: [Int] ]) @?= True
594+
595+----------------------------------------------------------------
596+-- Operators
597+
598+test_index :: Assertion
599+test_index = fromList [(5,'a'), (3,'b')] ! 5 @?= 'a'
600+
601+----------------------------------------------------------------
602+-- Query
603+
604+test_size :: Assertion
605+test_size = do
606+    null (empty)           @?= True
607+    null (singleton 1 'a') @?= False
608+
609+test_size2 :: Assertion
610+test_size2 = do
611+    size empty                                   @?= 0
612+    size (singleton 1 'a')                       @?= 1
613+    size (fromList([(1,'a'), (2,'c'), (3,'b')])) @?= 3
614+
615+test_member :: Assertion
616+test_member = do
617+    member 5 (fromList [(5,'a'), (3,'b')]) @?= True
618+    member 1 (fromList [(5,'a'), (3,'b')]) @?= False
619+
620+test_notMember :: Assertion
621+test_notMember = do
622+    notMember 5 (fromList [(5,'a'), (3,'b')]) @?= False
623+    notMember 1 (fromList [(5,'a'), (3,'b')]) @?= True
624+
625+test_lookup :: Assertion
626+test_lookup = do
627+    employeeCurrency 1 @?= Just 1
628+    employeeCurrency 2 @?= Nothing
629+  where
630+    employeeDept = fromList([(1,2), (3,1)])
631+    deptCountry = fromList([(1,1), (2,2)])
632+    countryCurrency = fromList([(1, 2), (2, 1)])
633+    employeeCurrency :: Int -> Maybe Int
634+    employeeCurrency name = do
635+        dept <- lookup name employeeDept
636+        country <- lookup dept deptCountry
637+        lookup country countryCurrency
638+
639+test_findWithDefault :: Assertion
640+test_findWithDefault = do
641+    findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) @?= 'x'
642+    findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) @?= 'a'
643+
644+----------------------------------------------------------------
645+-- Construction
646+
647+test_empty :: Assertion
648+test_empty = do
649+    (empty :: UMap)  @?= fromList []
650+    size empty @?= 0
651+
652+test_mempty :: Assertion
653+test_mempty = do
654+    (mempty :: UMap)  @?= fromList []
655+    size (mempty :: UMap) @?= 0
656+
657+test_singleton :: Assertion
658+test_singleton = do
659+    singleton 1 'a'        @?= fromList [(1, 'a')]
660+    size (singleton 1 'a') @?= 1
661+
662+test_insert :: Assertion
663+test_insert = do
664+    insert 5 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'x')]
665+    insert 7 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'a'), (7, 'x')]
666+    insert 5 'x' empty                         @?= singleton 5 'x'
667+
668+test_insertWith :: Assertion
669+test_insertWith = do
670+    insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
671+    insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
672+    insertWith (++) 5 "xxx" empty                         @?= singleton 5 "xxx"
673+
674+-- test_insertWith' :: Assertion
675+-- test_insertWith' = do
676+--     insertWith' (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
677+--     insertWith' (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
678+--     insertWith' (++) 5 "xxx" empty                         @?= singleton 5 "xxx"
679+
680+-- test_insertWithKey :: Assertion
681+-- test_insertWithKey = do
682+--     insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
683+--     insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
684+--     insertWithKey f 5 "xxx" empty                         @?= singleton 5 "xxx"
685+--   where
686+--     f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
687+
688+-- test_insertWithKey' :: Assertion
689+-- test_insertWithKey' = do
690+--     insertWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
691+--     insertWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
692+--     insertWithKey' f 5 "xxx" empty                         @?= singleton 5 "xxx"
693+--   where
694+--     f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
695+
696+test_insertLookupWithKey :: Assertion
697+test_insertLookupWithKey = do
698+    insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
699+    insertLookupWithKey f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
700+    insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,  fromList [(3, "b"), (5, "a"), (7, "xxx")])
701+    insertLookupWithKey f 5 "xxx" empty                         @?= (Nothing,  singleton 5 "xxx")
702+  where
703+    f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
704+
705+{-
706+test_insertLookupWithKey' :: Assertion
707+test_insertLookupWithKey' = do
708+    insertLookupWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
709+    insertLookupWithKey' f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
710+    insertLookupWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,  fromList [(3, "b"), (5, "a"), (7, "xxx")])
711+    insertLookupWithKey' f 5 "xxx" empty                         @?= (Nothing,  singleton 5 "xxx")
712+  where
713+    f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
714+-}
715+
716+----------------------------------------------------------------
717+-- Delete/Update
718+
719+test_delete :: Assertion
720+test_delete = do
721+    delete 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
722+    delete 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
723+    delete 5 empty                         @?= (empty :: IMap)
724+
725+test_adjust :: Assertion
726+test_adjust = do
727+    adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
728+    adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
729+    adjust ("new " ++) 7 empty                         @?= empty
730+
731+test_adjustWithKey :: Assertion
732+test_adjustWithKey = do
733+    adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
734+    adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
735+    adjustWithKey f 7 empty                         @?= empty
736+  where
737+    f key x = (show key) ++ ":new " ++ x
738+
739+test_update :: Assertion
740+test_update = do
741+    update f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
742+    update f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
743+    update f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
744+  where
745+    f x = if x == "a" then Just "new a" else Nothing
746+
747+test_updateWithKey :: Assertion
748+test_updateWithKey = do
749+    updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
750+    updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
751+    updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
752+ where
753+     f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
754+
755+test_updateLookupWithKey :: Assertion
756+test_updateLookupWithKey = do
757+    updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:new a")])
758+    updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= (Nothing,  fromList [(3, "b"), (5, "a")])
759+    updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= (Just "b", singleton 5 "a")
760+  where
761+    f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
762+
763+test_alter :: Assertion
764+test_alter = do
765+    alter f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
766+    alter f 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
767+    alter g 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "c")]
768+    alter g 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "c")]
769+  where
770+    f _ = Nothing
771+    g _ = Just "c"
772+
773+----------------------------------------------------------------
774+-- Combine
775+
776+test_union :: Assertion
777+test_union = union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
778+
779+test_mappend :: Assertion
780+test_mappend = mappend (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
781+
782+test_unionWith :: Assertion
783+test_unionWith = unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "aA"), (7, "C")]
784+
785+test_unionWithKey :: Assertion
786+test_unionWithKey = unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
787+  where
788+    f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
789+
790+test_unions :: Assertion
791+test_unions = do
792+    unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
793+        @?= fromList [(3, "b"), (5, "a"), (7, "C")]
794+    unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
795+        @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
796+
797+test_mconcat :: Assertion
798+test_mconcat = do
799+    mconcat [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
800+        @?= fromList [(3, "b"), (5, "a"), (7, "C")]
801+    mconcat [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
802+        @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
803+
804+test_unionsWith :: Assertion
805+test_unionsWith = unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
806+     @?= fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
807+
808+test_difference :: Assertion
809+test_difference = difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 3 "b"
810+
811+test_differenceWith :: Assertion
812+test_differenceWith = differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
813+     @?= singleton 3 "b:B"
814+ where
815+   f al ar = if al== "b" then Just (al ++ ":" ++ ar) else Nothing
816+
817+test_differenceWithKey :: Assertion
818+test_differenceWithKey = differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
819+     @?= singleton 3 "3:b|B"
820+  where
821+    f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
822+
823+test_intersection :: Assertion
824+test_intersection = intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "a"
825+
826+
827+test_intersectionWith :: Assertion
828+test_intersectionWith = intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "aA"
829+
830+test_intersectionWithKey :: Assertion
831+test_intersectionWithKey = intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "5:a|A"
832+  where
833+    f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
834+
835+----------------------------------------------------------------
836+-- Traversal
837+
838+test_map :: Assertion
839+test_map = map (++ "x") (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "bx"), (5, "ax")]
840+
841+test_mapWithKey :: Assertion
842+test_mapWithKey = mapWithKey f (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "3:b"), (5, "5:a")]
843+  where
844+    f key x = (show key) ++ ":" ++ x
845+
846+test_mapAccum :: Assertion
847+test_mapAccum = mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) @?= ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
848+  where
849+    f a b = (a ++ b, b ++ "X")
850+
851+test_mapAccumWithKey :: Assertion
852+test_mapAccumWithKey = mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
853+  where
854+    f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
855+
856+test_mapAccumRWithKey :: Assertion
857+test_mapAccumRWithKey = mapAccumRWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 5-a 3-b", fromList [(3, "bX"), (5, "aX")])
858+  where
859+    f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
860+
861+{-
862+test_mapKeys :: Assertion
863+test_mapKeys = do
864+    mapKeys (+ 1) (fromList [(5,"a"), (3,"b")])                        @?= fromList [(4, "b"), (6, "a")]
865+    mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "c"
866+    mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "c"
867+
868+test_mapKeysWith :: Assertion
869+test_mapKeysWith = do
870+    mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "cdab"
871+    mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "cdab"
872+-}
873+
874+{-
875+test_mapKeysMonotonic :: Assertion
876+test_mapKeysMonotonic = do
877+    mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")]
878+    valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) @?= True
879+    valid (mapKeysMonotonic (\ _ -> 1)     (fromList [(5,"a"), (3,"b")])) @?= False
880+-}
881+
882+test_fold :: Assertion
883+test_fold = fold f 0 (fromList [(5,"a"), (3,"bbb")]) @?= 4
884+  where
885+    f a len = len + (length a)
886+
887+test_foldWithKey :: Assertion
888+test_foldWithKey = foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) @?= "Map: (5:a)(3:b)"
889+  where
890+    f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
891+
892+----------------------------------------------------------------
893+-- Conversion
894+
895+test_elems :: Assertion
896+test_elems = do
897+    elems (fromList [(5,"a"), (3,"b")]) @?= ["b","a"]
898+    elems (empty :: UMap) @?= []
899+
900+test_keys :: Assertion
901+test_keys = do
902+    keys (fromList [(5,"a"), (3,"b")]) @?= [3,5]
903+    keys (empty :: UMap) @?= []
904+
905+test_keysSet :: Assertion
906+test_keysSet = do
907+    keysSet (fromList [(5,"a"), (3,"b")]) @?= Data.IntSet.fromList [3,5]
908+    keysSet (empty :: UMap) @?= Data.IntSet.empty
909+
910+test_assocs :: Assertion
911+test_assocs = do
912+    assocs (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
913+    assocs (empty :: UMap) @?= []
914+
915+----------------------------------------------------------------
916+-- Lists
917+
918+test_toList :: Assertion
919+test_toList = do
920+    toList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
921+    toList (empty :: SMap) @?= []
922+
923+test_fromList :: Assertion
924+test_fromList = do
925+    fromList [] @?= (empty :: SMap)
926+    fromList [(5,"a"), (3,"b"), (5, "c")] @?= fromList [(5,"c"), (3,"b")]
927+    fromList [(5,"c"), (3,"b"), (5, "a")] @?= fromList [(5,"a"), (3,"b")]
928+
929+test_fromListWith :: Assertion
930+test_fromListWith = do
931+    fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "ab"), (5, "aba")]
932+    fromListWith (++) [] @?= (empty :: SMap)
933+
934+test_fromListWithKey :: Assertion
935+test_fromListWithKey = do
936+    fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "3ab"), (5, "5a5ba")]
937+    fromListWithKey f [] @?= (empty :: SMap)
938+  where
939+    f k a1 a2 = (show k) ++ a1 ++ a2
940+
941+----------------------------------------------------------------
942+-- Ordered lists
943+
944+test_toAscList :: Assertion
945+test_toAscList = toAscList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
946+
947+-- test_toDescList :: Assertion
948+-- test_toDescList = toDescList (fromList [(5,"a"), (3,"b")]) @?= [(5,"a"), (3,"b")]
949+
950+test_showTree :: Assertion
951+test_showTree =
952+       (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
953+        in showTree t) @?= "*\n+--*\n|  +-- 1:=()\n|  +--*\n|     +-- 2:=()\n|     +-- 3:=()\n+--*\n   +-- 4:=()\n   +-- 5:=()\n"
954+
955+{-
956+test_showTree' :: Assertion
957+test_showTree' =
958+       (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
959+        in s t ) @?= "+--5:=()\n|\n4:=()\n|\n|  +--3:=()\n|  |\n+--2:=()\n   |\n   +--1:=()\n"
960+   where
961+    showElem k x  = show k ++ ":=" ++ show x
962+
963+    s = showTreeWith showElem False True
964+-}
965+
966+
967+test_fromAscList :: Assertion
968+test_fromAscList = do
969+    fromAscList [(3,"b"), (5,"a")]          @?= fromList [(3, "b"), (5, "a")]
970+    fromAscList [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "b")]
971+--    valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) @?= True
972+--    valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) @?= False
973+
974+
975+test_fromAscListWith :: Assertion
976+test_fromAscListWith = do
977+    fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "ba")]
978+--    valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) @?= True
979+--    valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) @?= False
980+
981+test_fromAscListWithKey :: Assertion
982+test_fromAscListWithKey = do
983+    fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] @?= fromList [(3, "b"), (5, "5:b5:ba")]
984+--    valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) @?= True
985+--    valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) @?= False
986+  where
987+    f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
988+
989+test_fromDistinctAscList :: Assertion
990+test_fromDistinctAscList = do
991+    fromDistinctAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
992+--    valid (fromDistinctAscList [(3,"b"), (5,"a")])          @?= True
993+--    valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) @?= False
994+
995+----------------------------------------------------------------
996+-- Filter
997+
998+test_filter :: Assertion
999+test_filter = do
1000+    filter (> "a") (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1001+    filter (> "x") (fromList [(5,"a"), (3,"b")]) @?= empty
1002+    filter (< "a") (fromList [(5,"a"), (3,"b")]) @?= empty
1003+
1004+test_filteWithKey :: Assertion
1005+test_filteWithKey = filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1006+
1007+test_partition :: Assertion
1008+test_partition = do
1009+    partition (> "a") (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
1010+    partition (< "x") (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
1011+    partition (> "x") (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
1012+
1013+test_partitionWithKey :: Assertion
1014+test_partitionWithKey = do
1015+    partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) @?= (singleton 5 "a", singleton 3 "b")
1016+    partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
1017+    partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
1018+
1019+test_mapMaybe :: Assertion
1020+test_mapMaybe = mapMaybe f (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "new a"
1021+  where
1022+    f x = if x == "a" then Just "new a" else Nothing
1023+
1024+test_mapMaybeWithKey :: Assertion
1025+test_mapMaybeWithKey = mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "key : 3"
1026+  where
1027+    f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
1028+
1029+test_mapEither :: Assertion
1030+test_mapEither = do
1031+    mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1032+        @?= (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
1033+    mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1034+        @?= ((empty :: SMap), fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1035+ where
1036+   f a = if a < "c" then Left a else Right a
1037+
1038+test_mapEitherWithKey :: Assertion
1039+test_mapEitherWithKey = do
1040+    mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1041+     @?= (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
1042+    mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1043+     @?= ((empty :: SMap), fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
1044+  where
1045+    f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
1046+
1047+test_split :: Assertion
1048+test_split = do
1049+    split 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3,"b"), (5,"a")])
1050+    split 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, singleton 5 "a")
1051+    split 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
1052+    split 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", empty)
1053+    split 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], empty)
1054+
1055+test_splitLookup :: Assertion
1056+test_splitLookup = do
1057+    splitLookup 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, Nothing, fromList [(3,"b"), (5,"a")])
1058+    splitLookup 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, Just "b", singleton 5 "a")
1059+    splitLookup 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Nothing, singleton 5 "a")
1060+    splitLookup 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Just "a", empty)
1061+    splitLookup 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], Nothing, empty)
1062+
1063+----------------------------------------------------------------
1064+-- Submap
1065+
1066+test_isSubmapOfBy :: Assertion
1067+test_isSubmapOfBy = do
1068+    isSubmapOfBy (==) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
1069+    isSubmapOfBy (<=) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
1070+    isSubmapOfBy (==) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
1071+    isSubmapOfBy (==) (fromList [(fromEnum 'a',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
1072+    isSubmapOfBy (<)  (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
1073+    isSubmapOfBy (==) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1)]) @?= False
1074+
1075+test_isSubmapOf :: Assertion
1076+test_isSubmapOf = do
1077+    isSubmapOf (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
1078+    isSubmapOf (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
1079+    isSubmapOf (fromList [(fromEnum 'a',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
1080+    isSubmapOf (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1)]) @?= False
1081+
1082+test_isProperSubmapOfBy :: Assertion
1083+test_isProperSubmapOfBy = do
1084+    isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
1085+    isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
1086+    isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
1087+    isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
1088+    isProperSubmapOfBy (<)  (fromList [(1,1)])       (fromList [(1,1),(2,2)]) @?= False
1089+
1090+test_isProperSubmapOf :: Assertion
1091+test_isProperSubmapOf = do
1092+    isProperSubmapOf (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
1093+    isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
1094+    isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
1095+
1096+----------------------------------------------------------------
1097+-- Indexed
1098+
1099+{-
1100+test_lookupIndex :: Assertion
1101+test_lookupIndex = do
1102+    isJust (lookupIndex 2 (fromList [(5,"a"), (3,"b")]))   @?= False
1103+    fromJust (lookupIndex 3 (fromList [(5,"a"), (3,"b")])) @?= 0
1104+    fromJust (lookupIndex 5 (fromList [(5,"a"), (3,"b")])) @?= 1
1105+    isJust (lookupIndex 6 (fromList [(5,"a"), (3,"b")]))   @?= False
1106+-}
1107+
1108+-- test_findIndex :: Assertion
1109+-- test_findIndex = do
1110+--     findIndex 3 (fromList [(5,"a"), (3,"b")]) @?= 0
1111+--     findIndex 5 (fromList [(5,"a"), (3,"b")]) @?= 1
1112+
1113+-- test_elemAt :: Assertion
1114+-- test_elemAt = do
1115+--     elemAt 0 (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
1116+--     elemAt 1 (fromList [(5,"a"), (3,"b")]) @?= (5, "a")
1117+
1118+-- test_updateAt :: Assertion
1119+-- test_updateAt = do
1120+--     updateAt (\ _ _ -> Just "x") 0    (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "x"), (5, "a")]
1121+--     updateAt (\ _ _ -> Just "x") 1    (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "x")]
1122+--     updateAt (\_ _  -> Nothing)  0    (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1123+--     updateAt (\_ _  -> Nothing)  1    (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1124+
1125+-- test_deleteAt :: Assertion
1126+-- test_deleteAt = do
1127+--     deleteAt 0  (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1128+--     deleteAt 1  (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1129+
1130+----------------------------------------------------------------
1131+-- Min/Max
1132+
1133+test_findMin :: Assertion
1134+test_findMin = findMin (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
1135+
1136+test_findMax :: Assertion
1137+test_findMax = findMax (fromList [(5,"a"), (3,"b")]) @?= (5,"a")
1138+
1139+test_deleteMin :: Assertion
1140+test_deleteMin = do
1141+    deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(5,"a"), (7,"c")]
1142+    -- deleteMin (empty :: SMap) @?= empty
1143+
1144+test_deleteMax :: Assertion
1145+test_deleteMax = do
1146+    deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(3,"b"), (5,"a")]
1147+    -- deleteMax (empty :: SMap) @?= empty
1148+
1149+-- test_deleteFindMin :: Assertion
1150+-- test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((3,"b"), fromList[(5,"a"), (10,"c")])
1151+
1152+-- test_deleteFindMax :: Assertion
1153+-- test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((10,"c"), fromList [(3,"b"), (5,"a")])
1154+
1155+-- test_updateMin :: Assertion
1156+----  test_updateMin = do
1157+--     updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")]
1158+--     updateMin (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1159+
1160+-- test_updateMax :: Assertion
1161+-- test_updateMax = do
1162+--     updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")]
1163+--     updateMax (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1164+
1165+-- test_updateMinWithKey :: Assertion
1166+-- test_updateMinWithKey = do
1167+--     updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")]
1168+--     updateMinWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1169+
1170+-- test_updateMaxWithKey :: Assertion
1171+-- test_updateMaxWithKey = do
1172+--     updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")]
1173+--     updateMaxWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1174+
1175+test_minView :: Assertion
1176+test_minView = do
1177+    minView (fromList [(5,"a"), (3,"b")]) @?= Just ("b", singleton 5 "a")
1178+    minView (empty :: SMap) @?= Nothing
1179+
1180+test_maxView :: Assertion
1181+test_maxView = do
1182+    maxView (fromList [(5,"a"), (3,"b")]) @?= Just ("a", singleton 3 "b")
1183+    maxView (empty :: SMap) @?= Nothing
1184+
1185+test_minViewWithKey :: Assertion
1186+test_minViewWithKey = do
1187+    minViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((3,"b"), singleton 5 "a")
1188+    minViewWithKey (empty :: SMap) @?= Nothing
1189+
1190+test_maxViewWithKey :: Assertion
1191+test_maxViewWithKey = do
1192+    maxViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((5,"a"), singleton 3 "b")
1193+    maxViewWithKey (empty :: SMap) @?= Nothing
1194+
1195+----------------------------------------------------------------
1196+-- Debug
1197+
1198+-- test_valid :: Assertion
1199+-- test_valid = do
1200+--     valid (fromAscList [(3,"b"), (5,"a")]) @?= True
1201+--     valid (fromAscList [(5,"a"), (3,"b")]) @?= False
1202+
1203+----------------------------------------------------------------
1204+-- QuickCheck
1205+----------------------------------------------------------------
1206+
1207+-- prop_fromList :: UMap -> Bool
1208+-- prop_fromList t = valid t
1209+
1210+prop_singleton :: Int -> Int -> Bool
1211+prop_singleton k x = insert k x empty == singleton k x
1212+
1213+-- prop_insert :: Int -> UMap -> Bool
1214+-- prop_insert k t = valid $ insert k () t
1215+
1216+prop_lookup :: Int -> UMap -> Bool
1217+prop_lookup k t = lookup k (insert k () t) /= Nothing
1218+
1219+-- prop_insertDelete :: Int -> UMap -> Bool
1220+-- prop_insertDelete k t = valid $ delete k (insert k () t)
1221+
1222+prop_insertDelete2 :: Int -> UMap -> Property
1223+prop_insertDelete2 k t = (lookup k t == Nothing) ==> (delete k (insert k () t) == t)
1224+
1225+prop_deleteNonMember :: Int -> UMap -> Property
1226+prop_deleteNonMember k t = (lookup k t == Nothing) ==> (delete k t == t)
1227+
1228+-- prop_deleteMin :: UMap -> Bool
1229+-- prop_deleteMin t = valid $ deleteMin $ deleteMin t
1230+
1231+-- prop_deleteMax :: UMap -> Bool
1232+-- prop_deleteMax t = valid $ deleteMax $ deleteMax t
1233+
1234+----------------------------------------------------------------
1235+
1236+-- prop_split :: Int -> UMap -> Property
1237+-- prop_split k t = (lookup k t /= Nothing) ==> let (r,l) = split k t
1238+--                                              in (valid r, valid l) == (True, True)
1239+
1240+-- prop_join :: Int -> UMap -> Bool
1241+-- prop_join k t = let (l,r) = split k t
1242+--                 in valid (join k () l r)
1243+
1244+-- prop_merge :: Int -> UMap -> Bool
1245+-- prop_merge k t = let (l,r) = split k t
1246+--                  in valid (merge l r)
1247+
1248+----------------------------------------------------------------
1249+
1250+-- prop_union :: UMap -> UMap -> Bool
1251+-- prop_union t1 t2 = valid (union t1 t2)
1252+
1253+prop_unionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
1254+prop_unionModel xs ys
1255+  = sort (keys (union (fromList xs) (fromList ys)))
1256+    == sort (nub (P.map fst xs ++ P.map fst ys))
1257+
1258+prop_unionSingleton :: IMap -> Int -> Int -> Bool
1259+prop_unionSingleton t k x = union (singleton k x) t == insert k x t
1260+
1261+prop_unionAssoc :: IMap -> IMap -> IMap -> Bool
1262+prop_unionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
1263+
1264+prop_unionWith :: IMap -> IMap -> Bool
1265+prop_unionWith t1 t2 = (union t1 t2 == unionWith (\_ y -> y) t2 t1)
1266+
1267+-- prop_unionWith2 :: IMap -> IMap -> Bool
1268+-- prop_unionWith2 t1 t2 = valid (unionWithKey (\_ x y -> x+y) t1 t2)
1269+
1270+prop_unionSum :: [(Int,Int)] -> [(Int,Int)] -> Bool
1271+prop_unionSum xs ys
1272+  = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
1273+    == (sum (P.map snd xs) + sum (P.map snd ys))
1274+
1275+-- prop_difference :: IMap -> IMap -> Bool
1276+-- prop_difference t1 t2 = valid (difference t1 t2)
1277+
1278+prop_differenceModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
1279+prop_differenceModel xs ys
1280+  = sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
1281+    == sort ((L.\\) (nub (P.map fst xs)) (nub (P.map fst ys)))
1282+
1283+-- prop_intersection :: IMap -> IMap -> Bool
1284+-- prop_intersection t1 t2 = valid (intersection t1 t2)
1285+
1286+prop_intersectionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
1287+prop_intersectionModel xs ys
1288+  = sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
1289+    == sort (nub ((L.intersect) (P.map fst xs) (P.map fst ys)))
1290+
1291+----------------------------------------------------------------
1292+
1293+prop_ordered :: Property
1294+prop_ordered
1295+  = forAll (choose (5,100)) $ \n ->
1296+    let xs = [(x,()) | x <- [0..n::Int]]
1297+    in fromAscList xs == fromList xs
1298+
1299+prop_list :: [Int] -> Bool
1300+prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
1301+
1302+----------------------------------------------------------------
1303+
1304+prop_alter :: UMap -> Int -> Bool
1305+prop_alter t k = {-balanced t' &&-} case lookup k t of
1306+    Just _  -> (size t - 1) == size t' && lookup k t' == Nothing
1307+    Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing
1308+  where
1309+    t' = alter f k t
1310+    f Nothing   = Just ()
1311+    f (Just ()) = Nothing
1312}
1313[Performance improvements for Data.IntMap (worker/wrapper and inlining)
1314Don Stewart <[email protected]>**20100831093316
1315 Ignore-this: 206036448558d270f0eb85ef4cd55368
1316] {
1317hunk ./Data/IntMap.hs 1
1318+{-# LANGUAGE CPP #-}
1319+{-# LANGUAGE MagicHash #-}
1320 {-# OPTIONS_GHC -cpp -XNoBangPatterns -XScopedTypeVariables #-}
1321 -----------------------------------------------------------------------------
1322 -- |
1323hunk ./Data/IntMap.hs 46
1324 
1325 module Data.IntMap  (
1326             -- * Map type
1327+#if !defined(TESTING)
1328               IntMap, Key          -- instance Eq,Show
1329hunk ./Data/IntMap.hs 48
1330+#else
1331+              IntMap(..), Key          -- instance Eq,Show
1332+#endif
1333 
1334             -- * Operators
1335             , (!), (\\)
1336hunk ./Data/IntMap.hs 60
1337             , size
1338             , member
1339             , notMember
1340-           , lookup
1341+            , lookup
1342             , findWithDefault
1343             
1344             -- * Construction
1345hunk ./Data/IntMap.hs 114
1346             -- * Conversion
1347             , elems
1348             , keys
1349-           , keysSet
1350+            , keysSet
1351             , assocs
1352             
1353             -- ** Lists
1354hunk ./Data/IntMap.hs 209
1355 type Nat = Word
1356 
1357 natFromInt :: Key -> Nat
1358-natFromInt i = fromIntegral i
1359+natFromInt = fromIntegral
1360+{-# INLINE natFromInt #-}
1361 
1362 intFromNat :: Nat -> Key
1363hunk ./Data/IntMap.hs 213
1364-intFromNat w = fromIntegral w
1365+intFromNat = fromIntegral
1366+{-# INLINE intFromNat #-}
1367 
1368 shiftRL :: Nat -> Key -> Nat
1369 #if __GLASGOW_HASKELL__
1370hunk ./Data/IntMap.hs 226
1371 #else
1372 shiftRL x i   = shiftR x i
1373 #endif
1374+{-# INLINE shiftRL #-}
1375 
1376 {--------------------------------------------------------------------
1377   Operators
1378hunk ./Data/IntMap.hs 240
1379 
1380 (!) :: IntMap a -> Key -> a
1381 m ! k    = find' k m
1382+{-# INLINE (!) #-}
1383 
1384 -- | Same as 'difference'.
1385 (\\) :: IntMap a -> IntMap b -> IntMap a
1386hunk ./Data/IntMap.hs 245
1387 m1 \\ m2 = difference m1 m2
1388+{-# INLINE (\\) #-}
1389 
1390 {--------------------------------------------------------------------
1391   Types 
1392hunk ./Data/IntMap.hs 303
1393 null :: IntMap a -> Bool
1394 null Nil = True
1395 null _   = False
1396+{-# INLINE null #-}
1397 
1398 -- | /O(n)/. Number of elements in the map.
1399 --
1400hunk ./Data/IntMap.hs 316
1401       Bin _ _ l r -> size l + size r
1402       Tip _ _ -> 1
1403       Nil     -> 0
1404+{-# INLINE size #-}
1405 
1406 -- | /O(min(n,W))/. Is the key a member of the map?
1407 --
1408hunk ./Data/IntMap.hs 328
1409   = case lookup k m of
1410       Nothing -> False
1411       Just _  -> True
1412+{-# INLINE member #-}
1413 
1414 -- | /O(log n)/. Is the key not a member of the map?
1415 --
1416hunk ./Data/IntMap.hs 337
1417 
1418 notMember :: Key -> IntMap a -> Bool
1419 notMember k m = not $ member k m
1420+{-# INLINE notMember #-}
1421 
1422 -- | /O(min(n,W))/. Lookup the value at a key in the map. See also 'Data.Map.lookup'.
1423 lookup :: Key -> IntMap a -> Maybe a
1424hunk ./Data/IntMap.hs 343
1425 lookup k t
1426   = let nk = natFromInt k  in seq nk (lookupN nk t)
1427+{-# INLINE lookup #-}
1428 
1429 lookupN :: Nat -> IntMap a -> Maybe a
1430 lookupN k t
1431hunk ./Data/IntMap.hs 355
1432         | (k == natFromInt kx)  -> Just x
1433         | otherwise             -> Nothing
1434       Nil -> Nothing
1435+-- ^ inlining lookup doesn't seem to help.
1436 
1437 find' :: Key -> IntMap a -> a
1438 find' k m
1439hunk ./Data/IntMap.hs 362
1440   = case lookup k m of
1441       Nothing -> error ("IntMap.find: key " ++ show k ++ " is not an element of the map")
1442       Just x  -> x
1443-
1444+{-# INLINE find' #-}
1445 
1446 -- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@
1447 -- returns the value at key @k@ or returns @def@ when the key is not an
1448hunk ./Data/IntMap.hs 376
1449   = case lookup k m of
1450       Nothing -> def
1451       Just x  -> x
1452+{-# INLINE findWithDefault #-}
1453 
1454 {--------------------------------------------------------------------
1455   Construction
1456hunk ./Data/IntMap.hs 389
1457 empty :: IntMap a
1458 empty
1459   = Nil
1460+{-# INLINE empty #-}
1461 
1462 -- | /O(1)/. A map of one element.
1463 --
1464hunk ./Data/IntMap.hs 399
1465 singleton :: Key -> a -> IntMap a
1466 singleton k x
1467   = Tip k x
1468+{-# INLINE singleton #-}
1469 
1470 {--------------------------------------------------------------------
1471   Insert
1472hunk ./Data/IntMap.hs 439
1473 insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
1474 insertWith f k x t
1475   = insertWithKey (\_ x' y' -> f x' y') k x t
1476+{-# INLINE insertWith #-}
1477 
1478 -- | /O(min(n,W))/. Insert with a combining function.
1479 -- @'insertWithKey' f key value mp@
1480hunk ./Data/IntMap.hs 453
1481 -- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx"
1482 
1483 insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
1484-insertWithKey f k x t
1485-  = case t of
1486-      Bin p m l r
1487-        | nomatch k p m -> join k (Tip k x) p t
1488-        | zero k m      -> Bin p m (insertWithKey f k x l) r
1489-        | otherwise     -> Bin p m l (insertWithKey f k x r)
1490-      Tip ky y
1491-        | k==ky         -> Tip k (f k x y)
1492-        | otherwise     -> join k (Tip k x) ky t
1493-      Nil -> Tip k x
1494+insertWithKey f k x = k `seq` go
1495+  where
1496+    go t@(Bin p m l r)
1497+        | nomatch k p m = join k (Tip k x) p t
1498+        | zero k m      = Bin p m (go l) r
1499+        | otherwise     = Bin p m l (go r)
1500+
1501+    go t@(Tip ky y)
1502+        | k==ky         = Tip k (f k x y)
1503+        | otherwise     = join k (Tip k x) ky t
1504+
1505+    go Nil = Tip k x
1506+{-# INLINE insertWithKey #-}
1507 
1508 
1509 -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
1510hunk ./Data/IntMap.hs 484
1511 -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])
1512 
1513 insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
1514-insertLookupWithKey f k x t
1515-  = case t of
1516-      Bin p m l r
1517-        | nomatch k p m -> (Nothing,join k (Tip k x) p t)
1518-        | zero k m      -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
1519-        | otherwise     -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
1520-      Tip ky y
1521-        | k==ky         -> (Just y,Tip k (f k x y))
1522-        | otherwise     -> (Nothing,join k (Tip k x) ky t)
1523-      Nil -> (Nothing,Tip k x)
1524+insertLookupWithKey f k x = k `seq` go
1525+  where
1526+      go t@(Bin p m l r)
1527+        | nomatch k p m = (Nothing,join k (Tip k x) p t)
1528+        | zero k m      = case go l of (found, l') -> (found,Bin p m l' r)
1529+        | otherwise     = case go r of (found, r') -> (found,Bin p m l r')
1530+
1531+      go t@(Tip ky y)
1532+        | k==ky         = (Just y,Tip k (f k x y))
1533+        | otherwise     = (Nothing,join k (Tip k x) ky t)
1534+
1535+      go Nil = (Nothing,Tip k x)
1536+{-# INLINE insertLookupWithKey #-}
1537 
1538 
1539 {--------------------------------------------------------------------
1540hunk ./Data/IntMap.hs 511
1541 -- > delete 5 empty                         == empty
1542 
1543 delete :: Key -> IntMap a -> IntMap a
1544-delete k t
1545-  = case t of
1546-      Bin p m l r
1547-        | nomatch k p m -> t
1548-        | zero k m      -> bin p m (delete k l) r
1549-        | otherwise     -> bin p m l (delete k r)
1550-      Tip ky _
1551-        | k==ky         -> Nil
1552-        | otherwise     -> t
1553-      Nil -> Nil
1554+delete k = go
1555+  where
1556+      go t@(Bin p m l r)
1557+        | nomatch k p m = t
1558+        | zero k m      = bin p m (go l) r
1559+        | otherwise     = bin p m l (go r)
1560+
1561+      go t@(Tip ky _)
1562+        | k==ky         = Nil
1563+        | otherwise     = t
1564+
1565+      go Nil = Nil
1566+{-# INLINE delete #-}
1567 
1568 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
1569 -- a member of the map, the original map is returned.
1570hunk ./Data/IntMap.hs 535
1571 adjust ::  (a -> a) -> Key -> IntMap a -> IntMap a
1572 adjust f k m
1573   = adjustWithKey (\_ x -> f x) k m
1574+{-# INLINE adjust #-}
1575 
1576 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
1577 -- a member of the map, the original map is returned.
1578hunk ./Data/IntMap.hs 546
1579 -- > adjustWithKey f 7 empty                         == empty
1580 
1581 adjustWithKey ::  (Key -> a -> a) -> Key -> IntMap a -> IntMap a
1582-adjustWithKey f k m
1583-  = updateWithKey (\k' x -> Just (f k' x)) k m
1584+adjustWithKey f
1585+  = updateWithKey (\k' x -> Just (f k' x))
1586+{-# INLINE adjustWithKey #-}
1587 
1588 -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
1589 -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
1590hunk ./Data/IntMap.hs 560
1591 -- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
1592 
1593 update ::  (a -> Maybe a) -> Key -> IntMap a -> IntMap a
1594-update f k m
1595-  = updateWithKey (\_ x -> f x) k m
1596+update f
1597+  = updateWithKey (\_ x -> f x)
1598+{-# INLINE update #-}
1599 
1600 -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
1601 -- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is
1602hunk ./Data/IntMap.hs 574
1603 -- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
1604 
1605 updateWithKey ::  (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
1606-updateWithKey f k t
1607-  = case t of
1608-      Bin p m l r
1609-        | nomatch k p m -> t
1610-        | zero k m      -> bin p m (updateWithKey f k l) r
1611-        | otherwise     -> bin p m l (updateWithKey f k r)
1612-      Tip ky y
1613-        | k==ky         -> case (f k y) of
1614+updateWithKey f k = go
1615+  where
1616+      go t@(Bin p m l r)
1617+        | nomatch k p m = t
1618+        | zero k m      = bin p m (go l) r
1619+        | otherwise     = bin p m l (go r)
1620+
1621+      go t@(Tip ky y)
1622+        | k==ky         = case f k y of
1623                              Just y' -> Tip ky y'
1624                              Nothing -> Nil
1625hunk ./Data/IntMap.hs 585
1626-        | otherwise     -> t
1627-      Nil -> Nil
1628+        | otherwise     = t
1629+
1630+      go Nil = Nil
1631+{-# INLINE updateWithKey #-}
1632 
1633 -- | /O(min(n,W))/. Lookup and update.
1634 -- The function returns original value, if it is updated.
1635hunk ./Data/IntMap.hs 601
1636 -- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
1637 
1638 updateLookupWithKey ::  (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
1639-updateLookupWithKey f k t
1640-  = case t of
1641-      Bin p m l r
1642-        | nomatch k p m -> (Nothing,t)
1643-        | zero k m      -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
1644-        | otherwise     -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
1645-      Tip ky y
1646-        | k==ky         -> case (f k y) of
1647+updateLookupWithKey f k = go
1648+  where
1649+      go t@(Bin p m l r)
1650+        | nomatch k p m = (Nothing,t)
1651+        | zero k m      = case updateLookupWithKey f k l of (found, l') -> (found,bin p m l' r)
1652+        | otherwise     = case updateLookupWithKey f k r of (found, r') -> (found,bin p m l r')
1653+
1654+      go t@(Tip ky y)
1655+        | k==ky         = case f k y of
1656                              Just y' -> (Just y,Tip ky y')
1657                              Nothing -> (Just y,Nil)
1658hunk ./Data/IntMap.hs 612
1659-        | otherwise     -> (Nothing,t)
1660-      Nil -> (Nothing,Nil)
1661-
1662+        | otherwise     = (Nothing,t)
1663 
1664hunk ./Data/IntMap.hs 614
1665+      go Nil = (Nothing,Nil)
1666+{-# INLINE updateLookupWithKey #-}
1667 
1668 -- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
1669 -- 'alter' can be used to insert, delete, or update a value in an 'IntMap'.
1670hunk ./Data/IntMap.hs 621
1671 -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
1672 alter :: (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
1673-alter f k t
1674-  = case t of
1675-      Bin p m l r
1676-        | nomatch k p m -> case f Nothing of
1677+alter f k = k `seq` go
1678+  where
1679+    go t@(Bin p m l r)
1680+        | nomatch k p m = case f Nothing of
1681                              Nothing -> t
1682hunk ./Data/IntMap.hs 626
1683-                             Just x -> join k (Tip k x) p t
1684-        | zero k m      -> bin p m (alter f k l) r
1685-        | otherwise     -> bin p m l (alter f k r)
1686-      Tip ky y         
1687-        | k==ky         -> case f (Just y) of
1688+                             Just x  -> join k (Tip k x) p t
1689+        | zero k m      = bin p m (go l) r
1690+        | otherwise     = bin p m l (go r)
1691+
1692+    go t@(Tip ky y)         
1693+        | k==ky         = case f (Just y) of
1694                              Just x -> Tip ky x
1695                              Nothing -> Nil
1696hunk ./Data/IntMap.hs 634
1697-        | otherwise     -> case f Nothing of
1698+
1699+        | otherwise     = case f Nothing of
1700                              Just x -> join k (Tip k x) ky t
1701                              Nothing -> Tip ky y
1702hunk ./Data/IntMap.hs 638
1703-      Nil               -> case f Nothing of
1704+
1705+    go Nil              = case f Nothing of
1706                              Just x -> Tip k x
1707                              Nothing -> Nil
1708 
1709hunk ./Data/IntMap.hs 643
1710+{-# INLINE alter #-}
1711 
1712 {--------------------------------------------------------------------
1713   Union
1714hunk ./Data/IntMap.hs 658
1715 unions :: [IntMap a] -> IntMap a
1716 unions xs
1717   = foldlStrict union empty xs
1718+{-# INLINE unions #-}
1719 
1720 -- | The union of a list of maps, with a combining operation.
1721 --
1722hunk ./Data/IntMap.hs 668
1723 unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
1724 unionsWith f ts
1725   = foldlStrict (unionWith f) empty ts
1726+{-# INLINE unionsWith #-}
1727 
1728 -- | /O(n+m)/. The (left-biased) union of two maps.
1729 -- It prefers the first map when duplicate keys are encountered,
1730hunk ./Data/IntMap.hs 703
1731 unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
1732 unionWith f m1 m2
1733   = unionWithKey (\_ x y -> f x y) m1 m2
1734+{-# INLINE unionWith #-}
1735 
1736 -- | /O(n+m)/. The union with a combining function.
1737 --
1738hunk ./Data/IntMap.hs 769
1739 differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
1740 differenceWith f m1 m2
1741   = differenceWithKey (\_ x y -> f x y) m1 m2
1742+{-# INLINE differenceWith #-}
1743 
1744 -- | /O(n+m)/. Difference with a combining function. When two equal keys are
1745 -- encountered, the combining function is applied to the key and both values.
1746hunk ./Data/IntMap.hs 846
1747 intersectionWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
1748 intersectionWith f m1 m2
1749   = intersectionWithKey (\_ x y -> f x y) m1 m2
1750+{-# INLINE intersectionWith #-}
1751 
1752 -- | /O(n+m)/. The intersection with a combining function.
1753 --
1754hunk ./Data/IntMap.hs 890
1755 -- > updateMinWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
1756 
1757 updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
1758-updateMinWithKey f t
1759-    = case t of
1760-        Bin p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
1761-        Bin p m l r         -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
1762-        Tip k y -> Tip k (f k y)
1763-        Nil -> error "maxView: empty map has no maximal element"
1764+updateMinWithKey f = go
1765+  where
1766+     go (Bin p m l r) | m < 0 = let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
1767+     go (Bin p m l r)         = let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
1768+     go (Tip k y) = Tip k (f k y)
1769+     go Nil       = error "maxView: empty map has no maximal element"
1770+{-# INLINE updateMinWithKey #-}
1771 
1772 updateMinWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
1773hunk ./Data/IntMap.hs 899
1774-updateMinWithKeyUnsigned f t
1775-    = case t of
1776-        Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
1777-        Tip k y -> Tip k (f k y)
1778-        Nil -> error "updateMinWithKeyUnsigned Nil"
1779+updateMinWithKeyUnsigned f = go
1780+  where
1781+     go (Bin p m l r) = let t' = go l in Bin p m t' r
1782+     go (Tip k y)     = Tip k (f k y)
1783+     go Nil           = error "updateMinWithKeyUnsigned Nil"
1784+{-# INLINE updateMinWithKeyUnsigned #-}
1785 
1786 -- | /O(log n)/. Update the value at the maximal key.
1787 --
1788hunk ./Data/IntMap.hs 912
1789 -- > updateMaxWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
1790 
1791 updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
1792-updateMaxWithKey f t
1793-    = case t of
1794-        Bin p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' r
1795-        Bin p m l r         -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
1796-        Tip k y -> Tip k (f k y)
1797-        Nil -> error "maxView: empty map has no maximal element"
1798+updateMaxWithKey f = go
1799+  where
1800+    go (Bin p m l r) | m < 0 = let t' = updateMaxWithKeyUnsigned f l in Bin p m t' r
1801+    go (Bin p m l r)         = let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
1802+    go (Tip k y)        = Tip k (f k y)
1803+    go Nil              = error "maxView: empty map has no maximal element"
1804+{-# INLINE updateMaxWithKey #-}
1805 
1806 updateMaxWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
1807hunk ./Data/IntMap.hs 921
1808-updateMaxWithKeyUnsigned f t
1809-    = case t of
1810-        Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
1811-        Tip k y -> Tip k (f k y)
1812-        Nil -> error "updateMaxWithKeyUnsigned Nil"
1813+updateMaxWithKeyUnsigned f = go
1814+  where
1815+    go (Bin p m l r) = let t' = go r in Bin p m l t'
1816+    go (Tip k y)     = Tip k (f k y)
1817+    go Nil           = error "updateMaxWithKeyUnsigned Nil"
1818+{-# INLINE updateMaxWithKeyUnsigned #-}
1819 
1820 
1821 -- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
1822hunk ./Data/IntMap.hs 979
1823 
1824 updateMax :: (a -> a) -> IntMap a -> IntMap a
1825 updateMax f = updateMaxWithKey (const f)
1826+{-# INLINE updateMax #-}
1827 
1828 -- | /O(log n)/. Update the value at the minimal key.
1829 --
1830hunk ./Data/IntMap.hs 988
1831 
1832 updateMin :: (a -> a) -> IntMap a -> IntMap a
1833 updateMin f = updateMinWithKey (const f)
1834+{-# INLINE updateMin #-}
1835 
1836 -- Similar to the Arrow instance.
1837 first :: (a -> c) -> (a, b) -> (c, b)
1838hunk ./Data/IntMap.hs 993
1839 first f (x,y) = (f x,y)
1840+{-# INLINE first #-}
1841 
1842 -- | /O(log n)/. Retrieves the maximal key of the map, and the map
1843 -- stripped of that element, or 'Nothing' if passed an empty map.
1844hunk ./Data/IntMap.hs 1035
1845           find (Bin _ _ _ r') = find r'
1846           find Nil            = error "findMax Nil"
1847 
1848--- | /O(log n)/. Delete the minimal key.
1849+-- | /O(log n)/. Delete the minimal key. An error is thrown if the IntMap is already empty.
1850+-- Note, this is not the same behavior Map.
1851 deleteMin :: IntMap a -> IntMap a
1852 deleteMin = maybe (error "deleteMin: empty map has no minimal element") snd . minView
1853 
1854hunk ./Data/IntMap.hs 1040
1855--- | /O(log n)/. Delete the maximal key.
1856+-- | /O(log n)/. Delete the maximal key. An error is thrown if the IntMap is already empty.
1857+-- Note, this is not the same behavior Map.
1858 deleteMax :: IntMap a -> IntMap a
1859 deleteMax = maybe (error "deleteMax: empty map has no maximal element") snd . maxView
1860 
1861hunk ./Data/IntMap.hs 1054
1862 isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
1863 isProperSubmapOf m1 m2
1864   = isProperSubmapOfBy (==) m1 m2
1865+{-# INLINE isProperSubmapOf #-}
1866 
1867 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
1868  The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
1869hunk ./Data/IntMap.hs 1077
1870   = case submapCmp predicate t1 t2 of
1871       LT -> True
1872       _  -> False
1873+{-# INLINE isProperSubmapOfBy #-}
1874 
1875 submapCmp :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
1876 submapCmp predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1877hunk ./Data/IntMap.hs 1105
1878      _                      -> GT -- disjoint
1879 submapCmp _    Nil Nil = EQ
1880 submapCmp _    Nil _   = LT
1881+{-# INLINE submapCmp #-}
1882 
1883 -- | /O(n+m)/. Is this a submap?
1884 -- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
1885hunk ./Data/IntMap.hs 1112
1886 isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
1887 isSubmapOf m1 m2
1888   = isSubmapOfBy (==) m1 m2
1889+{-# INLINE isSubmapOf #-}
1890 
1891 {- | /O(n+m)/.
1892  The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if
1893hunk ./Data/IntMap.hs 1150
1894 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
1895 
1896 map :: (a -> b) -> IntMap a -> IntMap b
1897-map f m
1898-  = mapWithKey (\_ x -> f x) m
1899+map f = mapWithKey (\_ x -> f x)
1900+{-# INLINE map #-}
1901 
1902 -- | /O(n)/. Map a function over all values in the map.
1903 --
1904hunk ./Data/IntMap.hs 1159
1905 -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
1906 
1907 mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
1908-mapWithKey f t 
1909-  = case t of
1910-      Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
1911-      Tip k x     -> Tip k (f k x)
1912-      Nil         -> Nil
1913+mapWithKey f = go
1914+  where
1915+   go (Bin p m l r) = Bin p m (go l) (go r)
1916+   go (Tip k x)     = Tip k (f k x)
1917+   go Nil           = Nil
1918+{-# INLINE mapWithKey #-}
1919 
1920 -- | /O(n)/. The function @'mapAccum'@ threads an accumulating
1921 -- argument through the map in ascending order of keys.
1922hunk ./Data/IntMap.hs 1173
1923 -- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
1924 
1925 mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1926-mapAccum f a m
1927-  = mapAccumWithKey (\a' _ x -> f a' x) a m
1928+mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)
1929+{-# INLINE mapAccum #-}
1930 
1931 -- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
1932 -- argument through the map in ascending order of keys.
1933hunk ./Data/IntMap.hs 1185
1934 mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1935 mapAccumWithKey f a t
1936   = mapAccumL f a t
1937+{-# INLINE mapAccumWithKey #-}
1938 
1939 -- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
1940 -- argument through the map in ascending order of keys.
1941hunk ./Data/IntMap.hs 1221
1942 filter :: (a -> Bool) -> IntMap a -> IntMap a
1943 filter p m
1944   = filterWithKey (\_ x -> p x) m
1945+{-# INLINE filter #-}
1946 
1947 -- | /O(n)/. Filter all keys\/values that satisfy some predicate.
1948 --
1949hunk ./Data/IntMap.hs 1228
1950 -- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
1951 
1952 filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
1953-filterWithKey predicate t
1954-  = case t of
1955-      Bin p m l r
1956-        -> bin p m (filterWithKey predicate l) (filterWithKey predicate r)
1957-      Tip k x
1958-        | predicate k x -> t
1959-        | otherwise     -> Nil
1960-      Nil -> Nil
1961+filterWithKey p = go
1962+  where
1963+    go (Bin p m l r) = bin p m (go l) (go r)
1964+    go t@(Tip k x)
1965+        | p k x      = t
1966+        | otherwise  = Nil
1967+    go Nil = Nil
1968+{-# INLINE filterWithKey #-}
1969 
1970 -- | /O(n)/. Partition the map according to some predicate. The first
1971 -- map contains all elements that satisfy the predicate, the second all
1972hunk ./Data/IntMap.hs 1248
1973 partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
1974 partition p m
1975   = partitionWithKey (\_ x -> p x) m
1976+{-# INLINE partition #-}
1977 
1978 -- | /O(n)/. Partition the map according to some predicate. The first
1979 -- map contains all elements that satisfy the predicate, the second all
1980hunk ./Data/IntMap.hs 1276
1981 -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
1982 
1983 mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
1984-mapMaybe f m
1985-  = mapMaybeWithKey (\_ x -> f x) m
1986+mapMaybe f = mapMaybeWithKey (\_ x -> f x)
1987+{-# INLINE mapMaybe #-}
1988 
1989 -- | /O(n)/. Map keys\/values and collect the 'Just' results.
1990 --
1991hunk ./Data/IntMap.hs 1285
1992 -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
1993 
1994 mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
1995-mapMaybeWithKey f (Bin p m l r)
1996-  = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
1997-mapMaybeWithKey f (Tip k x) = case f k x of
1998-  Just y  -> Tip k y
1999-  Nothing -> Nil
2000-mapMaybeWithKey _ Nil = Nil
2001+mapMaybeWithKey f = go
2002+  where
2003+    go (Bin p m l r) = bin p m (go l) (go r)
2004+    go (Tip k x)     = case f k x of
2005+                          Just y  -> Tip k y
2006+                          Nothing -> Nil
2007+    go Nil = Nil
2008+{-# INLINE mapMaybeWithKey #-}
2009 
2010 -- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
2011 --
2012hunk ./Data/IntMap.hs 1306
2013 mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
2014 mapEither f m
2015   = mapEitherWithKey (\_ x -> f x) m
2016+{-# INLINE mapEither #-}
2017 
2018 -- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
2019 --
2020hunk ./Data/IntMap.hs 1414
2021 -- > fold f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
2022 
2023 fold :: (a -> b -> b) -> b -> IntMap a -> b
2024-fold f z t
2025-  = foldWithKey (\_ x y -> f x y) z t
2026+fold f = foldWithKey (\_ x y -> f x y)
2027+{-# INLINE fold #-}
2028 
2029 -- | /O(n)/. Fold the keys and values in the map, such that
2030 -- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
2031hunk ./Data/IntMap.hs 1427
2032 -- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
2033 
2034 foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
2035-foldWithKey f z t
2036-  = foldr f z t
2037+foldWithKey
2038+  = foldr
2039+{-# INLINE foldWithKey #-}
2040 
2041 foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b
2042 foldr f z t
2043hunk ./Data/IntMap.hs 1438
2044       Bin _ _ _ _ -> foldr' f z t
2045       Tip k x     -> f k x z
2046       Nil         -> z
2047+{-# INLINE foldr #-}
2048 
2049 foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
2050hunk ./Data/IntMap.hs 1441
2051-foldr' f z t
2052-  = case t of
2053-      Bin _ _ l r -> foldr' f (foldr' f z r) l
2054-      Tip k x     -> f k x z
2055-      Nil         -> z
2056-
2057-
2058+foldr' f = go
2059+  where
2060+    go z (Bin _ _ l r) = go (go z r) l
2061+    go z (Tip k x)     = f k x z
2062+    go z Nil           = z
2063+{-# INLINE foldr' #-}
2064 
2065 {--------------------------------------------------------------------
2066   List variations
2067hunk ./Data/IntMap.hs 1458
2068 -- > elems empty == []
2069 
2070 elems :: IntMap a -> [a]
2071-elems m
2072-  = foldWithKey (\_ x xs -> x:xs) [] m
2073+elems
2074+  = foldWithKey (\_ x xs -> x:xs) []
2075+{-# INLINE elems #-}
2076 
2077 -- | /O(n)/. Return all keys of the map in ascending order.
2078 --
2079hunk ./Data/IntMap.hs 1468
2080 -- > keys empty == []
2081 
2082 keys  :: IntMap a -> [Key]
2083-keys m
2084-  = foldWithKey (\k _ ks -> k:ks) [] m
2085+keys
2086+  = foldWithKey (\k _ ks -> k:ks) []
2087+{-# INLINE keys #-}
2088 
2089 -- | /O(n*min(n,W))/. The set of all keys of the map.
2090 --
2091hunk ./Data/IntMap.hs 1489
2092 assocs :: IntMap a -> [(Key,a)]
2093 assocs m
2094   = toList m
2095+{-# INLINE assocs #-}
2096 
2097 
2098 {--------------------------------------------------------------------
2099hunk ./Data/IntMap.hs 1501
2100 -- > toList empty == []
2101 
2102 toList :: IntMap a -> [(Key,a)]
2103-toList t
2104-  = foldWithKey (\k x xs -> (k,x):xs) [] t
2105+toList
2106+  = foldWithKey (\k x xs -> (k,x):xs) []
2107+{-# INLINE toList #-}
2108 
2109 -- | /O(n)/. Convert the map to a list of key\/value pairs where the
2110 -- keys are in ascending order.
2111hunk ./Data/IntMap.hs 1526
2112   = foldlStrict ins empty xs
2113   where
2114     ins t (k,x)  = insert k x t
2115+{-# INLINE fromList #-}
2116 
2117 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
2118 --
2119hunk ./Data/IntMap.hs 1536
2120 fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
2121 fromListWith f xs
2122   = fromListWithKey (\_ x y -> f x y) xs
2123+{-# INLINE fromListWith #-}
2124 
2125 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
2126 --
2127hunk ./Data/IntMap.hs 1548
2128   = foldlStrict ins empty xs
2129   where
2130     ins t (k,x) = insertWithKey f k x t
2131+{-# INLINE fromListWithKey #-}
2132 
2133 -- | /O(n)/. Build a map from a list of key\/value pairs where
2134 -- the keys are in ascending order.
2135hunk ./Data/IntMap.hs 1559
2136 fromAscList :: [(Key,a)] -> IntMap a
2137 fromAscList xs
2138   = fromAscListWithKey (\_ x _ -> x) xs
2139+{-# INLINE fromAscList #-}
2140 
2141 -- | /O(n)/. Build a map from a list of key\/value pairs where
2142 -- the keys are in ascending order, with a combining function on equal keys.
2143hunk ./Data/IntMap.hs 1570
2144 fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
2145 fromAscListWith f xs
2146   = fromAscListWithKey (\_ x y -> f x y) xs
2147+{-# INLINE fromAscListWith #-}
2148 
2149 -- | /O(n)/. Build a map from a list of key\/value pairs where
2150 -- the keys are in ascending order, with a combining function on equal keys.
2151hunk ./Data/IntMap.hs 1785
2152   where
2153     m = branchMask p1 p2
2154     p = mask p1 m
2155+{-# INLINE join #-}
2156 
2157 {--------------------------------------------------------------------
2158   @bin@ assures that we never have empty trees within a tree.
2159hunk ./Data/IntMap.hs 1794
2160 bin _ _ l Nil = l
2161 bin _ _ Nil r = r
2162 bin p m l r   = Bin p m l r
2163+{-# INLINE bin #-}
2164 
2165   
2166 {--------------------------------------------------------------------
2167hunk ./Data/IntMap.hs 1803
2168 zero :: Key -> Mask -> Bool
2169 zero i m
2170   = (natFromInt i) .&. (natFromInt m) == 0
2171+{-# INLINE zero #-}
2172 
2173 nomatch,match :: Key -> Prefix -> Mask -> Bool
2174 nomatch i p m
2175hunk ./Data/IntMap.hs 1808
2176   = (mask i m) /= p
2177+{-# INLINE nomatch #-}
2178 
2179 match i p m
2180   = (mask i m) == p
2181hunk ./Data/IntMap.hs 1812
2182+{-# INLINE match #-}
2183 
2184 mask :: Key -> Mask -> Prefix
2185 mask i m
2186hunk ./Data/IntMap.hs 1817
2187   = maskW (natFromInt i) (natFromInt m)
2188+{-# INLINE mask #-}
2189 
2190 
2191 zeroN :: Nat -> Nat -> Bool
2192hunk ./Data/IntMap.hs 1822
2193 zeroN i m = (i .&. m) == 0
2194+{-# INLINE zeroN #-}
2195 
2196 {--------------------------------------------------------------------
2197   Big endian operations 
2198hunk ./Data/IntMap.hs 1830
2199 maskW :: Nat -> Nat -> Prefix
2200 maskW i m
2201   = intFromNat (i .&. (complement (m-1) `xor` m))
2202+{-# INLINE maskW #-}
2203 
2204 shorter :: Mask -> Mask -> Bool
2205 shorter m1 m2
2206hunk ./Data/IntMap.hs 1835
2207   = (natFromInt m1) > (natFromInt m2)
2208+{-# INLINE shorter #-}
2209 
2210 branchMask :: Prefix -> Prefix -> Mask
2211 branchMask p1 p2
2212hunk ./Data/IntMap.hs 1840
2213   = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
2214+{-# INLINE branchMask #-}
2215   
2216 {----------------------------------------------------------------------
2217   Finding the highest bit (mask) in a word [x] can be done efficiently in
2218hunk ./Data/IntMap.hs 1893
2219         x4 -> case (x4 .|. shiftRL x4 16) of
2220          x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms
2221           x6 -> (x6 `xor` (shiftRL x6 1))
2222+{-# INLINE highestBitMask #-}
2223 
2224 
2225 {--------------------------------------------------------------------
2226hunk ./Data/IntMap.hs 1899
2227   Utilities
2228 --------------------------------------------------------------------}
2229-foldlStrict :: (a -> b -> a) -> a -> [b] -> a
2230-foldlStrict f z xs
2231-  = case xs of
2232-      []     -> z
2233-      (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
2234 
2235hunk ./Data/IntMap.hs 1900
2236-{-
2237-{--------------------------------------------------------------------
2238-  Testing
2239---------------------------------------------------------------------}
2240-testTree :: [Int] -> IntMap Int
2241-testTree xs   = fromList [(x,x*x*30696 `mod` 65521) | x <- xs]
2242-test1 = testTree [1..20]
2243-test2 = testTree [30,29..10]
2244-test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
2245-
2246-{--------------------------------------------------------------------
2247-  QuickCheck
2248---------------------------------------------------------------------}
2249-qcheck prop
2250-  = check config prop
2251+foldlStrict :: (a -> b -> a) -> a -> [b] -> a
2252+foldlStrict f = go
2253   where
2254hunk ./Data/IntMap.hs 1903
2255-    config = Config
2256-      { configMaxTest = 500
2257-      , configMaxFail = 5000
2258-      , configSize    = \n -> (div n 2 + 3)
2259-      , configEvery   = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
2260-      }
2261-
2262-
2263-{--------------------------------------------------------------------
2264-  Arbitrary, reasonably balanced trees
2265---------------------------------------------------------------------}
2266-instance Arbitrary a => Arbitrary (IntMap a) where
2267-  arbitrary = do{ ks <- arbitrary
2268-                ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks
2269-                ; return (fromList xs)
2270-                }
2271-
2272-
2273-{--------------------------------------------------------------------
2274-  Single, Insert, Delete
2275---------------------------------------------------------------------}
2276-prop_Single :: Key -> Int -> Bool
2277-prop_Single k x
2278-  = (insert k x empty == singleton k x)
2279-
2280-prop_InsertDelete :: Key -> Int -> IntMap Int -> Property
2281-prop_InsertDelete k x t
2282-  = not (member k t) ==> delete k (insert k x t) == t
2283-
2284-prop_UpdateDelete :: Key -> IntMap Int -> Bool 
2285-prop_UpdateDelete k t
2286-  = update (const Nothing) k t == delete k t
2287-
2288-
2289-{--------------------------------------------------------------------
2290-  Union
2291---------------------------------------------------------------------}
2292-prop_UnionInsert :: Key -> Int -> IntMap Int -> Bool
2293-prop_UnionInsert k x t
2294-  = union (singleton k x) t == insert k x t
2295-
2296-prop_UnionAssoc :: IntMap Int -> IntMap Int -> IntMap Int -> Bool
2297-prop_UnionAssoc t1 t2 t3
2298-  = union t1 (union t2 t3) == union (union t1 t2) t3
2299-
2300-prop_UnionComm :: IntMap Int -> IntMap Int -> Bool
2301-prop_UnionComm t1 t2
2302-  = (union t1 t2 == unionWith (\x y -> y) t2 t1)
2303-
2304-
2305-prop_Diff :: [(Key,Int)] -> [(Key,Int)] -> Bool
2306-prop_Diff xs ys
2307-  =  List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
2308-    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
2309-
2310-prop_Int :: [(Key,Int)] -> [(Key,Int)] -> Bool
2311-prop_Int xs ys
2312-  =  List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
2313-    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
2314-
2315-{--------------------------------------------------------------------
2316-  Lists
2317---------------------------------------------------------------------}
2318-prop_Ordered
2319-  = forAll (choose (5,100)) $ \n ->
2320-    let xs = concat [[(x-n,()),(x-n,())] | x <- [0..2*n::Int]]
2321-    in fromAscList xs == fromList xs
2322-
2323-prop_List :: [Key] -> Bool
2324-prop_List xs
2325-  = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
2326-
2327-
2328-{--------------------------------------------------------------------
2329-  updateMin / updateMax
2330---------------------------------------------------------------------}
2331-prop_UpdateMinMax :: [Key] -> Bool
2332-prop_UpdateMinMax xs =
2333-  let m = fromList [(x,0)|x<-xs]
2334-      minKey = fst . head . Prelude.filter ((==1).snd) . assocs . updateMin succ $ m
2335-      maxKey = fst . head . Prelude.filter ((==1).snd) . assocs . updateMax succ $ m
2336-  in  all (>=minKey) xs && all (<=maxKey) xs
2337-
2338--}
2339+    go z []     = z
2340+    go z (x:xs) = z `seq` go (f z x) xs
2341+{-# INLINE foldlStrict #-}
2342}
2343[Missing MagicHash for IntSet
2344Don Stewart <[email protected]>**20100831093446
2345 Ignore-this: d075f760adb9a2aa0ee04676e38a07cc
2346] hunk ./Data/IntSet.hs 1
2347-{-# OPTIONS -cpp #-}
2348+{-# LANGUAGE CPP #-}
2349+{-# LANGUAGE MagicHash #-}
2350 -----------------------------------------------------------------------------
2351 -- |
2352 -- Module      :  Data.IntSet
2353
2354Context:
2355
2356[Set Data.Map's delta to 4; fixes #4242
2357Ian Lynagh <[email protected]>**20100815131954]
2358[Add a test for #4242
2359Ian Lynagh <[email protected]>**20100815131856]
2360[Add a local type signature
2361[email protected]**20100730124447
2362 Ignore-this: b581d3f2c80a7a860456d589960f12f2
2363]
2364[Add type signature in local where clause
2365[email protected]**20100727151709
2366 Ignore-this: 5929c4156500b25b280eb414b508c508
2367]
2368[Fix Data.Sequence's breakr, and add a test for it; fixes trac #4157
2369Ian Lynagh <[email protected]>**20100704140627]
2370[Fix proposal #4109: Make Data.Map.insertWith's strictness consistent
2371Ian Lynagh <[email protected]>**20100615133055]
2372[Tweak layout to work with the alternative layout rule
2373Ian Lynagh <[email protected]>**20091129154519]
2374[Disable building Data.Sequence (and dependents) for nhc98.
2375[email protected]**20091124025653
2376 There is some subtlety of polymorphically recursive datatypes and
2377 type-class defaulting that nhc98's type system barfs over.
2378]
2379[Fix another instance of non-ghc breakage.
2380[email protected]**20091123092637]
2381[Add #ifdef around ghc-only (<$) as member of Functor class.
2382[email protected]**20091123085155]
2383[Fix broken code in non-GHC branch of an ifdef.
2384[email protected]**20091123084824]
2385[doc bugfix: correct description of index argument
2386Ross Paterson <[email protected]>**20091028105532
2387 Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9
2388 
2389 As noted by iaefai on the libraries list.
2390 
2391 Please merge to STABLE.
2392]
2393[Bump version to 0.3.0.0
2394Ian Lynagh <[email protected]>**20090920141847]
2395[update base dependency
2396Ross Paterson <[email protected]>**20090916073125
2397 Ignore-this: ad382ffc6c6a18c15364e6c072f19edb
2398 
2399 The package uses mkNoRepType and Data.Functor, which were not in the
2400 stable branch of base-4.
2401]
2402[add fast version of <$ for Seq
2403Ross Paterson <[email protected]>**20090916072812
2404 Ignore-this: 5a39a7d31d39760ed589790b1118d240
2405]
2406[new methods for Data.Sequence (proposal #3271)
2407Ross Paterson <[email protected]>**20090915173324
2408 Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7
2409 
2410 Adds a lot of new methods to Data.Sequence, mostly paralleling those
2411 in Data.List.  Several of these are significantly faster than versions
2412 implemented with the previous public interface.  In particular, replicate
2413 takes O(log n) time and space instead of O(n).
2414 (by Louis Wasserman)
2415]
2416[Fix "Cabal check" warnings
2417Ian Lynagh <[email protected]>**20090811215900]
2418[TAG 2009-06-25
2419Ian Lynagh <[email protected]>**20090625160202]
2420Patch bundle hash:
24219dc991ccf6f28731385952cc19588761d7bd55a2