hunk ./Data/Map.hs 460
- Tip -> singleton kx x
+ Tip -> singleton kx $! x
hunk ./Data/Sequence.hs 1447
-breakr p xs = foldr (\ i _ -> flipPair (splitAt i xs)) (xs, empty) (findIndicesR p xs)
+breakr p xs = foldr (\ i _ -> flipPair (splitAt (i + 1) xs)) (xs, empty) (findIndicesR p xs)
hunk ./tests/all.T 6
+test('sequence001', normal, compile_and_run, ['-package containers'])
addfile ./tests/sequence001.hs
hunk ./tests/sequence001.hs 1
+
+module Main where
+
+import Data.Sequence
+
+main :: IO ()
+main = do print $ dropWhileL (< 3) $ fromList [1..5]
+ print $ dropWhileR (> 3) $ fromList [1..5]
+
addfile ./tests/sequence001.stdout
hunk ./tests/sequence001.stdout 1
+fromList [3,4,5]
+fromList [1,2,3]
hunk ./Data/Sequence.hs 1
+{-# LANGUAGE ScopedTypeVariables #-}
hunk ./Data/Sequence.hs 523
-applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a)
+applicativeTree :: forall f a. Applicative f => Int -> Int -> f a -> f (FingerTree a)
hunk ./Data/Sequence.hs 546
+
+ emptyTree :: forall b. f (FingerTree b)
hunk ./Data/IntMap.hs 1
-{-# OPTIONS_GHC -cpp -XNoBangPatterns #-}
+{-# OPTIONS_GHC -cpp -XNoBangPatterns -XScopedTypeVariables #-}
hunk ./Data/IntMap.hs 1518
-fromDistinctAscList :: [(Key,a)] -> IntMap a
+fromDistinctAscList :: forall a. [(Key,a)] -> IntMap a
hunk ./tests/all.T 5
+test('datamap002', normal, compile_and_run, ['-package containers'])
addfile ./tests/datamap002.hs
hunk ./tests/datamap002.hs 1
+
+-- In 6.12 this failed
+
+module Main (main) where
+
+import Data.Map
+
+main :: IO ()
+main = print $ valid $ deleteMin $ deleteMin
+ $ fromList [ (i, ()) | i <- [0,2,5,1,6,4,8,9,7,11,10,3] ]
+
addfile ./tests/datamap002.stdout
hunk ./tests/datamap002.stdout 1
+True
hunk ./Data/Map.hs 1894
-delta = 5
+delta = 4
hunk ./Data/IntMap.hs 2
+{-# LANGUAGE CPP #-}
hunk ./Data/IntMap.hs 1519
+#ifdef GLASGOW_HASKELL
hunk ./Data/IntMap.hs 1521
+#else
+fromDistinctAscList :: [(Key,a)] -> IntMap a
+#endif
hunk ./Data/IntMap.hs 1530
+#ifdef GLASGOW_HASKELL
hunk ./Data/IntMap.hs 1532
+#endif
hunk ./Data/IntMap.hs 1519
-#ifdef GLASGOW_HASKELL
+#ifdef __GLASGOW_HASKELL__
hunk ./Data/IntMap.hs 1530
-#ifdef GLASGOW_HASKELL
+#ifdef __GLASGOW_HASKELL__
hunk ./Data/Map.hs 1
+{-# LANGUAGE CPP #-}
hunk ./Data/Map.hs 43
+#if !defined(TESTING)
hunk ./Data/Map.hs 45
+#else
+ Map(..) -- instance Eq,Show,Read
+#endif
hunk ./Data/Map.hs 180
+
+#if defined(TESTING)
+ -- * Internals
+ , bin
+ , balanced
+ , join
+ , merge
+#endif
addfile ./tests/map-properties.hs
hunk ./tests/map-properties.hs 1
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+--
+-- QuickCheck properties for Data.Map
+-- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i.. map-properties.hs
+
+--
+
+import Data.Map
+import Data.Monoid
+import Data.Maybe hiding (mapMaybe)
+import Data.Ord
+import Data.Function
+import Test.QuickCheck
+import Text.Show.Functions
+import Prelude hiding (lookup, null, map ,filter)
+import qualified Prelude (map, filter)
+import qualified Data.List as List
+
+import Control.Applicative ((<$>),(<*>))
+import Data.List (nub,sort)
+import qualified Data.List as L ((\\),intersect)
+import qualified Data.Set
+-- import Data.SMap.Types
+-- import Data.SMap.Balance
+-- import Data.SMap.Internal
+import Data.Maybe (isJust,fromJust)
+import Prelude hiding (lookup,map,filter,null)
+import qualified Prelude as P (map)
+import Test.Framework (defaultMain, testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2
+import Test.HUnit hiding (Test, Testable)
+import Test.QuickCheck
+
+main = do
+ q $ label "prop_Valid" prop_Valid
+ q $ label "prop_Single" prop_Single
+ q $ label "prop_InsertValid" prop_InsertValid
+ q $ label "prop_InsertDelete" prop_InsertDelete
+ q $ label "prop_DeleteValid" prop_DeleteValid
+ q $ label "prop_Join" prop_Join
+ q $ label "prop_Merge" prop_Merge
+ q $ label "prop_UnionValid" prop_UnionValid
+ q $ label "prop_UnionInsert" prop_UnionInsert
+ q $ label "prop_UnionAssoc" prop_UnionAssoc
+ q $ label "prop_UnionComm" prop_UnionComm
+ q $ label "prop_UnionWithValid" prop_UnionWithValid
+ q $ label "prop_UnionWith" prop_UnionWith
+ q $ label "prop_DiffValid" prop_DiffValid
+ q $ label "prop_Diff" prop_Diff
+ q $ label "prop_Diff2" prop_Diff2
+ q $ label "prop_IntValid" prop_IntValid
+ q $ label "prop_Int" prop_Int
+ q $ label "prop_Ordered" prop_Ordered
+ q $ label "prop_List" prop_List
+
+ -- new tests
+ q $ label "prop_index" prop_index
+ q $ label "prop_null" prop_null
+ q $ label "prop_member" prop_member
+ q $ label "prop_notmember" prop_notmember
+ q $ label "prop_findWithDefault" prop_findWithDefault
+ q $ label "prop_findIndex" prop_findIndex
+ q $ label "prop_findMin" prop_findMin
+ q $ label "prop_findMax" prop_findMax
+ q $ label "prop_filter" prop_filter
+ q $ label "prop_partition" prop_partition
+ q $ label "prop_map" prop_map
+ q $ label "prop_fmap" prop_fmap
+-- q $ label "prop_mapkeys" prop_mapkeys
+ q $ label "prop_foldr" prop_foldr
+ q $ label "prop_foldl" prop_foldl
+-- q $ label "prop_foldl'" prop_foldl'
+ q $ label "prop_fold" prop_fold
+ q $ label "prop_folWithKeyd" prop_foldWithKey
+
+ defaultMain tests
+
+ where
+ q :: Testable prop => prop -> IO ()
+ q = quickCheckWith args
+
+
+{--------------------------------------------------------------------
+ Testing
+--------------------------------------------------------------------}
+testTree xs = fromList [(x,"*") | x <- xs]
+test1 = testTree [1..20]
+test2 = testTree [30,29..10]
+test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
+
+
+{--------------------------------------------------------------------
+ QuickCheck
+--------------------------------------------------------------------}
+
+args = stdArgs {
+ maxSuccess = 500
+ , maxDiscard = 500
+ }
+
+{-
+qcheck prop
+ = check config prop
+ where
+ config = Config
+ { configMaxTest = 500
+ , configMaxFail = 5000
+ , configSize = \n -> (div n 2 + 3)
+ , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
+ }
+-}
+
+
+{--------------------------------------------------------------------
+ Arbitrary, reasonably balanced trees
+--------------------------------------------------------------------}
+instance (Enum k,Arbitrary a) => Arbitrary (Map k a) where
+ arbitrary = sized (arbtree 0 maxkey)
+ where maxkey = 10^5
+
+--
+-- requires access to internals
+--
+arbtree :: (Enum k,Arbitrary a) => Int -> Int -> Int -> Gen (Map k a)
+arbtree lo hi n
+ | n <= 0 = return Tip
+ | lo >= hi = return Tip
+ | otherwise = do{ x <- arbitrary
+ ; i <- choose (lo,hi)
+ ; m <- choose (1,70)
+ ; let (ml,mr) | m==(1::Int)= (1,2)
+ | m==2 = (2,1)
+ | m==3 = (1,1)
+ | otherwise = (2,2)
+ ; l <- arbtree lo (i-1) (n `div` ml)
+ ; r <- arbtree (i+1) hi (n `div` mr)
+ ; return (bin (toEnum i) x l r)
+ }
+
+
+{--------------------------------------------------------------------
+ Valid tree's
+--------------------------------------------------------------------}
+forValid :: (Show k,Enum k,Show a,Arbitrary a,Testable b) => (Map k a -> b) -> Property
+forValid f
+ = forAll arbitrary $ \t ->
+-- classify (balanced t) "balanced" $
+ classify (size t == 0) "empty" $
+ classify (size t > 0 && size t <= 10) "small" $
+ classify (size t > 10 && size t <= 64) "medium" $
+ classify (size t > 64) "large" $
+ balanced t ==> f t
+
+forValidIntTree :: Testable a => (Map Int Int -> a) -> Property
+forValidIntTree f
+ = forValid f
+
+forValidUnitTree :: Testable a => (Map Int () -> a) -> Property
+forValidUnitTree f
+ = forValid f
+
+
+prop_Valid
+ = forValidUnitTree $ \t -> valid t
+
+{--------------------------------------------------------------------
+ Single, Insert, Delete
+--------------------------------------------------------------------}
+prop_Single :: Int -> Int -> Bool
+prop_Single k x
+ = (insert k x empty == singleton k x)
+
+prop_InsertValid :: Int -> Property
+prop_InsertValid k
+ = forValidUnitTree $ \t -> valid (insert k () t)
+
+prop_InsertDelete :: Int -> Map Int () -> Property
+prop_InsertDelete k t
+ = (lookup k t == Nothing) ==> delete k (insert k () t) == t
+
+prop_DeleteValid :: Int -> Property
+prop_DeleteValid k
+ = forValidUnitTree $ \t ->
+ valid (delete k (insert k () t))
+
+{--------------------------------------------------------------------
+ Balance
+--------------------------------------------------------------------}
+prop_Join :: Int -> Property
+prop_Join k
+ = forValidUnitTree $ \t ->
+ let (l,r) = split k t
+ in valid (join k () l r)
+
+prop_Merge :: Int -> Property
+prop_Merge k
+ = forValidUnitTree $ \t ->
+ let (l,r) = split k t
+ in valid (merge l r)
+
+
+{--------------------------------------------------------------------
+ Union
+--------------------------------------------------------------------}
+prop_UnionValid :: Property
+prop_UnionValid
+ = forValidUnitTree $ \t1 ->
+ forValidUnitTree $ \t2 ->
+ valid (union t1 t2)
+
+prop_UnionInsert :: Int -> Int -> Map Int Int -> Bool
+prop_UnionInsert k x t
+ = union (singleton k x) t == insert k x t
+
+prop_UnionAssoc :: Map Int Int -> Map Int Int -> Map Int Int -> Bool
+prop_UnionAssoc t1 t2 t3
+ = union t1 (union t2 t3) == union (union t1 t2) t3
+
+prop_UnionComm :: Map Int Int -> Map Int Int -> Bool
+prop_UnionComm t1 t2
+ = (union t1 t2 == unionWith (\x y -> y) t2 t1)
+
+prop_UnionWithValid
+ = forValidIntTree $ \t1 ->
+ forValidIntTree $ \t2 ->
+ valid (unionWithKey (\k x y -> x+y) t1 t2)
+
+prop_UnionWith :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_UnionWith xs ys
+ = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
+ == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
+
+prop_DiffValid
+ = forValidUnitTree $ \t1 ->
+ forValidUnitTree $ \t2 ->
+ valid (difference t1 t2)
+
+prop_Diff :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_Diff xs ys
+ = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
+ == List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys)))
+
+prop_Diff2 :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_Diff2 xs ys
+ = List.sort (keys ((\\) (fromListWith (+) xs) (fromListWith (+) ys)))
+ == List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys)))
+
+prop_IntValid
+ = forValidUnitTree $ \t1 ->
+ forValidUnitTree $ \t2 ->
+ valid (intersection t1 t2)
+
+prop_Int :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_Int xs ys
+ = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
+ == List.sort (List.nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
+
+{--------------------------------------------------------------------
+ Lists
+--------------------------------------------------------------------}
+prop_Ordered
+ = forAll (choose (5,100)) $ \n ->
+ let xs = [(x,()) | x <- [0..n::Int]]
+ in fromAscList xs == fromList xs
+
+prop_List :: [Int] -> Bool
+prop_List xs
+ = (List.sort (List.nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
+
+------------------------------------------------------------------------
+-- New tests: compare against the list model (after nub on keys)
+
+prop_index = \(xs :: [Int]) -> length xs > 0 ==>
+ let m = fromList (zip xs xs)
+ in xs == [ m ! i | i <- xs ]
+
+prop_null (m :: Data.Map.Map Int Int) = Data.Map.null m == (size m == 0)
+
+prop_member (xs :: [Int]) n =
+ let m = fromList (zip xs xs)
+ in (n `elem` xs) == (n `member` m)
+
+prop_notmember (xs :: [Int]) n =
+ let m = fromList (zip xs xs)
+ in (n `notElem` xs) == (n `notMember` m)
+
+prop_findWithDefault = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList xs
+ xs = List.nubBy ((==) `on` fst) ys
+ in
+ and [ findWithDefault 0 i m == j | (i,j) <- xs ]
+
+prop_findIndex = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ in findIndex (fst (head ys)) m `seq` True
+
+prop_lookupIndex = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ in isJust (lookupIndex (fst (head ys)) m)
+
+prop_findMin = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in findMin m == List.minimumBy (comparing fst) xs
+
+prop_findMax = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in findMax m == List.maximumBy (comparing fst) xs
+
+prop_filter = \p (ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.filter p m == fromList (List.filter (p . snd) xs)
+
+prop_partition = \p (ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.partition p m == let (a,b) = (List.partition (p . snd) xs) in (fromList a, fromList b)
+
+prop_map (f :: Int -> Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.map f m == fromList [ (a, f b) | (a,b) <- xs ]
+
+prop_fmap (f :: Int -> Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ fmap f m == fromList [ (a, f b) | (a,b) <- xs ]
+
+{-
+
+-- mapkeys is hard, as we have to consider collisions of the index space.
+
+prop_mapkeys (f :: Int -> Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.mapKeys f m ==
+ (fromList $
+ {-List.nubBy ((==) `on` fst) $ reverse-} [ (f a, b) | (a,b) <- xs ])
+-}
+
+
+prop_foldr (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ fold (+) n m == List.foldr (+) n (List.map snd xs)
+ where
+ fold k = Data.Map.foldrWithKey (\_ x' z' -> k x' z')
+
+
+prop_foldl (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.foldlWithKey (\a _ b -> a + b) n m == List.foldl (+) n (List.map snd xs)
+
+
+{-
+prop_foldl' (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.foldlWithKey' (\a _ b -> a + b) n m == List.foldl' (+) n (List.map snd xs)
+-}
+
+
+prop_fold (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.fold (+) n m == List.foldr (+) n (List.map snd xs)
+
+prop_foldWithKey (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.foldWithKey (const (+)) n m == List.foldr (+) n (List.map snd xs)
+
+------------------------------------------------------------------------
+
+type UMap = Map Int ()
+type IMap = Map Int Int
+type SMap = Map Int String
+
+----------------------------------------------------------------
+
+tests :: [Test]
+tests = [ testGroup "Test Case" [
+ testCase "ticket4242" test_ticket4242
+ , testCase "index" test_index
+ , testCase "size" test_size
+ , testCase "size2" test_size2
+ , testCase "member" test_member
+ , testCase "notMember" test_notMember
+ , testCase "lookup" test_lookup
+ , testCase "findWithDefault" test_findWithDefault
+ , testCase "empty" test_empty
+ , testCase "mempty" test_mempty
+ , testCase "singleton" test_singleton
+ , testCase "insert" test_insert
+ , testCase "insertWith" test_insertWith
+ , testCase "insertWith'" test_insertWith'
+ , testCase "insertWithKey" test_insertWithKey
+ , testCase "insertWithKey'" test_insertWithKey'
+ , testCase "insertLookupWithKey" test_insertLookupWithKey
+-- , testCase "insertLookupWithKey'" test_insertLookupWithKey'
+ , testCase "delete" test_delete
+ , testCase "adjust" test_adjust
+ , testCase "adjustWithKey" test_adjustWithKey
+ , testCase "update" test_update
+ , testCase "updateWithKey" test_updateWithKey
+ , testCase "updateLookupWithKey" test_updateLookupWithKey
+ , testCase "alter" test_alter
+ , testCase "union" test_union
+ , testCase "mappend" test_mappend
+ , testCase "unionWith" test_unionWith
+ , testCase "unionWithKey" test_unionWithKey
+ , testCase "unions" test_unions
+ , testCase "mconcat" test_mconcat
+ , testCase "unionsWith" test_unionsWith
+ , testCase "difference" test_difference
+ , testCase "differenceWith" test_differenceWith
+ , testCase "differenceWithKey" test_differenceWithKey
+ , testCase "intersection" test_intersection
+ , testCase "intersectionWith" test_intersectionWith
+ , testCase "intersectionWithKey" test_intersectionWithKey
+ , testCase "map" test_map
+ , testCase "mapWithKey" test_mapWithKey
+ , testCase "mapAccum" test_mapAccum
+ , testCase "mapAccumWithKey" test_mapAccumWithKey
+ , testCase "mapAccumRWithKey" test_mapAccumRWithKey
+ , testCase "mapKeys" test_mapKeys
+ , testCase "mapKeysWith" test_mapKeysWith
+ , testCase "mapKeysMonotonic" test_mapKeysMonotonic
+ , testCase "fold" test_fold
+ , testCase "foldWithKey" test_foldWithKey
+ , testCase "elems" test_elems
+ , testCase "keys" test_keys
+ , testCase "keysSet" test_keysSet
+ , testCase "associative" test_assocs
+ , testCase "toList" test_toList
+ , testCase "fromList" test_fromList
+ , testCase "fromListWith" test_fromListWith
+ , testCase "fromListWithKey" test_fromListWithKey
+ , testCase "toAscList" test_toAscList
+ , testCase "toDescList" test_toDescList
+ , testCase "showTree" test_showTree
+ , testCase "showTree'" test_showTree'
+ , testCase "fromAscList" test_fromAscList
+ , testCase "fromAscListWith" test_fromAscListWith
+ , testCase "fromAscListWithKey" test_fromAscListWithKey
+ , testCase "fromDistinctAscList" test_fromDistinctAscList
+ , testCase "filter" test_filter
+ , testCase "filterWithKey" test_filteWithKey
+ , testCase "partition" test_partition
+ , testCase "partitionWithKey" test_partitionWithKey
+ , testCase "mapMaybe" test_mapMaybe
+ , testCase "mapMaybeWithKey" test_mapMaybeWithKey
+ , testCase "mapEither" test_mapEither
+ , testCase "mapEitherWithKey" test_mapEitherWithKey
+ , testCase "split" test_split
+ , testCase "splitLookup" test_splitLookup
+ , testCase "isSubmapOfBy" test_isSubmapOfBy
+ , testCase "isSubmapOf" test_isSubmapOf
+ , testCase "isProperSubmapOfBy" test_isProperSubmapOfBy
+ , testCase "isProperSubmapOf" test_isProperSubmapOf
+ , testCase "lookupIndex" test_lookupIndex
+ , testCase "findIndex" test_findIndex
+ , testCase "elemAt" test_elemAt
+ , testCase "updateAt" test_updateAt
+ , testCase "deleteAt" test_deleteAt
+ , testCase "findMin" test_findMin
+ , testCase "findMax" test_findMax
+ , testCase "deleteMin" test_deleteMin
+ , testCase "deleteMax" test_deleteMax
+ , testCase "deleteFindMin" test_deleteFindMin
+ , testCase "deleteFindMax" test_deleteFindMax
+ , testCase "updateMin" test_updateMin
+ , testCase "updateMax" test_updateMax
+ , testCase "updateMinWithKey" test_updateMinWithKey
+ , testCase "updateMaxWithKey" test_updateMaxWithKey
+ , testCase "minView" test_minView
+ , testCase "maxView" test_maxView
+ , testCase "minViewWithKey" test_minViewWithKey
+ , testCase "maxViewWithKey" test_maxViewWithKey
+ , testCase "valid" test_valid
+ ]
+ , testGroup "Property Test" [
+ -- testProperty "fromList" prop_fromList
+ testProperty "insert to singleton" prop_singleton
+ -- , testProperty "insert" prop_insert
+ , testProperty "insert then lookup" prop_lookup
+ -- , testProperty "insert then delete" prop_insertDelete
+ -- , testProperty "insert then delete2" prop_insertDelete2
+ , testProperty "delete non member" prop_deleteNonMember
+ -- , testProperty "deleteMin" prop_deleteMin
+ -- , testProperty "deleteMax" prop_deleteMax
+ , testProperty "split" prop_split
+ -- , testProperty "split then join" prop_join
+ -- , testProperty "split then merge" prop_merge
+ -- , testProperty "union" prop_union
+ , testProperty "union model" prop_unionModel
+ , testProperty "union singleton" prop_unionSingleton
+ , testProperty "union associative" prop_unionAssoc
+ , testProperty "fromAscList" prop_ordered
+ , testProperty "fromList then toList" prop_list
+ , testProperty "unionWith" prop_unionWith
+ -- , testProperty "unionWith2" prop_unionWith2
+ , testProperty "union sum" prop_unionSum
+ -- , testProperty "difference" prop_difference
+ , testProperty "difference model" prop_differenceModel
+ , testProperty "intersection" prop_intersection
+ , testProperty "intersection model" prop_intersectionModel
+ -- , testProperty "alter" prop_alter
+ ]
+ ]
+
+
+----------------------------------------------------------------
+-- Unit tests
+----------------------------------------------------------------
+
+test_ticket4242 :: Assertion
+test_ticket4242 = (valid $ deleteMin $ deleteMin $ fromList [ (i, ()) | i <- [0,2,5,1,6,4,8,9,7,11,10,3] :: [Int] ]) @?= True
+
+----------------------------------------------------------------
+-- Operators
+
+test_index :: Assertion
+test_index = fromList [(5,'a'), (3,'b')] ! 5 @?= 'a'
+
+----------------------------------------------------------------
+-- Query
+
+test_size :: Assertion
+test_size = do
+ null (empty) @?= True
+ null (singleton 1 'a') @?= False
+
+test_size2 :: Assertion
+test_size2 = do
+ size empty @?= 0
+ size (singleton 1 'a') @?= 1
+ size (fromList([(1,'a'), (2,'c'), (3,'b')])) @?= 3
+
+test_member :: Assertion
+test_member = do
+ member 5 (fromList [(5,'a'), (3,'b')]) @?= True
+ member 1 (fromList [(5,'a'), (3,'b')]) @?= False
+
+test_notMember :: Assertion
+test_notMember = do
+ notMember 5 (fromList [(5,'a'), (3,'b')]) @?= False
+ notMember 1 (fromList [(5,'a'), (3,'b')]) @?= True
+
+test_lookup :: Assertion
+test_lookup = do
+ employeeCurrency "John" @?= Just "Euro"
+ employeeCurrency "Pete" @?= Nothing
+ where
+ employeeDept = fromList([("John","Sales"), ("Bob","IT")])
+ deptCountry = fromList([("IT","USA"), ("Sales","France")])
+ countryCurrency = fromList([("USA", "Dollar"), ("France", "Euro")])
+ employeeCurrency :: String -> Maybe String
+ employeeCurrency name = do
+ dept <- lookup name employeeDept
+ country <- lookup dept deptCountry
+ lookup country countryCurrency
+
+test_findWithDefault :: Assertion
+test_findWithDefault = do
+ findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) @?= 'x'
+ findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) @?= 'a'
+
+----------------------------------------------------------------
+-- Construction
+
+test_empty :: Assertion
+test_empty = do
+ (empty :: UMap) @?= fromList []
+ size empty @?= 0
+
+test_mempty :: Assertion
+test_mempty = do
+ (mempty :: UMap) @?= fromList []
+ size (mempty :: UMap) @?= 0
+
+test_singleton :: Assertion
+test_singleton = do
+ singleton 1 'a' @?= fromList [(1, 'a')]
+ size (singleton 1 'a') @?= 1
+
+test_insert :: Assertion
+test_insert = do
+ insert 5 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'x')]
+ insert 7 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'a'), (7, 'x')]
+ insert 5 'x' empty @?= singleton 5 'x'
+
+test_insertWith :: Assertion
+test_insertWith = do
+ insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
+ insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
+ insertWith (++) 5 "xxx" empty @?= singleton 5 "xxx"
+
+test_insertWith' :: Assertion
+test_insertWith' = do
+ insertWith' (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
+ insertWith' (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
+ insertWith' (++) 5 "xxx" empty @?= singleton 5 "xxx"
+
+test_insertWithKey :: Assertion
+test_insertWithKey = do
+ insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
+ insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
+ insertWithKey f 5 "xxx" empty @?= singleton 5 "xxx"
+ where
+ f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+
+test_insertWithKey' :: Assertion
+test_insertWithKey' = do
+ insertWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
+ insertWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
+ insertWithKey' f 5 "xxx" empty @?= singleton 5 "xxx"
+ where
+ f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+
+test_insertLookupWithKey :: Assertion
+test_insertLookupWithKey = do
+ insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
+ insertLookupWithKey f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
+ insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
+ insertLookupWithKey f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx")
+ where
+ f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+
+{-
+test_insertLookupWithKey' :: Assertion
+test_insertLookupWithKey' = do
+ insertLookupWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
+ insertLookupWithKey' f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
+ insertLookupWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
+ insertLookupWithKey' f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx")
+ where
+ f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+-}
+
+----------------------------------------------------------------
+-- Delete/Update
+
+test_delete :: Assertion
+test_delete = do
+ delete 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+ delete 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ delete 5 empty @?= (empty :: IMap)
+
+test_adjust :: Assertion
+test_adjust = do
+ adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
+ adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ adjust ("new " ++) 7 empty @?= empty
+
+test_adjustWithKey :: Assertion
+test_adjustWithKey = do
+ adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
+ adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ adjustWithKey f 7 empty @?= empty
+ where
+ f key x = (show key) ++ ":new " ++ x
+
+test_update :: Assertion
+test_update = do
+ update f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
+ update f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ update f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+ where
+ f x = if x == "a" then Just "new a" else Nothing
+
+test_updateWithKey :: Assertion
+test_updateWithKey = do
+ updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
+ updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+ where
+ f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
+
+test_updateLookupWithKey :: Assertion
+test_updateLookupWithKey = do
+ updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= (Just "5:new a", fromList [(3, "b"), (5, "5:new a")])
+ updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a")])
+ updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= (Just "b", singleton 5 "a")
+ where
+ f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
+
+test_alter :: Assertion
+test_alter = do
+ alter f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ alter f 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+ alter g 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "c")]
+ alter g 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "c")]
+ where
+ f _ = Nothing
+ g _ = Just "c"
+
+----------------------------------------------------------------
+-- Combine
+
+test_union :: Assertion
+test_union = union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
+
+test_mappend :: Assertion
+test_mappend = mappend (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
+
+test_unionWith :: Assertion
+test_unionWith = unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "aA"), (7, "C")]
+
+test_unionWithKey :: Assertion
+test_unionWithKey = unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
+ where
+ f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
+
+test_unions :: Assertion
+test_unions = do
+ unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+ @?= fromList [(3, "b"), (5, "a"), (7, "C")]
+ unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
+ @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
+
+test_mconcat :: Assertion
+test_mconcat = do
+ mconcat [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+ @?= fromList [(3, "b"), (5, "a"), (7, "C")]
+ mconcat [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
+ @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
+
+test_unionsWith :: Assertion
+test_unionsWith = unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+ @?= fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
+
+test_difference :: Assertion
+test_difference = difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 3 "b"
+
+test_differenceWith :: Assertion
+test_differenceWith = differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
+ @?= singleton 3 "b:B"
+ where
+ f al ar = if al== "b" then Just (al ++ ":" ++ ar) else Nothing
+
+test_differenceWithKey :: Assertion
+test_differenceWithKey = differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
+ @?= singleton 3 "3:b|B"
+ where
+ f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
+
+test_intersection :: Assertion
+test_intersection = intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "a"
+
+
+test_intersectionWith :: Assertion
+test_intersectionWith = intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "aA"
+
+test_intersectionWithKey :: Assertion
+test_intersectionWithKey = intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "5:a|A"
+ where
+ f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
+
+----------------------------------------------------------------
+-- Traversal
+
+test_map :: Assertion
+test_map = map (++ "x") (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "bx"), (5, "ax")]
+
+test_mapWithKey :: Assertion
+test_mapWithKey = mapWithKey f (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "3:b"), (5, "5:a")]
+ where
+ f key x = (show key) ++ ":" ++ x
+
+test_mapAccum :: Assertion
+test_mapAccum = mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) @?= ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
+ where
+ f a b = (a ++ b, b ++ "X")
+
+test_mapAccumWithKey :: Assertion
+test_mapAccumWithKey = mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
+ where
+ f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
+
+test_mapAccumRWithKey :: Assertion
+test_mapAccumRWithKey = mapAccumRWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 5-a 3-b", fromList [(3, "bX"), (5, "aX")])
+ where
+ f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
+
+test_mapKeys :: Assertion
+test_mapKeys = do
+ mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
+ mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "c"
+ mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "c"
+
+test_mapKeysWith :: Assertion
+test_mapKeysWith = do
+ mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "cdab"
+ mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "cdab"
+
+test_mapKeysMonotonic :: Assertion
+test_mapKeysMonotonic = do
+ mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")]
+ valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) @?= True
+ valid (mapKeysMonotonic (\ _ -> 1) (fromList [(5,"a"), (3,"b")])) @?= False
+
+test_fold :: Assertion
+test_fold = fold f 0 (fromList [(5,"a"), (3,"bbb")]) @?= 4
+ where
+ f a len = len + (length a)
+
+test_foldWithKey :: Assertion
+test_foldWithKey = foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) @?= "Map: (5:a)(3:b)"
+ where
+ f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
+
+----------------------------------------------------------------
+-- Conversion
+
+test_elems :: Assertion
+test_elems = do
+ elems (fromList [(5,"a"), (3,"b")]) @?= ["b","a"]
+ elems (empty :: UMap) @?= []
+
+test_keys :: Assertion
+test_keys = do
+ keys (fromList [(5,"a"), (3,"b")]) @?= [3,5]
+ keys (empty :: UMap) @?= []
+
+test_keysSet :: Assertion
+test_keysSet = do
+ keysSet (fromList [(5,"a"), (3,"b")]) @?= Data.Set.fromList [3,5]
+ keysSet (empty :: UMap) @?= Data.Set.empty
+
+test_assocs :: Assertion
+test_assocs = do
+ assocs (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
+ assocs (empty :: UMap) @?= []
+
+----------------------------------------------------------------
+-- Lists
+
+test_toList :: Assertion
+test_toList = do
+ toList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
+ toList (empty :: SMap) @?= []
+
+test_fromList :: Assertion
+test_fromList = do
+ fromList [] @?= (empty :: SMap)
+ fromList [(5,"a"), (3,"b"), (5, "c")] @?= fromList [(5,"c"), (3,"b")]
+ fromList [(5,"c"), (3,"b"), (5, "a")] @?= fromList [(5,"a"), (3,"b")]
+
+test_fromListWith :: Assertion
+test_fromListWith = do
+ fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "ab"), (5, "aba")]
+ fromListWith (++) [] @?= (empty :: SMap)
+
+test_fromListWithKey :: Assertion
+test_fromListWithKey = do
+ fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "3ab"), (5, "5a5ba")]
+ fromListWithKey f [] @?= (empty :: SMap)
+ where
+ f k a1 a2 = (show k) ++ a1 ++ a2
+
+----------------------------------------------------------------
+-- Ordered lists
+
+test_toAscList :: Assertion
+test_toAscList = toAscList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
+
+test_toDescList :: Assertion
+test_toDescList = toDescList (fromList [(5,"a"), (3,"b")]) @?= [(5,"a"), (3,"b")]
+
+test_showTree :: Assertion
+test_showTree =
+ (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
+ in showTree t) @?= "4:=()\n+--2:=()\n| +--1:=()\n| +--3:=()\n+--5:=()\n"
+
+test_showTree' :: Assertion
+test_showTree' =
+ (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
+ in s t ) @?= "+--5:=()\n|\n4:=()\n|\n| +--3:=()\n| |\n+--2:=()\n |\n +--1:=()\n"
+ where
+ showElem k x = show k ++ ":=" ++ show x
+
+ s = showTreeWith showElem False True
+
+
+test_fromAscList :: Assertion
+test_fromAscList = do
+ fromAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
+ fromAscList [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "b")]
+ valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) @?= True
+ valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) @?= False
+
+test_fromAscListWith :: Assertion
+test_fromAscListWith = do
+ fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "ba")]
+ valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) @?= True
+ valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) @?= False
+
+test_fromAscListWithKey :: Assertion
+test_fromAscListWithKey = do
+ fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] @?= fromList [(3, "b"), (5, "5:b5:ba")]
+ valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) @?= True
+ valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) @?= False
+ where
+ f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
+
+test_fromDistinctAscList :: Assertion
+test_fromDistinctAscList = do
+ fromDistinctAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
+ valid (fromDistinctAscList [(3,"b"), (5,"a")]) @?= True
+ valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) @?= False
+
+----------------------------------------------------------------
+-- Filter
+
+test_filter :: Assertion
+test_filter = do
+ filter (> "a") (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+ filter (> "x") (fromList [(5,"a"), (3,"b")]) @?= empty
+ filter (< "a") (fromList [(5,"a"), (3,"b")]) @?= empty
+
+test_filteWithKey :: Assertion
+test_filteWithKey = filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+
+test_partition :: Assertion
+test_partition = do
+ partition (> "a") (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
+ partition (< "x") (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
+ partition (> "x") (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
+
+test_partitionWithKey :: Assertion
+test_partitionWithKey = do
+ partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) @?= (singleton 5 "a", singleton 3 "b")
+ partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
+ partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
+
+test_mapMaybe :: Assertion
+test_mapMaybe = mapMaybe f (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "new a"
+ where
+ f x = if x == "a" then Just "new a" else Nothing
+
+test_mapMaybeWithKey :: Assertion
+test_mapMaybeWithKey = mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "key : 3"
+ where
+ f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
+
+test_mapEither :: Assertion
+test_mapEither = do
+ mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ @?= (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
+ mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ @?= ((empty :: SMap), fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ where
+ f a = if a < "c" then Left a else Right a
+
+test_mapEitherWithKey :: Assertion
+test_mapEitherWithKey = do
+ mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ @?= (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
+ mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ @?= ((empty :: SMap), fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
+ where
+ f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
+
+test_split :: Assertion
+test_split = do
+ split 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3,"b"), (5,"a")])
+ split 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, singleton 5 "a")
+ split 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
+ split 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", empty)
+ split 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], empty)
+
+test_splitLookup :: Assertion
+test_splitLookup = do
+ splitLookup 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, Nothing, fromList [(3,"b"), (5,"a")])
+ splitLookup 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, Just "b", singleton 5 "a")
+ splitLookup 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Nothing, singleton 5 "a")
+ splitLookup 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Just "a", empty)
+ splitLookup 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], Nothing, empty)
+
+----------------------------------------------------------------
+-- Submap
+
+test_isSubmapOfBy :: Assertion
+test_isSubmapOfBy = do
+ isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
+ isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
+ isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)]) @?= True
+ isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)]) @?= False
+ isSubmapOfBy (<) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= False
+ isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)]) @?= False
+
+test_isSubmapOf :: Assertion
+test_isSubmapOf = do
+ isSubmapOf (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
+ isSubmapOf (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)]) @?= True
+ isSubmapOf (fromList [('a',2)]) (fromList [('a',1),('b',2)]) @?= False
+ isSubmapOf (fromList [('a',1),('b',2)]) (fromList [('a',1)]) @?= False
+
+test_isProperSubmapOfBy :: Assertion
+test_isProperSubmapOfBy = do
+ isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
+ isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
+ isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
+ isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
+ isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= False
+
+test_isProperSubmapOf :: Assertion
+test_isProperSubmapOf = do
+ isProperSubmapOf (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
+ isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
+ isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
+
+----------------------------------------------------------------
+-- Indexed
+
+test_lookupIndex :: Assertion
+test_lookupIndex = do
+ isJust (lookupIndex 2 (fromList [(5,"a"), (3,"b")])) @?= False
+ fromJust (lookupIndex 3 (fromList [(5,"a"), (3,"b")])) @?= 0
+ fromJust (lookupIndex 5 (fromList [(5,"a"), (3,"b")])) @?= 1
+ isJust (lookupIndex 6 (fromList [(5,"a"), (3,"b")])) @?= False
+
+test_findIndex :: Assertion
+test_findIndex = do
+ findIndex 3 (fromList [(5,"a"), (3,"b")]) @?= 0
+ findIndex 5 (fromList [(5,"a"), (3,"b")]) @?= 1
+
+test_elemAt :: Assertion
+test_elemAt = do
+ elemAt 0 (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
+ elemAt 1 (fromList [(5,"a"), (3,"b")]) @?= (5, "a")
+
+test_updateAt :: Assertion
+test_updateAt = do
+ updateAt (\ _ _ -> Just "x") 0 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "x"), (5, "a")]
+ updateAt (\ _ _ -> Just "x") 1 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "x")]
+ updateAt (\_ _ -> Nothing) 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+ updateAt (\_ _ -> Nothing) 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+
+test_deleteAt :: Assertion
+test_deleteAt = do
+ deleteAt 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+ deleteAt 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+
+----------------------------------------------------------------
+-- Min/Max
+
+test_findMin :: Assertion
+test_findMin = findMin (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
+
+test_findMax :: Assertion
+test_findMax = findMax (fromList [(5,"a"), (3,"b")]) @?= (5,"a")
+
+test_deleteMin :: Assertion
+test_deleteMin = do
+ deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(5,"a"), (7,"c")]
+ deleteMin (empty :: SMap) @?= empty
+
+test_deleteMax :: Assertion
+test_deleteMax = do
+ deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(3,"b"), (5,"a")]
+ deleteMax (empty :: SMap) @?= empty
+
+test_deleteFindMin :: Assertion
+test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((3,"b"), fromList[(5,"a"), (10,"c")])
+
+test_deleteFindMax :: Assertion
+test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((10,"c"), fromList [(3,"b"), (5,"a")])
+
+test_updateMin :: Assertion
+test_updateMin = do
+ updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")]
+ updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+
+test_updateMax :: Assertion
+test_updateMax = do
+ updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")]
+ updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+
+test_updateMinWithKey :: Assertion
+test_updateMinWithKey = do
+ updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")]
+ updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+
+test_updateMaxWithKey :: Assertion
+test_updateMaxWithKey = do
+ updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")]
+ updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+
+test_minView :: Assertion
+test_minView = do
+ minView (fromList [(5,"a"), (3,"b")]) @?= Just ("b", singleton 5 "a")
+ minView (empty :: SMap) @?= Nothing
+
+test_maxView :: Assertion
+test_maxView = do
+ maxView (fromList [(5,"a"), (3,"b")]) @?= Just ("a", singleton 3 "b")
+ maxView (empty :: SMap) @?= Nothing
+
+test_minViewWithKey :: Assertion
+test_minViewWithKey = do
+ minViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((3,"b"), singleton 5 "a")
+ minViewWithKey (empty :: SMap) @?= Nothing
+
+test_maxViewWithKey :: Assertion
+test_maxViewWithKey = do
+ maxViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((5,"a"), singleton 3 "b")
+ maxViewWithKey (empty :: SMap) @?= Nothing
+
+----------------------------------------------------------------
+-- Debug
+
+test_valid :: Assertion
+test_valid = do
+ valid (fromAscList [(3,"b"), (5,"a")]) @?= True
+ valid (fromAscList [(5,"a"), (3,"b")]) @?= False
+
+----------------------------------------------------------------
+-- QuickCheck
+----------------------------------------------------------------
+
+prop_fromList :: UMap -> Bool
+prop_fromList t = valid t
+
+prop_singleton :: Int -> Int -> Bool
+prop_singleton k x = insert k x empty == singleton k x
+
+prop_insert :: Int -> UMap -> Bool
+prop_insert k t = valid $ insert k () t
+
+prop_lookup :: Int -> UMap -> Bool
+prop_lookup k t = lookup k (insert k () t) /= Nothing
+
+prop_insertDelete :: Int -> UMap -> Bool
+prop_insertDelete k t = valid $ delete k (insert k () t)
+
+prop_insertDelete2 :: Int -> UMap -> Property
+prop_insertDelete2 k t = (lookup k t == Nothing) ==> (delete k (insert k () t) == t)
+
+prop_deleteNonMember :: Int -> UMap -> Property
+prop_deleteNonMember k t = (lookup k t == Nothing) ==> (delete k t == t)
+
+prop_deleteMin :: UMap -> Bool
+prop_deleteMin t = valid $ deleteMin $ deleteMin t
+
+prop_deleteMax :: UMap -> Bool
+prop_deleteMax t = valid $ deleteMax $ deleteMax t
+
+----------------------------------------------------------------
+
+prop_split :: Int -> UMap -> Property
+prop_split k t = (lookup k t /= Nothing) ==> let (r,l) = split k t
+ in (valid r, valid l) == (True, True)
+
+prop_join :: Int -> UMap -> Bool
+prop_join k t = let (l,r) = split k t
+ in valid (join k () l r)
+
+prop_merge :: Int -> UMap -> Bool
+prop_merge k t = let (l,r) = split k t
+ in valid (merge l r)
+
+----------------------------------------------------------------
+
+prop_union :: UMap -> UMap -> Bool
+prop_union t1 t2 = valid (union t1 t2)
+
+prop_unionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_unionModel xs ys
+ = sort (keys (union (fromList xs) (fromList ys)))
+ == sort (nub (P.map fst xs ++ P.map fst ys))
+
+prop_unionSingleton :: IMap -> Int -> Int -> Bool
+prop_unionSingleton t k x = union (singleton k x) t == insert k x t
+
+prop_unionAssoc :: IMap -> IMap -> IMap -> Bool
+prop_unionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
+
+prop_unionWith :: IMap -> IMap -> Bool
+prop_unionWith t1 t2 = (union t1 t2 == unionWith (\_ y -> y) t2 t1)
+
+prop_unionWith2 :: IMap -> IMap -> Bool
+prop_unionWith2 t1 t2 = valid (unionWithKey (\_ x y -> x+y) t1 t2)
+
+prop_unionSum :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_unionSum xs ys
+ = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
+ == (sum (P.map snd xs) + sum (P.map snd ys))
+
+prop_difference :: IMap -> IMap -> Bool
+prop_difference t1 t2 = valid (difference t1 t2)
+
+prop_differenceModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_differenceModel xs ys
+ = sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
+ == sort ((L.\\) (nub (P.map fst xs)) (nub (P.map fst ys)))
+
+prop_intersection :: IMap -> IMap -> Bool
+prop_intersection t1 t2 = valid (intersection t1 t2)
+
+prop_intersectionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_intersectionModel xs ys
+ = sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
+ == sort (nub ((L.intersect) (P.map fst xs) (P.map fst ys)))
+
+----------------------------------------------------------------
+
+prop_ordered :: Property
+prop_ordered
+ = forAll (choose (5,100)) $ \n ->
+ let xs = [(x,()) | x <- [0..n::Int]]
+ in fromAscList xs == fromList xs
+
+prop_list :: [Int] -> Bool
+prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
+
+----------------------------------------------------------------
+
+prop_alter :: UMap -> Int -> Bool
+prop_alter t k = balanced t' && case lookup k t of
+ Just _ -> (size t - 1) == size t' && lookup k t' == Nothing
+ Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing
+ where
+ t' = alter f k t
+ f Nothing = Just ()
+ f (Just ()) = Nothing
adddir ./benchmarks
addfile ./benchmarks/Benchmarks.hs
hunk ./benchmarks/Benchmarks.hs 1
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import Control.DeepSeq
+import Control.Exception (evaluate)
+import Control.Monad.Trans (liftIO)
+import Criterion.Config
+import Criterion.Main
+import Data.List (foldl')
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Prelude hiding (lookup)
+
+instance (NFData k, NFData a) => NFData (M.Map k a) where
+ rnf M.Tip = ()
+ rnf (M.Bin _ k a l r) = rnf k `seq` rnf a `seq` rnf l `seq` rnf r
+
+main = do
+ let m = M.fromAscList elems :: M.Map Int Int
+ defaultMainWith
+ defaultConfig
+ (liftIO . evaluate $ rnf [m])
+ [ bench "lookup" $ nf (lookup keys) m
+ , bench "insert" $ nf (ins elems) M.empty
+ , bench "insertWith empty" $ nf (insWith elems) M.empty
+ , bench "insertWith update" $ nf (insWith elems) m
+ , bench "insertWith' empty" $ nf (insWith' elems) M.empty
+ , bench "insertWith' update" $ nf (insWith' elems) m
+ , bench "insertWithKey empty" $ nf (insWithKey elems) M.empty
+ , bench "insertWithKey update" $ nf (insWithKey elems) m
+ , bench "insertWithKey' empty" $ nf (insWithKey' elems) M.empty
+ , bench "insertWithKey' update" $ nf (insWithKey' elems) m
+ , bench "insertLookupWithKey empty" $
+ nf (insLookupWithKey elems) M.empty
+ , bench "insertLookupWithKey update" $
+ nf (insLookupWithKey elems) m
+-- , bench "insertLookupWithKey' empty" $
+-- nf (insLookupWithKey' elems) M.empty
+-- , bench "insertLookupWithKey' update" $
+-- nf (insLookupWithKey' elems) m
+ , bench "map" $ nf (M.map (+ 1)) m
+ , bench "mapWithKey" $ nf (M.mapWithKey (+)) m
+ , bench "foldlWithKey" $ nf (ins elems) m
+-- , bench "foldlWithKey'" $ nf (M.foldlWithKey' sum 0) m
+ , bench "foldrWithKey" $ nf (M.foldrWithKey consPair []) m
+ , bench "delete" $ nf (del keys) m
+ , bench "update" $ nf (upd keys) m
+ , bench "updateLookupWithKey" $ nf (upd' keys) m
+ , bench "alter" $ nf (alt keys) m
+ , bench "mapMaybe" $ nf (M.mapMaybe maybeDel) m
+ , bench "mapMaybeWithKey" $ nf (M.mapMaybeWithKey (const maybeDel)) m
+ , bench "lookupIndex" $ nf (lookupIndex keys) m
+ ]
+ where
+ elems = zip keys values
+ keys = [1..2^10]
+ values = [1..2^10]
+ sum k v1 v2 = k + v1 + v2
+ consPair k v xs = (k, v) : xs
+
+add3 :: Int -> Int -> Int -> Int
+add3 x y z = x + y + z
+{-# INLINE add3 #-}
+
+lookup :: [Int] -> M.Map Int Int -> Int
+lookup xs m = foldl' (\n k -> fromMaybe n (M.lookup k m)) 0 xs
+
+lookupIndex :: [Int] -> M.Map Int Int -> Int
+lookupIndex xs m = foldl' (\n k -> fromMaybe n (M.lookupIndex k m)) 0 xs
+
+ins :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
+ins xs m = foldl' (\m (k, v) -> M.insert k v m) m xs
+
+insWith :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
+insWith xs m = foldl' (\m (k, v) -> M.insertWith (+) k v m) m xs
+
+insWithKey :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
+insWithKey xs m = foldl' (\m (k, v) -> M.insertWithKey add3 k v m) m xs
+
+insWith' :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
+insWith' xs m = foldl' (\m (k, v) -> M.insertWith' (+) k v m) m xs
+
+insWithKey' :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
+insWithKey' xs m = foldl' (\m (k, v) -> M.insertWithKey' add3 k v m) m xs
+
+data PairS a b = PS !a !b
+
+insLookupWithKey :: [(Int, Int)] -> M.Map Int Int -> (Int, M.Map Int Int)
+insLookupWithKey xs m = let !(PS a b) = foldl' f (PS 0 m) xs in (a, b)
+ where
+ f (PS n m) (k, v) = let !(n', m') = M.insertLookupWithKey add3 k v m
+ in PS (fromMaybe 0 n' + n) m'
+
+{-
+insLookupWithKey' :: [(Int, Int)] -> M.Map Int Int -> (Int, M.Map Int Int)
+insLookupWithKey' xs m = let !(PS a b) = foldl' f (PS 0 m) xs in (a, b)
+ where
+ f (PS n m) (k, v) = let !(n', m') = M.insertLookupWithKey' add3 k v m
+ in PS (fromMaybe 0 n' + n) m'
+-}
+
+del :: [Int] -> M.Map Int Int -> M.Map Int Int
+del xs m = foldl' (\m k -> M.delete k m) m xs
+
+upd :: [Int] -> M.Map Int Int -> M.Map Int Int
+upd xs m = foldl' (\m k -> M.update Just k m) m xs
+
+upd' :: [Int] -> M.Map Int Int -> M.Map Int Int
+upd' xs m = foldl' (\m k -> snd $ M.updateLookupWithKey (\_ a -> Just a) k m) m xs
+
+alt :: [Int] -> M.Map Int Int -> M.Map Int Int
+alt xs m = foldl' (\m k -> M.alter id k m) m xs
+
+maybeDel :: Int -> Maybe Int
+maybeDel n | n `mod` 3 == 0 = Nothing
+ | otherwise = Just n
addfile ./benchmarks/Makefile
hunk ./benchmarks/Makefile 1
+package := containers
+version := $(shell awk '/^version:/{print $$2}' ../$(package).cabal)
+lib := ../dist/build/libHS$(package)-$(version).a
+
+programs := bench
+
+bench: Benchmarks.hs ../Data/Map.hs
+ ghc -DTESTING -cpp -O2 --make -fforce-recomp -i.. -o bench Benchmarks.hs
+
+.PHONY: run-bench
+run-bench: bench
+ ./bench +RTS -K10M
+
+.PHONY: clean
+clean:
+ -find . \( -name '*.o' -o -name '*.hi' \) -exec rm {} \;
+ -rm -f $(programs)
hunk ./Data/Map.hs 26
--- Journal of Functional Programming 3(4):553-562, October 1993,
--- .
+-- Journal of Functional Programming 3(4):553-562, October 1993,
+-- .
hunk ./Data/Map.hs 30
--- \"/Binary search trees of bounded balance/\",
--- SIAM journal of computing 2(1), March 1973.
+-- \"/Binary search trees of bounded balance/\",
+-- SIAM journal of computing 2(1), March 1973.
hunk ./Data/Map.hs 44
- Map -- instance Eq,Show,Read
+ Map -- instance Eq,Show,Read
hunk ./Data/Map.hs 52
-
hunk ./Data/Map.hs 66
- , insertWith, insertWithKey, insertLookupWithKey
- , insertWith', insertWithKey'
+ , insertWith
+ , insertWith'
+ , insertWithKey
+ , insertWithKey'
+ , insertLookupWithKey
hunk ./Data/Map.hs 88
- , unionsWith
+ , unionsWith
hunk ./Data/Map.hs 190
+
hunk ./Data/Map.hs 206
-{-
--- for quick check
-import qualified Prelude
-import qualified List
-import Debug.QuickCheck
-import List(nub,sort)
--}
-
hunk ./Data/Map.hs 224
+{-# INLINE (!) #-}
hunk ./Data/Map.hs 229
+{-# INLINE (\\) #-}
hunk ./Data/Map.hs 272
-null t
- = case t of
- Tip -> True
- Bin {} -> False
+null Tip = True
+null (Bin {}) = False
+{-# INLINE null #-}
hunk ./Data/Map.hs 283
-size t
- = case t of
- Tip -> 0
- Bin sz _ _ _ _ -> sz
+size Tip = 0
+size (Bin sz _ _ _ _) = sz
+{-# INLINE size #-}
hunk ./Data/Map.hs 318
-lookup k t
- = case t of
- Tip -> Nothing
- Bin _ kx x l r
- -> case compare k kx of
- LT -> lookup k l
- GT -> lookup k r
- EQ -> Just x
+lookup k = k `seq` go
+ where
+ go Tip = Nothing
+ go (Bin _ kx x l r) =
+ case compare k kx of
+ LT -> go l
+ GT -> go r
+ EQ -> Just x
+{-# INLINE lookup #-}
hunk ./Data/Map.hs 329
-lookupAssoc k t
- = case t of
- Tip -> Nothing
- Bin _ kx x l r
- -> case compare k kx of
- LT -> lookupAssoc k l
- GT -> lookupAssoc k r
- EQ -> Just (kx,x)
+lookupAssoc k = k `seq` go
+ where
+ go Tip = Nothing
+ go (Bin _ kx x l r) =
+ case compare k kx of
+ LT -> go l
+ GT -> go r
+ EQ -> Just (kx,x)
+{-# INLINE lookupAssoc #-}
hunk ./Data/Map.hs 345
-member k m
- = case lookup k m of
- Nothing -> False
- Just _ -> True
+member k m = case lookup k m of
+ Nothing -> False
+ Just _ -> True
+{-# INLINE member #-}
hunk ./Data/Map.hs 357
+{-# INLINE notMember #-}
hunk ./Data/Map.hs 361
+-- Consider using 'lookup' when elements may not be present.
hunk ./Data/Map.hs 363
-find k m
- = case lookup k m of
- Nothing -> error "Map.find: element not in the map"
- Just x -> x
+find k m = case lookup k m of
+ Nothing -> error "Map.find: element not in the map"
+ Just x -> x
+{-# INLINE find #-}
hunk ./Data/Map.hs 376
-findWithDefault def k m
- = case lookup k m of
- Nothing -> def
- Just x -> x
-
-
+findWithDefault def k m = case lookup k m of
+ Nothing -> def
+ Just x -> x
+{-# INLINE findWithDefault #-}
hunk ./Data/Map.hs 390
-empty
- = Tip
+empty = Tip
+{-# INLINE empty #-}
hunk ./Data/Map.hs 399
-singleton k x
- = Bin 1 k x Tip Tip
+singleton k x = Bin 1 k x Tip Tip
+{-# INLINE singleton #-}
hunk ./Data/Map.hs 415
-insert kx x t
- = case t of
- Tip -> singleton kx x
- Bin sz ky y l r
- -> case compare kx ky of
- LT -> balance ky y (insert kx x l) r
- GT -> balance ky y l (insert kx x r)
- EQ -> Bin sz kx x l r
+insert kx x = kx `seq` go
+ where
+ go Tip = singleton kx x
+ go (Bin sz ky y l r) =
+ case compare kx ky of
+ LT -> balance ky y (go l) r
+ GT -> balance ky y l (go r)
+ EQ -> Bin sz kx x l r
+{-# INLINE insert #-}
hunk ./Data/Map.hs 436
-insertWith f k x m
- = insertWithKey (\_ x' y' -> f x' y') k x m
+insertWith f = insertWithKey (\_ x' y' -> f x' y')
+{-# INLINE insertWith #-}
hunk ./Data/Map.hs 440
+-- This is often the most desirable behavior.
+--
+-- For example, to update a counter:
+--
+-- > insertWith' (+) k 1 m
+--
hunk ./Data/Map.hs 447
-insertWith' f k x m
- = insertWithKey' (\_ x' y' -> f x' y') k x m
-
+insertWith' f = insertWithKey' (\_ x' y' -> f x' y')
+{-# INLINE insertWith' #-}
hunk ./Data/Map.hs 463
-insertWithKey f kx x t
- = case t of
- Tip -> singleton kx x
- Bin sy ky y l r
- -> case compare kx ky of
- LT -> balance ky y (insertWithKey f kx x l) r
- GT -> balance ky y l (insertWithKey f kx x r)
- EQ -> Bin sy kx (f kx x y) l r
+insertWithKey f kx x = kx `seq` go
+ where
+ go Tip = singleton kx x
+ go (Bin sy ky y l r) =
+ case compare kx ky of
+ LT -> balance ky y (go l) r
+ GT -> balance ky y l (go r)
+ EQ -> Bin sy kx (f kx x y) l r
+{-# INLINE insertWithKey #-}
hunk ./Data/Map.hs 475
-insertWithKey' f kx x t
- = case t of
- Tip -> singleton kx $! x
- Bin sy ky y l r
- -> case compare kx ky of
- LT -> balance ky y (insertWithKey' f kx x l) r
- GT -> balance ky y l (insertWithKey' f kx x r)
- EQ -> let x' = f kx x y in seq x' (Bin sy kx x' l r)
-
+insertWithKey' f kx x = kx `seq` go
+ where
+ go Tip = singleton kx $! x
+ go (Bin sy ky y l r) =
+ case compare kx ky of
+ LT -> balance ky y (go l) r
+ GT -> balance ky y l (go r)
+ EQ -> let x' = f kx x y in seq x' (Bin sy kx x' l r)
+{-# INLINE insertWithKey' #-}
hunk ./Data/Map.hs 501
-insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a,Map k a)
-insertLookupWithKey f kx x t
- = case t of
- Tip -> (Nothing, singleton kx x)
- Bin sy ky y l r
- -> case compare kx ky of
- LT -> let (found,l') = insertLookupWithKey f kx x l in (found,balance ky y l' r)
- GT -> let (found,r') = insertLookupWithKey f kx x r in (found,balance ky y l r')
- EQ -> (Just y, Bin sy kx (f kx x y) l r)
+insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a
+ -> (Maybe a, Map k a)
+insertLookupWithKey f kx x = kx `seq` go
+ where
+ go Tip = (Nothing, singleton kx x)
+ go (Bin sy ky y l r) =
+ case compare kx ky of
+ LT -> let (found, l') = go l
+ in (found, balance ky y l' r)
+ GT -> let (found, r') = go r
+ in (found, balance ky y l r')
+ EQ -> (Just y, Bin sy kx (f kx x y) l r)
+{-# INLINE insertLookupWithKey #-}
+
+{-
+-- | /O(log n)/. A strict version of 'insertLookupWithKey'.
+insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a
+ -> (Maybe a, Map k a)
+insertLookupWithKey' f kx x = kx `seq` go
+ where
+ go Tip = x `seq` (Nothing, singleton kx x)
+ go (Bin sy ky y l r) =
+ case compare kx ky of
+ LT -> let (found, l') = go l
+ in (found, balance ky y l' r)
+ GT -> let (found, r') = go r
+ in (found, balance ky y l r')
+ EQ -> let x' = f kx x y in x' `seq` (Just y, Bin sy kx x' l r)
+{-# INLINE insertLookupWithKey' #-}
+-}
hunk ./Data/Map.hs 544
-delete k t
- = case t of
- Tip -> Tip
- Bin _ kx x l r
- -> case compare k kx of
- LT -> balance kx x (delete k l) r
- GT -> balance kx x l (delete k r)
- EQ -> glue l r
+delete k = k `seq` go
+ where
+ go Tip = Tip
+ go (Bin _ kx x l r) =
+ case compare k kx of
+ LT -> balance kx x (go l) r
+ GT -> balance kx x l (go r)
+ EQ -> glue l r
+{-# INLINE delete #-}
hunk ./Data/Map.hs 563
-adjust f k m
- = adjustWithKey (\_ x -> f x) k m
+adjust f = adjustWithKey (\_ x -> f x)
+{-# INLINE adjust #-}
hunk ./Data/Map.hs 575
-adjustWithKey f k m
- = updateWithKey (\k' x' -> Just (f k' x')) k m
+adjustWithKey f = updateWithKey (\k' x' -> Just (f k' x'))
+{-# INLINE adjustWithKey #-}
hunk ./Data/Map.hs 588
-update f k m
- = updateWithKey (\_ x -> f x) k m
+update f = updateWithKey (\_ x -> f x)
+{-# INLINE update #-}
hunk ./Data/Map.hs 602
-updateWithKey f k t
- = case t of
- Tip -> Tip
- Bin sx kx x l r
- -> case compare k kx of
- LT -> balance kx x (updateWithKey f k l) r
- GT -> balance kx x l (updateWithKey f k r)
- EQ -> case f kx x of
- Just x' -> Bin sx kx x' l r
- Nothing -> glue l r
+updateWithKey f k = k `seq` go
+ where
+ go Tip = Tip
+ go (Bin sx kx x l r) =
+ case compare k kx of
+ LT -> balance kx x (go l) r
+ GT -> balance kx x l (go r)
+ EQ -> case f kx x of
+ Just x' -> Bin sx kx x' l r
+ Nothing -> glue l r
+{-# INLINE updateWithKey #-}
hunk ./Data/Map.hs 624
-updateLookupWithKey f k t
- = case t of
- Tip -> (Nothing,Tip)
- Bin sx kx x l r
- -> case compare k kx of
- LT -> let (found,l') = updateLookupWithKey f k l in (found,balance kx x l' r)
- GT -> let (found,r') = updateLookupWithKey f k r in (found,balance kx x l r')
+updateLookupWithKey f k = k `seq` go
+ where
+ go Tip = (Nothing,Tip)
+ go (Bin sx kx x l r) =
+ case compare k kx of
+ LT -> let (found,l') = go l in (found,balance kx x l' r)
+ GT -> let (found,r') = go r in (found,balance kx x l r')
hunk ./Data/Map.hs 634
+{-# INLINE updateLookupWithKey #-}
hunk ./Data/Map.hs 649
-alter f k t
- = case t of
- Tip -> case f Nothing of
+alter f k = k `seq` go
+ where
+ go Tip = case f Nothing of
hunk ./Data/Map.hs 653
- Just x -> singleton k x
- Bin sx kx x l r
- -> case compare k kx of
- LT -> balance kx x (alter f k l) r
- GT -> balance kx x l (alter f k r)
+ Just x -> singleton k x
+
+ go (Bin sx kx x l r) = case compare k kx of
+ LT -> balance kx x (go l) r
+ GT -> balance kx x l (go r)
hunk ./Data/Map.hs 661
+{-# INLINE alter #-}
hunk ./Data/Map.hs 680
+{-# INLINE findIndex #-}
hunk ./Data/Map.hs 691
-lookupIndex k t = f 0 t
+lookupIndex k = k `seq` go 0
hunk ./Data/Map.hs 693
- f _ Tip = Nothing
- f idx (Bin _ kx _ l r)
- = case compare k kx of
- LT -> f idx l
- GT -> f (idx + size l + 1) r
+ go idx Tip = idx `seq` Nothing
+ go idx (Bin _ kx _ l r)
+ = idx `seq` case compare k kx of
+ LT -> go idx l
+ GT -> go (idx + size l + 1) r
hunk ./Data/Map.hs 699
+{-# INLINE lookupIndex #-}
hunk ./Data/Map.hs 732
-updateAt f i (Bin sx kx x l r)
- = case compare i sizeL of
- LT -> balance kx x (updateAt f i l) r
- GT -> balance kx x l (updateAt f (i-sizeL-1) r)
+updateAt f i t = i `seq` go i t
+ where
+ go i (Bin sx kx x l r) = case compare i sizeL of
+ LT -> balance kx x (go i l) r
+ GT -> balance kx x l (go (i-sizeL-1) r)
hunk ./Data/Map.hs 740
- where
- sizeL = size l
+ where
+ sizeL = size l
+{-# INLINE updateAt #-}
hunk ./Data/Map.hs 755
+{-# INLINE deleteAt #-}
hunk ./Data/Map.hs 809
+{-# INLINE updateMin #-}
hunk ./Data/Map.hs 819
+{-# INLINE updateMax #-}
hunk ./Data/Map.hs 828
-updateMinWithKey f t
- = case t of
- Bin sx kx x Tip r -> case f kx x of
- Nothing -> r
- Just x' -> Bin sx kx x' Tip r
- Bin _ kx x l r -> balance kx x (updateMinWithKey f l) r
- Tip -> Tip
+updateMinWithKey f = go
+ where
+ go (Bin sx kx x Tip r) = case f kx x of
+ Nothing -> r
+ Just x' -> Bin sx kx x' Tip r
+ go (Bin _ kx x l r) = balance kx x (go l) r
+ go Tip = Tip
+{-# INLINE updateMinWithKey #-}
hunk ./Data/Map.hs 843
-updateMaxWithKey f t
- = case t of
- Bin sx kx x l Tip -> case f kx x of
+updateMaxWithKey f = go
+ where
+ go (Bin sx kx x l Tip) = case f kx x of
hunk ./Data/Map.hs 848
- Bin _ kx x l r -> balance kx x l (updateMaxWithKey f r)
- Tip -> Tip
+ go (Bin _ kx x l r) = balance kx x l (go r)
+ go Tip = Tip
+{-# INLINE updateMaxWithKey #-}
hunk ./Data/Map.hs 860
-minViewWithKey x = Just (deleteFindMin x)
+minViewWithKey x = Just (deleteFindMin x)
hunk ./Data/Map.hs 870
-maxViewWithKey x = Just (deleteFindMax x)
+maxViewWithKey x = Just (deleteFindMax x)
hunk ./Data/Map.hs 881
-minView x = Just (first snd $ deleteFindMin x)
+minView x = Just (first snd $ deleteFindMin x)
hunk ./Data/Map.hs 891
-maxView x = Just (first snd $ deleteFindMax x)
+maxView x = Just (first snd $ deleteFindMax x)
hunk ./Data/Map.hs 896
+{-# INLINE first #-}
hunk ./Data/Map.hs 912
+{-# INLINE unions #-}
hunk ./Data/Map.hs 923
+{-# INLINE unionsWith #-}
hunk ./Data/Map.hs 938
+{-# INLINE union #-}
hunk ./Data/Map.hs 954
-{-
-XXX unused code
-
--- right-biased hedge union
-hedgeUnionR :: Ord a
- => (a -> Ordering) -> (a -> Ordering) -> Map a b -> Map a b
- -> Map a b
-hedgeUnionR _ _ t1 Tip
- = t1
-hedgeUnionR cmplo cmphi Tip (Bin _ kx x l r)
- = join kx x (filterGt cmplo l) (filterLt cmphi r)
-hedgeUnionR cmplo cmphi (Bin _ kx x l r) t2
- = join kx newx (hedgeUnionR cmplo cmpkx l lt)
- (hedgeUnionR cmpkx cmphi r gt)
- where
- cmpkx k = compare kx k
- lt = trim cmplo cmpkx t2
- (found,gt) = trimLookupLo kx cmphi t2
- newx = case found of
- Nothing -> x
- Just (_,y) -> y
--}
-
hunk ./Data/Map.hs 964
+{-# INLINE unionWith #-}
hunk ./Data/Map.hs 977
+{-# INLINE unionWithKey #-}
hunk ./Data/Map.hs 1012
+{-# INLINE difference #-}
hunk ./Data/Map.hs 1041
+{-# INLINE differenceWith #-}
hunk ./Data/Map.hs 1057
+{-# INLINE differenceWithKey #-}
hunk ./Data/Map.hs 1096
+{-# INLINE intersection #-}
hunk ./Data/Map.hs 1105
+{-# INLINE intersectionWith #-}
hunk ./Data/Map.hs 1156
-isSubmapOf m1 m2
- = isSubmapOfBy (==) m1 m2
+isSubmapOf m1 m2 = isSubmapOfBy (==) m1 m2
+{-# INLINE isSubmapOf #-}
hunk ./Data/Map.hs 1180
+{-# INLINE isSubmapOfBy #-}
hunk ./Data/Map.hs 1197
+{-# INLINE isProperSubmapOf #-}
hunk ./Data/Map.hs 1220
+{-# INLINE isProperSubmapOfBy #-}
hunk ./Data/Map.hs 1234
+{-# INLINE filter #-}
hunk ./Data/Map.hs 1241
-filterWithKey _ Tip = Tip
-filterWithKey p (Bin _ kx x l r)
- | p kx x = join kx x (filterWithKey p l) (filterWithKey p r)
- | otherwise = merge (filterWithKey p l) (filterWithKey p r)
-
+filterWithKey p = go
+ where
+ go Tip = Tip
+ go (Bin _ kx x l r)
+ | p kx x = join kx x (go l) (go r)
+ | otherwise = merge (go l) (go r)
+{-# INLINE filterWithKey #-}
hunk ./Data/Map.hs 1260
+{-# INLINE partition #-}
hunk ./Data/Map.hs 1285
-mapMaybe f m
- = mapMaybeWithKey (\_ x -> f x) m
+mapMaybe f = mapMaybeWithKey (\_ x -> f x)
+{-# INLINE mapMaybe #-}
hunk ./Data/Map.hs 1294
-mapMaybeWithKey _ Tip = Tip
-mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
- Just y -> join kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
- Nothing -> merge (mapMaybeWithKey f l) (mapMaybeWithKey f r)
+mapMaybeWithKey f = go
+ where
+ go Tip = Tip
+ go (Bin _ kx x l r) = case f kx x of
+ Just y -> join kx y (go l) (go r)
+ Nothing -> merge (go l) (go r)
+{-# INLINE mapMaybeWithKey #-}
hunk ./Data/Map.hs 1314
+{-# INLINE mapEither #-}
hunk ./Data/Map.hs 1343
-map f m
- = mapWithKey (\_ x -> f x) m
+map f = mapWithKey (\_ x -> f x)
+{-# INLINE map #-}
hunk ./Data/Map.hs 1352
-mapWithKey _ Tip = Tip
-mapWithKey f (Bin sx kx x l r)
- = Bin sx kx (f kx x) (mapWithKey f l) (mapWithKey f r)
+mapWithKey f = go
+ where
+ go Tip = Tip
+ go (Bin sx kx x l r) = Bin sx kx (f kx x) (go l) (go r)
+{-# INLINE mapWithKey #-}
hunk ./Data/Map.hs 1367
+{-# INLINE mapAccum #-}
hunk ./Data/Map.hs 1378
+{-# INLINE mapAccumWithKey #-}
hunk ./Data/Map.hs 1383
-mapAccumL f a t
- = case t of
- Tip -> (a,Tip)
- Bin sx kx x l r
- -> let (a1,l') = mapAccumL f a l
- (a2,x') = f a1 kx x
- (a3,r') = mapAccumL f a2 r
- in (a3,Bin sx kx x' l' r')
+mapAccumL f = go
+ where
+ go a Tip = (a,Tip)
+ go a (Bin sx kx x l r) =
+ let (a1,l') = go a l
+ (a2,x') = f a1 kx x
+ (a3,r') = go a2 r
+ in (a3,Bin sx kx x' l' r')
+{-# INLINE mapAccumL #-}
hunk ./Data/Map.hs 1396
-mapAccumRWithKey f a t
- = case t of
- Tip -> (a,Tip)
- Bin sx kx x l r
- -> let (a1,r') = mapAccumRWithKey f a r
- (a2,x') = f a1 kx x
- (a3,l') = mapAccumRWithKey f a2 l
- in (a3,Bin sx kx x' l' r')
+mapAccumRWithKey f = go
+ where
+ go a Tip = (a,Tip)
+ go a (Bin sx kx x l r) =
+ let (a1,r') = go a r
+ (a2,x') = f a1 kx x
+ (a3,l') = go a2 l
+ in (a3,Bin sx kx x' l' r')
+{-# INLINE mapAccumRWithKey #-}
hunk ./Data/Map.hs 1419
+{-# INLINE mapKeys #-}
hunk ./Data/Map.hs 1458
+{-# INLINE mapKeysMonotonic #-}
hunk ./Data/Map.hs 1472
-
hunk ./Data/Map.hs 1473
-fold f z m
- = foldWithKey (\_ x' z' -> f x' z') z m
+fold f = foldWithKey (\_ x' z' -> f x' z')
+{-# DEPRECATED fold "Use foldrWithKey instead" #-}
+{-# INLINE fold #-}
hunk ./Data/Map.hs 1488
-
hunk ./Data/Map.hs 1489
-foldWithKey f z t
- = foldrWithKey f z t
-
-{-
-XXX unused code
-
--- | /O(n)/. In-order fold.
-foldi :: (k -> a -> b -> b -> b) -> b -> Map k a -> b
-foldi _ z Tip = z
-foldi f z (Bin _ kx x l r) = f kx x (foldi f z l) (foldi f z r)
--}
+foldWithKey = foldrWithKey
+{-# DEPRECATED foldWithKey "Use foldrWithKey instead" #-}
+{-# INLINE foldWithKey #-}
hunk ./Data/Map.hs 1496
-foldrWithKey _ z Tip = z
-foldrWithKey f z (Bin _ kx x l r) =
- foldrWithKey f (f kx x (foldrWithKey f z r)) l
-
+foldrWithKey f = go
+ where
+ go z Tip = z
+ go z (Bin _ kx x l r) = go (f kx x (go z r)) l
+{-# INLINE foldrWithKey #-}
hunk ./Data/Map.hs 1505
-foldlWithKey _ z Tip = z
-foldlWithKey f z (Bin _ kx x l r) =
- foldlWithKey f (f (foldlWithKey f z l) kx x) r
+foldlWithKey f = go
+ where
+ go z Tip = z
+ go z (Bin _ kx x l r) = go (f (go z l) kx x) r
+{-# INLINE foldlWithKey #-}
+
+{-
+-- | /O(n)/. A strict version of 'foldlWithKey'.
+foldlWithKey' :: (b -> k -> a -> b) -> b -> Map k a -> b
+foldlWithKey' f = go
+ where
+ go z Tip = z
+ go z (Bin _ kx x l r) = z `seq` go (f (go z l) kx x) r
+{-# INLINE foldlWithKey' #-}
+-}
hunk ./Data/Map.hs 1559
+{-# INLINE assocs #-}
hunk ./Data/Map.hs 1578
+{-# INLINE fromList #-}
hunk ./Data/Map.hs 1588
+{-# INLINE fromListWith #-}
hunk ./Data/Map.hs 1601
+{-# INLINE fromListWithKey #-}
hunk ./Data/Map.hs 1610
+{-# INLINE toList #-}
hunk ./Data/Map.hs 1618
+{-# INLINE toAscList #-}
hunk ./Data/Map.hs 1623
+{-# INLINE toDescList #-}
hunk ./Data/Map.hs 1643
+{-# INLINE fromAscList #-}
hunk ./Data/Map.hs 1655
+{-# INLINE fromAscListWith #-}
hunk ./Data/Map.hs 1681
+{-# INLINE fromAscListWithKey #-}
hunk ./Data/Map.hs 1760
-filterGt _ Tip = Tip
-filterGt cmp (Bin _ kx x l r)
- = case cmp kx of
- LT -> join kx x (filterGt cmp l) r
- GT -> filterGt cmp r
- EQ -> r
-
+filterGt cmp = go
+ where
+ go Tip = Tip
+ go (Bin _ kx x l r) = case cmp kx of
+ LT -> join kx x (go l) r
+ GT -> go r
+ EQ -> r
+{-# INLINE filterGt #-}
+
hunk ./Data/Map.hs 1770
-filterLt _ Tip = Tip
-filterLt cmp (Bin _ kx x l r)
- = case cmp kx of
- LT -> filterLt cmp l
- GT -> join kx x l (filterLt cmp r)
- EQ -> l
+filterLt cmp = go
+ where
+ go Tip = Tip
+ go (Bin _ kx x l r) = case cmp kx of
+ LT -> go l
+ GT -> join kx x l (go r)
+ EQ -> l
+{-# INLINE filterLt #-}
hunk ./Data/Map.hs 1793
-split _ Tip = (Tip,Tip)
-split k (Bin _ kx x l r)
- = case compare k kx of
- LT -> let (lt,gt) = split k l in (lt,join kx x gt r)
- GT -> let (lt,gt) = split k r in (join kx x l lt,gt)
- EQ -> (l,r)
+split k = go
+ where
+ go Tip = (Tip, Tip)
+ go (Bin _ kx x l r) = case compare k kx of
+ LT -> let (lt,gt) = go l in (lt,join kx x gt r)
+ GT -> let (lt,gt) = go r in (join kx x l lt,gt)
+ EQ -> (l,r)
+{-# INLINE split #-}
hunk ./Data/Map.hs 1812
-splitLookup _ Tip = (Tip,Nothing,Tip)
-splitLookup k (Bin _ kx x l r)
- = case compare k kx of
- LT -> let (lt,z,gt) = splitLookup k l in (lt,z,join kx x gt r)
- GT -> let (lt,z,gt) = splitLookup k r in (join kx x l lt,z,gt)
+splitLookup k = go
+ where
+ go Tip = (Tip,Nothing,Tip)
+ go (Bin _ kx x l r) = case compare k kx of
+ LT -> let (lt,z,gt) = go l in (lt,z,join kx x gt r)
+ GT -> let (lt,z,gt) = go r in (join kx x l lt,z,gt)
hunk ./Data/Map.hs 1819
+{-# INLINE splitLookup #-}
hunk ./Data/Map.hs 1823
-splitLookupWithKey _ Tip = (Tip,Nothing,Tip)
-splitLookupWithKey k (Bin _ kx x l r)
- = case compare k kx of
- LT -> let (lt,z,gt) = splitLookupWithKey k l in (lt,z,join kx x gt r)
- GT -> let (lt,z,gt) = splitLookupWithKey k r in (join kx x l lt,z,gt)
+splitLookupWithKey k = go
+ where
+ go Tip = (Tip,Nothing,Tip)
+ go (Bin _ kx x l r) = case compare k kx of
+ LT -> let (lt,z,gt) = go l in (lt,z,join kx x gt r)
+ GT -> let (lt,z,gt) = go r in (join kx x l lt,z,gt)
hunk ./Data/Map.hs 1830
-
-{-
-XXX unused code
-
--- | /O(log n)/. Performs a 'split' but also returns whether the pivot
--- element was found in the original set.
-splitMember :: Ord k => k -> Map k a -> (Map k a,Bool,Map k a)
-splitMember x t = let (l,m,r) = splitLookup x t in
- (l,maybe False (const True) m,r)
--}
+{-# INLINE splitLookupWithKey #-}
hunk ./Data/Map.hs 2064
-{-
-XXX unused code
-
--- parses a pair of things with the syntax a:=b
-readPair :: (Read a, Read b) => ReadS (a,b)
-readPair s = do (a, ct1) <- reads s
- (":=", ct2) <- lex ct1
- (b, ct3) <- reads ct2
- return ((a,b), ct3)
--}
-
hunk ./Data/Map.hs 2071
-{-
-XXX unused code
-
-showMap :: (Show k,Show a) => [(k,a)] -> ShowS
-showMap []
- = showString "{}"
-showMap (x:xs)
- = showChar '{' . showElem x . showTail xs
- where
- showTail [] = showChar '}'
- showTail (x':xs') = showString ", " . showElem x' . showTail xs'
-
- showElem (k,x') = shows k . showString " := " . shows x'
--}
-
hunk ./Data/Map.hs 2216
-foldlStrict f z xs
- = case xs of
- [] -> z
- (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
-
-
-{-
-{--------------------------------------------------------------------
- Testing
---------------------------------------------------------------------}
-testTree xs = fromList [(x,"*") | x <- xs]
-test1 = testTree [1..20]
-test2 = testTree [30,29..10]
-test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
-
-{--------------------------------------------------------------------
- QuickCheck
---------------------------------------------------------------------}
-qcheck prop
- = check config prop
+foldlStrict f = go
hunk ./Data/Map.hs 2218
- config = Config
- { configMaxTest = 500
- , configMaxFail = 5000
- , configSize = \n -> (div n 2 + 3)
- , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
- }
+ go z [] = z
+ go z (x:xs) = z `seq` go (f z x) xs
+{-# INLINE foldlStrict #-}
hunk ./Data/Map.hs 2223
-{--------------------------------------------------------------------
- Arbitrary, reasonably balanced trees
---------------------------------------------------------------------}
-instance (Enum k,Arbitrary a) => Arbitrary (Map k a) where
- arbitrary = sized (arbtree 0 maxkey)
- where maxkey = 10000
-
-arbtree :: (Enum k,Arbitrary a) => Int -> Int -> Int -> Gen (Map k a)
-arbtree lo hi n
- | n <= 0 = return Tip
- | lo >= hi = return Tip
- | otherwise = do{ x <- arbitrary
- ; i <- choose (lo,hi)
- ; m <- choose (1,30)
- ; let (ml,mr) | m==(1::Int)= (1,2)
- | m==2 = (2,1)
- | m==3 = (1,1)
- | otherwise = (2,2)
- ; l <- arbtree lo (i-1) (n `div` ml)
- ; r <- arbtree (i+1) hi (n `div` mr)
- ; return (bin (toEnum i) x l r)
- }
-
-
-{--------------------------------------------------------------------
- Valid tree's
---------------------------------------------------------------------}
-forValid :: (Show k,Enum k,Show a,Arbitrary a,Testable b) => (Map k a -> b) -> Property
-forValid f
- = forAll arbitrary $ \t ->
--- classify (balanced t) "balanced" $
- classify (size t == 0) "empty" $
- classify (size t > 0 && size t <= 10) "small" $
- classify (size t > 10 && size t <= 64) "medium" $
- classify (size t > 64) "large" $
- balanced t ==> f t
-
-forValidIntTree :: Testable a => (Map Int Int -> a) -> Property
-forValidIntTree f
- = forValid f
-
-forValidUnitTree :: Testable a => (Map Int () -> a) -> Property
-forValidUnitTree f
- = forValid f
-
-
-prop_Valid
- = forValidUnitTree $ \t -> valid t
-
-{--------------------------------------------------------------------
- Single, Insert, Delete
---------------------------------------------------------------------}
-prop_Single :: Int -> Int -> Bool
-prop_Single k x
- = (insert k x empty == singleton k x)
-
-prop_InsertValid :: Int -> Property
-prop_InsertValid k
- = forValidUnitTree $ \t -> valid (insert k () t)
-
-prop_InsertDelete :: Int -> Map Int () -> Property
-prop_InsertDelete k t
- = (lookup k t == Nothing) ==> delete k (insert k () t) == t
-
-prop_DeleteValid :: Int -> Property
-prop_DeleteValid k
- = forValidUnitTree $ \t ->
- valid (delete k (insert k () t))
-
-{--------------------------------------------------------------------
- Balance
---------------------------------------------------------------------}
-prop_Join :: Int -> Property
-prop_Join k
- = forValidUnitTree $ \t ->
- let (l,r) = split k t
- in valid (join k () l r)
-
-prop_Merge :: Int -> Property
-prop_Merge k
- = forValidUnitTree $ \t ->
- let (l,r) = split k t
- in valid (merge l r)
-
-
-{--------------------------------------------------------------------
- Union
---------------------------------------------------------------------}
-prop_UnionValid :: Property
-prop_UnionValid
- = forValidUnitTree $ \t1 ->
- forValidUnitTree $ \t2 ->
- valid (union t1 t2)
-
-prop_UnionInsert :: Int -> Int -> Map Int Int -> Bool
-prop_UnionInsert k x t
- = union (singleton k x) t == insert k x t
-
-prop_UnionAssoc :: Map Int Int -> Map Int Int -> Map Int Int -> Bool
-prop_UnionAssoc t1 t2 t3
- = union t1 (union t2 t3) == union (union t1 t2) t3
-
-prop_UnionComm :: Map Int Int -> Map Int Int -> Bool
-prop_UnionComm t1 t2
- = (union t1 t2 == unionWith (\x y -> y) t2 t1)
-
-prop_UnionWithValid
- = forValidIntTree $ \t1 ->
- forValidIntTree $ \t2 ->
- valid (unionWithKey (\k x y -> x+y) t1 t2)
-
-prop_UnionWith :: [(Int,Int)] -> [(Int,Int)] -> Bool
-prop_UnionWith xs ys
- = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
- == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
-
-prop_DiffValid
- = forValidUnitTree $ \t1 ->
- forValidUnitTree $ \t2 ->
- valid (difference t1 t2)
-
-prop_Diff :: [(Int,Int)] -> [(Int,Int)] -> Bool
-prop_Diff xs ys
- = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
- == List.sort ((List.\\) (nub (Prelude.map fst xs)) (nub (Prelude.map fst ys)))
-
-prop_IntValid
- = forValidUnitTree $ \t1 ->
- forValidUnitTree $ \t2 ->
- valid (intersection t1 t2)
-
-prop_Int :: [(Int,Int)] -> [(Int,Int)] -> Bool
-prop_Int xs ys
- = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
- == List.sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
-
-{--------------------------------------------------------------------
- Lists
---------------------------------------------------------------------}
-prop_Ordered
- = forAll (choose (5,100)) $ \n ->
- let xs = [(x,()) | x <- [0..n::Int]]
- in fromAscList xs == fromList xs
-
-prop_List :: [Int] -> Bool
-prop_List xs
- = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
--}
hunk ./Data/Map.hs 71
+ , insertLookupWithKey'
hunk ./Data/Map.hs 117
+ , foldlWithKey'
hunk ./Data/Map.hs 517
-{-
hunk ./Data/Map.hs 531
--}
hunk ./Data/Map.hs 1511
-{-
hunk ./Data/Map.hs 1518
--}
hunk ./benchmarks/Benchmarks.hs 37
--- , bench "insertLookupWithKey' empty" $
--- nf (insLookupWithKey' elems) M.empty
--- , bench "insertLookupWithKey' update" $
--- nf (insLookupWithKey' elems) m
+ , bench "insertLookupWithKey' empty" $
+ nf (insLookupWithKey' elems) M.empty
+ , bench "insertLookupWithKey' update" $
+ nf (insLookupWithKey' elems) m
hunk ./benchmarks/Benchmarks.hs 44
--- , bench "foldlWithKey'" $ nf (M.foldlWithKey' sum 0) m
+ , bench "foldlWithKey'" $ nf (M.foldlWithKey' sum 0) m
hunk ./benchmarks/Benchmarks.hs 94
-{-
hunk ./benchmarks/Benchmarks.hs 99
--}
hunk ./tests/map-properties.hs 74
--- q $ label "prop_foldl'" prop_foldl'
+ q $ label "prop_foldl'" prop_foldl'
hunk ./tests/map-properties.hs 367
-{-
hunk ./tests/map-properties.hs 372
--}
hunk ./tests/map-properties.hs 413
--- , testCase "insertLookupWithKey'" test_insertLookupWithKey'
+ , testCase "insertLookupWithKey'" test_insertLookupWithKey'
hunk ./tests/map-properties.hs 643
-{-
hunk ./tests/map-properties.hs 651
--}
hunk ./containers.cabal 2
-version: 0.3.0.0
+version: 0.4.0.0
hunk ./Data/Map.hs 731
-updateAt _ _ Tip = error "Map.updateAt: index out of range"
hunk ./Data/Map.hs 733
+ go _ Tip = error "Map.updateAt: index out of range"
hunk ./tests/map-properties.hs 1051
+-- updateAt (\_ _ -> Nothing) 7 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
hunk ./containers.cabal 24
+ ghc-options: -O2
+ if impl(ghc>6.10)
+ Ghc-Options: -fregs-graph
addfile ./tests/intmap-properties.hs
hunk ./tests/intmap-properties.hs 1
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+--
+-- QuickCheck properties for Data.IntMap
+-- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i.. intmap-properties.hs
+
+import Data.IntMap
+import Data.Monoid
+import Data.Maybe hiding (mapMaybe)
+import Data.Ord
+import Data.Function
+import Test.QuickCheck
+import Text.Show.Functions
+import Prelude hiding (lookup, null, map ,filter)
+import qualified Prelude (map, filter)
+import qualified Data.List as List
+
+import Control.Applicative ((<$>),(<*>))
+import Data.List (nub,sort)
+import qualified Data.List as L ((\\),intersect)
+import qualified Data.IntSet
+import Data.Maybe (isJust,fromJust)
+import Prelude hiding (lookup,map,filter,null)
+import qualified Prelude as P (map)
+import Test.Framework (defaultMain, testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2
+import Test.HUnit hiding (Test, Testable)
+import Test.QuickCheck
+
+type Map = IntMap
+
+main = do
+-- q $ label "prop_Valid" prop_Valid
+ q $ label "prop_Single" prop_Single
+-- q $ label "prop_InsertValid" prop_InsertValid
+ q $ label "prop_InsertDelete" prop_InsertDelete
+-- q $ label "prop_DeleteValid" prop_DeleteValid
+-- q $ label "prop_Join" prop_Join
+-- q $ label "prop_Merge" prop_Merge
+-- q $ label "prop_UnionValid" prop_UnionValid
+ q $ label "prop_UnionInsert" prop_UnionInsert
+ q $ label "prop_UnionAssoc" prop_UnionAssoc
+ q $ label "prop_UnionComm" prop_UnionComm
+-- q $ label "prop_UnionWithValid" prop_UnionWithValid
+ q $ label "prop_UnionWith" prop_UnionWith
+-- q $ label "prop_DiffValid" prop_DiffValid
+ q $ label "prop_Diff" prop_Diff
+ q $ label "prop_Diff2" prop_Diff2
+-- q $ label "prop_IntValid" prop_IntValid
+ q $ label "prop_Int" prop_Int
+ q $ label "prop_Ordered" prop_Ordered
+ q $ label "prop_List" prop_List
+
+ -- new tests
+ q $ label "prop_index" prop_index
+ q $ label "prop_null" prop_null
+ q $ label "prop_member" prop_member
+ q $ label "prop_notmember" prop_notmember
+ q $ label "prop_findWithDefault" prop_findWithDefault
+-- q $ label "prop_findIndex" prop_findIndex
+ q $ label "prop_findMin" prop_findMin
+ q $ label "prop_findMax" prop_findMax
+ q $ label "prop_filter" prop_filter
+ q $ label "prop_partition" prop_partition
+ q $ label "prop_map" prop_map
+ q $ label "prop_fmap" prop_fmap
+-- q $ label "prop_mapkeys" prop_mapkeys
+-- q $ label "prop_foldr" prop_foldr
+-- q $ label "prop_foldl" prop_foldl
+-- q $ label "prop_foldl'" prop_foldl'
+ q $ label "prop_fold" prop_fold
+ q $ label "prop_folWithKeyd" prop_foldWithKey
+
+ defaultMain tests
+
+ where
+ q :: Testable prop => prop -> IO ()
+ q = quickCheckWith args
+
+
+{--------------------------------------------------------------------
+ Testing
+--------------------------------------------------------------------}
+testTree xs = fromList [(x,"*") | x <- xs]
+test1 = testTree [1..20]
+test2 = testTree [30,29..10]
+test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
+
+
+{--------------------------------------------------------------------
+ QuickCheck
+--------------------------------------------------------------------}
+
+args = stdArgs {
+ maxSuccess = 500
+ , maxDiscard = 500
+ }
+
+{-
+qcheck prop
+ = check config prop
+ where
+ config = Config
+ { configMaxTest = 500
+ , configMaxFail = 5000
+ , configSize = \n -> (div n 2 + 3)
+ , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
+ }
+-}
+
+
+{--------------------------------------------------------------------
+ Arbitrary, reasonably balanced trees
+--------------------------------------------------------------------}
+-- instance (Arbitrary a) => Arbitrary (IntMap a) where
+-- arbitrary = sized (arbtree 0 maxkey)
+-- where maxkey = 10^5
+
+instance Arbitrary a => Arbitrary (IntMap a) where
+ arbitrary = do{ ks <- arbitrary
+ ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks
+ ; return (fromList xs)
+ }
+
+
+{-
+--
+-- requires access to internals
+--
+
+arbtree :: (Arbitrary a) => Int -> Int -> Int -> Gen (IntMap a)
+arbtree lo hi n
+ | n <= 0 = return empty
+ | lo >= hi = return empty
+ | otherwise = do{ x <- arbitrary
+ ; i <- choose (lo,hi)
+ ; m <- choose (1,70)
+ ; let (ml,mr) | m==(1::Int)= (1,2)
+ | m==2 = (2,1)
+ | m==3 = (1,1)
+ | otherwise = (2,2)
+ ; l <- arbtree lo (i-1) (n `div` ml)
+ ; r <- arbtree (i+1) hi (n `div` mr)
+ ; return (unions [singleton (toEnum i) x, l, r ])
+ }
+-}
+
+
+{--------------------------------------------------------------------
+ Valid tree's
+--------------------------------------------------------------------}
+forValid :: (Show a,Arbitrary a,Testable b) => (Map a -> b) -> Property
+forValid f
+ = forAll arbitrary $ \t ->
+-- classify (balanced t) "balanced" $
+ classify (size t == 0) "empty" $
+ classify (size t > 0 && size t <= 10) "small" $
+ classify (size t > 10 && size t <= 64) "medium" $
+ classify (size t > 64) "large" $
+ {-balanced t ==>-} f t
+
+forValidIntTree :: Testable a => (Map Int -> a) -> Property
+forValidIntTree f
+ = forValid f
+
+forValidUnitTree :: Testable a => (Map () -> a) -> Property
+forValidUnitTree f
+ = forValid f
+
+
+-- prop_Valid
+-- = forValidUnitTree $ \t -> valid t
+
+{--------------------------------------------------------------------
+ Single, Insert, Delete
+--------------------------------------------------------------------}
+prop_Single :: Int -> Int -> Bool
+prop_Single k x
+ = (insert k x empty == singleton k x)
+
+-- prop_InsertValid :: Int -> Property
+-- prop_InsertValid k
+-- = forValidUnitTree $ \t -> valid (insert k () t)
+
+prop_InsertDelete :: Int -> Map () -> Property
+prop_InsertDelete k t
+ = (lookup k t == Nothing) ==> delete k (insert k () t) == t
+
+-- prop_DeleteValid :: Int -> Property
+-- prop_DeleteValid k
+-- = forValidUnitTree $ \t ->
+-- valid (delete k (insert k () t))
+
+{--------------------------------------------------------------------
+ Balance
+--------------------------------------------------------------------}
+
+{-
+prop_Join :: Int -> Property
+prop_Join k
+ = forValidUnitTree $ \t ->
+ let (l,r) = split k t
+ in valid (join k () l r)
+-}
+
+{-
+prop_Merge :: Int -> Property
+prop_Merge k
+ = forValidUnitTree $ \t ->
+ let (l,r) = split k t
+ in valid (merge l r)
+-}
+
+
+{--------------------------------------------------------------------
+ Union
+--------------------------------------------------------------------}
+
+{-
+prop_UnionValid :: Property
+prop_UnionValid
+ = forValidUnitTree $ \t1 ->
+ forValidUnitTree $ \t2 ->
+ valid (union t1 t2)
+-}
+
+prop_UnionInsert :: Int -> Int -> Map Int -> Bool
+prop_UnionInsert k x t
+ = union (singleton k x) t == insert k x t
+
+prop_UnionAssoc :: Map Int -> Map Int -> Map Int -> Bool
+prop_UnionAssoc t1 t2 t3
+ = union t1 (union t2 t3) == union (union t1 t2) t3
+
+prop_UnionComm :: Map Int -> Map Int -> Bool
+prop_UnionComm t1 t2
+ = (union t1 t2 == unionWith (\x y -> y) t2 t1)
+
+{-
+prop_UnionWithValid
+ = forValidIntTree $ \t1 ->
+ forValidIntTree $ \t2 ->
+ valid (unionWithKey (\k x y -> x+y) t1 t2)
+-}
+
+prop_UnionWith :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_UnionWith xs ys
+ = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
+ == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
+
+{-
+prop_DiffValid
+ = forValidUnitTree $ \t1 ->
+ forValidUnitTree $ \t2 ->
+ valid (difference t1 t2)
+-}
+
+prop_Diff :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_Diff xs ys
+ = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
+ == List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys)))
+
+prop_Diff2 :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_Diff2 xs ys
+ = List.sort (keys ((\\) (fromListWith (+) xs) (fromListWith (+) ys)))
+ == List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys)))
+
+{-
+prop_IntValid
+ = forValidUnitTree $ \t1 ->
+ forValidUnitTree $ \t2 ->
+ valid (intersection t1 t2)
+-}
+
+prop_Int :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_Int xs ys
+ = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
+ == List.sort (List.nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
+
+{--------------------------------------------------------------------
+ Lists
+--------------------------------------------------------------------}
+prop_Ordered
+ = forAll (choose (5,100)) $ \n ->
+ let xs = [(x,()) | x <- [0..n::Int]]
+ in fromAscList xs == fromList xs
+
+prop_List :: [Int] -> Bool
+prop_List xs
+ = (List.sort (List.nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
+
+------------------------------------------------------------------------
+-- New tests: compare against the list model (after nub on keys)
+
+prop_index = \(xs :: [Int]) -> length xs > 0 ==>
+ let m = fromList (zip xs xs)
+ in xs == [ m ! i | i <- xs ]
+
+prop_null (m :: Data.IntMap.IntMap Int) = Data.IntMap.null m == (size m == 0)
+
+prop_member (xs :: [Int]) n =
+ let m = fromList (zip xs xs)
+ in (n `elem` xs) == (n `member` m)
+
+prop_notmember (xs :: [Int]) n =
+ let m = fromList (zip xs xs)
+ in (n `notElem` xs) == (n `notMember` m)
+
+prop_findWithDefault = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList xs
+ xs = List.nubBy ((==) `on` fst) ys
+ in
+ and [ findWithDefault 0 i m == j | (i,j) <- xs ]
+
+-- prop_findIndex = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+-- let m = fromList ys
+-- in findIndex (fst (head ys)) m `seq` True
+
+-- prop_lookupIndex = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+-- let m = fromList ys
+-- in isJust (lookupIndex (fst (head ys)) m)
+
+prop_findMin = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in findMin m == List.minimumBy (comparing fst) xs
+
+prop_findMax = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in findMax m == List.maximumBy (comparing fst) xs
+
+prop_filter = \p (ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.IntMap.filter p m == fromList (List.filter (p . snd) xs)
+
+prop_partition = \p (ys :: [(Int, Int)]) -> length ys > 0 ==>
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.IntMap.partition p m == let (a,b) = (List.partition (p . snd) xs) in (fromList a, fromList b)
+
+prop_map (f :: Int -> Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.IntMap.map f m == fromList [ (a, f b) | (a,b) <- xs ]
+
+prop_fmap (f :: Int -> Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ fmap f m == fromList [ (a, f b) | (a,b) <- xs ]
+
+{-
+
+-- mapkeys is hard, as we have to consider collisions of the index space.
+
+prop_mapkeys (f :: Int -> Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.Map.mapKeys f m ==
+ (fromList $
+ {-List.nubBy ((==) `on` fst) $ reverse-} [ (f a, b) | (a,b) <- xs ])
+-}
+
+
+{-
+prop_foldr (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ fold (+) n m == List.foldr (+) n (List.map snd xs)
+ where
+ fold k = Data.IntMap.foldrWithKey (\_ x' z' -> k x' z')
+-}
+
+{-
+prop_foldl (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.IntMap.foldlWithKey (\a _ b -> a + b) n m == List.foldl (+) n (List.map snd xs)
+-}
+
+
+
+{-
+prop_foldl' (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.IntMap.foldlWithKey' (\a _ b -> a + b) n m == List.foldl' (+) n (List.map snd xs)
+-}
+
+
+prop_fold (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.IntMap.fold (+) n m == List.foldr (+) n (List.map snd xs)
+
+prop_foldWithKey (n :: Int) (ys :: [(Int, Int)]) =
+ let m = fromList ys
+ xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
+ in
+ Data.IntMap.foldWithKey (const (+)) n m == List.foldr (+) n (List.map snd xs)
+
+------------------------------------------------------------------------
+
+type UMap = Map ()
+type IMap = Map Int
+type SMap = Map String
+
+----------------------------------------------------------------
+
+tests :: [Test]
+tests = [ testGroup "Test Case" [
+-- testCase "ticket4242" test_ticket4242
+ testCase "index" test_index
+ , testCase "size" test_size
+ , testCase "size2" test_size2
+ , testCase "member" test_member
+ , testCase "notMember" test_notMember
+ , testCase "lookup" test_lookup
+ , testCase "findWithDefault" test_findWithDefault
+ , testCase "empty" test_empty
+ , testCase "mempty" test_mempty
+ , testCase "singleton" test_singleton
+ , testCase "insert" test_insert
+ , testCase "insertWith" test_insertWith
+ -- , testCase "insertWith'" test_insertWith'
+ -- , testCase "insertWithKey" test_insertWithKey
+ -- , testCase "insertWithKey'" test_insertWithKey'
+ , testCase "insertLookupWithKey" test_insertLookupWithKey
+ -- , testCase "insertLookupWithKey'" test_insertLookupWithKey'
+ , testCase "delete" test_delete
+ , testCase "adjust" test_adjust
+ , testCase "adjustWithKey" test_adjustWithKey
+ , testCase "update" test_update
+ , testCase "updateWithKey" test_updateWithKey
+ , testCase "updateLookupWithKey" test_updateLookupWithKey
+ , testCase "alter" test_alter
+ , testCase "union" test_union
+ , testCase "mappend" test_mappend
+ , testCase "unionWith" test_unionWith
+ , testCase "unionWithKey" test_unionWithKey
+ , testCase "unions" test_unions
+ , testCase "mconcat" test_mconcat
+ , testCase "unionsWith" test_unionsWith
+ , testCase "difference" test_difference
+ , testCase "differenceWith" test_differenceWith
+ , testCase "differenceWithKey" test_differenceWithKey
+ , testCase "intersection" test_intersection
+ , testCase "intersectionWith" test_intersectionWith
+ , testCase "intersectionWithKey" test_intersectionWithKey
+ , testCase "map" test_map
+ , testCase "mapWithKey" test_mapWithKey
+ , testCase "mapAccum" test_mapAccum
+ , testCase "mapAccumWithKey" test_mapAccumWithKey
+ , testCase "mapAccumRWithKey" test_mapAccumRWithKey
+-- , testCase "mapKeys" test_mapKeys
+-- , testCase "mapKeysWith" test_mapKeysWith
+-- , testCase "mapKeysMonotonic" test_mapKeysMonotonic
+ , testCase "fold" test_fold
+ , testCase "foldWithKey" test_foldWithKey
+ , testCase "elems" test_elems
+ , testCase "keys" test_keys
+ , testCase "keysSet" test_keysSet
+ , testCase "associative" test_assocs
+ , testCase "toList" test_toList
+ , testCase "fromList" test_fromList
+ , testCase "fromListWith" test_fromListWith
+ , testCase "fromListWithKey" test_fromListWithKey
+ , testCase "toAscList" test_toAscList
+ -- , testCase "toDescList" test_toDescList
+ , testCase "showTree" test_showTree
+ -- , testCase "showTree'" test_showTree'
+ , testCase "fromAscList" test_fromAscList
+ , testCase "fromAscListWith" test_fromAscListWith
+ , testCase "fromAscListWithKey" test_fromAscListWithKey
+ , testCase "fromDistinctAscList" test_fromDistinctAscList
+ , testCase "filter" test_filter
+ , testCase "filterWithKey" test_filteWithKey
+ , testCase "partition" test_partition
+ , testCase "partitionWithKey" test_partitionWithKey
+ , testCase "mapMaybe" test_mapMaybe
+ , testCase "mapMaybeWithKey" test_mapMaybeWithKey
+ , testCase "mapEither" test_mapEither
+ , testCase "mapEitherWithKey" test_mapEitherWithKey
+ , testCase "split" test_split
+ , testCase "splitLookup" test_splitLookup
+ , testCase "isSubmapOfBy" test_isSubmapOfBy
+ , testCase "isSubmapOf" test_isSubmapOf
+ , testCase "isProperSubmapOfBy" test_isProperSubmapOfBy
+ , testCase "isProperSubmapOf" test_isProperSubmapOf
+-- , testCase "lookupIndex" test_lookupIndex
+-- , testCase "findIndex" test_findIndex
+-- , testCase "elemAt" test_elemAt
+-- , testCase "updateAt" test_updateAt
+-- , testCase "deleteAt" test_deleteAt
+ , testCase "findMin" test_findMin
+ , testCase "findMax" test_findMax
+ , testCase "deleteMin" test_deleteMin
+ , testCase "deleteMax" test_deleteMax
+ -- , testCase "deleteFindMin" test_deleteFindMin
+ -- , testCase "deleteFindMax" test_deleteFindMax
+ -- , testCase "updateMin" test_updateMin
+ -- , testCase "updateMax" test_updateMax
+ -- , testCase "updateMinWithKey" test_updateMinWithKey
+ -- , testCase "updateMaxWithKey" test_updateMaxWithKey
+ , testCase "minView" test_minView
+ , testCase "maxView" test_maxView
+ , testCase "minViewWithKey" test_minViewWithKey
+ , testCase "maxViewWithKey" test_maxViewWithKey
+-- , testCase "valid" test_valid
+ ]
+ , testGroup "Property Test" [
+ -- testProperty "fromList" prop_fromList
+ testProperty "insert to singleton" prop_singleton
+ -- , testProperty "insert" prop_insert
+ , testProperty "insert then lookup" prop_lookup
+ -- , testProperty "insert then delete" prop_insertDelete
+ -- , testProperty "insert then delete2" prop_insertDelete2
+ , testProperty "delete non member" prop_deleteNonMember
+ -- , testProperty "deleteMin" prop_deleteMin
+ -- , testProperty "deleteMax" prop_deleteMax
+ -- , testProperty "split" prop_split
+ -- , testProperty "split then join" prop_join
+ -- , testProperty "split then merge" prop_merge
+ -- , testProperty "union" prop_union
+ , testProperty "union model" prop_unionModel
+ , testProperty "union singleton" prop_unionSingleton
+ , testProperty "union associative" prop_unionAssoc
+ , testProperty "fromAscList" prop_ordered
+ , testProperty "fromList then toList" prop_list
+ , testProperty "unionWith" prop_unionWith
+ -- , testProperty "unionWith2" prop_unionWith2
+ , testProperty "union sum" prop_unionSum
+ -- , testProperty "difference" prop_difference
+ , testProperty "difference model" prop_differenceModel
+ -- , testProperty "intersection" prop_intersection
+ , testProperty "intersection model" prop_intersectionModel
+ -- , testProperty "alter" prop_alter
+ ]
+ ]
+
+
+----------------------------------------------------------------
+-- Unit tests
+----------------------------------------------------------------
+
+-- test_ticket4242 :: Assertion
+-- test_ticket4242 = (valid $ deleteMin $ deleteMin $ fromList [ (i, ()) | i <- [0,2,5,1,6,4,8,9,7,11,10,3] :: [Int] ]) @?= True
+
+----------------------------------------------------------------
+-- Operators
+
+test_index :: Assertion
+test_index = fromList [(5,'a'), (3,'b')] ! 5 @?= 'a'
+
+----------------------------------------------------------------
+-- Query
+
+test_size :: Assertion
+test_size = do
+ null (empty) @?= True
+ null (singleton 1 'a') @?= False
+
+test_size2 :: Assertion
+test_size2 = do
+ size empty @?= 0
+ size (singleton 1 'a') @?= 1
+ size (fromList([(1,'a'), (2,'c'), (3,'b')])) @?= 3
+
+test_member :: Assertion
+test_member = do
+ member 5 (fromList [(5,'a'), (3,'b')]) @?= True
+ member 1 (fromList [(5,'a'), (3,'b')]) @?= False
+
+test_notMember :: Assertion
+test_notMember = do
+ notMember 5 (fromList [(5,'a'), (3,'b')]) @?= False
+ notMember 1 (fromList [(5,'a'), (3,'b')]) @?= True
+
+test_lookup :: Assertion
+test_lookup = do
+ employeeCurrency 1 @?= Just 1
+ employeeCurrency 2 @?= Nothing
+ where
+ employeeDept = fromList([(1,2), (3,1)])
+ deptCountry = fromList([(1,1), (2,2)])
+ countryCurrency = fromList([(1, 2), (2, 1)])
+ employeeCurrency :: Int -> Maybe Int
+ employeeCurrency name = do
+ dept <- lookup name employeeDept
+ country <- lookup dept deptCountry
+ lookup country countryCurrency
+
+test_findWithDefault :: Assertion
+test_findWithDefault = do
+ findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) @?= 'x'
+ findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) @?= 'a'
+
+----------------------------------------------------------------
+-- Construction
+
+test_empty :: Assertion
+test_empty = do
+ (empty :: UMap) @?= fromList []
+ size empty @?= 0
+
+test_mempty :: Assertion
+test_mempty = do
+ (mempty :: UMap) @?= fromList []
+ size (mempty :: UMap) @?= 0
+
+test_singleton :: Assertion
+test_singleton = do
+ singleton 1 'a' @?= fromList [(1, 'a')]
+ size (singleton 1 'a') @?= 1
+
+test_insert :: Assertion
+test_insert = do
+ insert 5 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'x')]
+ insert 7 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'a'), (7, 'x')]
+ insert 5 'x' empty @?= singleton 5 'x'
+
+test_insertWith :: Assertion
+test_insertWith = do
+ insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
+ insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
+ insertWith (++) 5 "xxx" empty @?= singleton 5 "xxx"
+
+-- test_insertWith' :: Assertion
+-- test_insertWith' = do
+-- insertWith' (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
+-- insertWith' (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
+-- insertWith' (++) 5 "xxx" empty @?= singleton 5 "xxx"
+
+-- test_insertWithKey :: Assertion
+-- test_insertWithKey = do
+-- insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
+-- insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
+-- insertWithKey f 5 "xxx" empty @?= singleton 5 "xxx"
+-- where
+-- f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+
+-- test_insertWithKey' :: Assertion
+-- test_insertWithKey' = do
+-- insertWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
+-- insertWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
+-- insertWithKey' f 5 "xxx" empty @?= singleton 5 "xxx"
+-- where
+-- f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+
+test_insertLookupWithKey :: Assertion
+test_insertLookupWithKey = do
+ insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
+ insertLookupWithKey f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
+ insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
+ insertLookupWithKey f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx")
+ where
+ f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+
+{-
+test_insertLookupWithKey' :: Assertion
+test_insertLookupWithKey' = do
+ insertLookupWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
+ insertLookupWithKey' f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
+ insertLookupWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
+ insertLookupWithKey' f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx")
+ where
+ f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+-}
+
+----------------------------------------------------------------
+-- Delete/Update
+
+test_delete :: Assertion
+test_delete = do
+ delete 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+ delete 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ delete 5 empty @?= (empty :: IMap)
+
+test_adjust :: Assertion
+test_adjust = do
+ adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
+ adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ adjust ("new " ++) 7 empty @?= empty
+
+test_adjustWithKey :: Assertion
+test_adjustWithKey = do
+ adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
+ adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ adjustWithKey f 7 empty @?= empty
+ where
+ f key x = (show key) ++ ":new " ++ x
+
+test_update :: Assertion
+test_update = do
+ update f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
+ update f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ update f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+ where
+ f x = if x == "a" then Just "new a" else Nothing
+
+test_updateWithKey :: Assertion
+test_updateWithKey = do
+ updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
+ updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+ where
+ f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
+
+test_updateLookupWithKey :: Assertion
+test_updateLookupWithKey = do
+ updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:new a")])
+ updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a")])
+ updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= (Just "b", singleton 5 "a")
+ where
+ f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
+
+test_alter :: Assertion
+test_alter = do
+ alter f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
+ alter f 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+ alter g 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "c")]
+ alter g 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "c")]
+ where
+ f _ = Nothing
+ g _ = Just "c"
+
+----------------------------------------------------------------
+-- Combine
+
+test_union :: Assertion
+test_union = union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
+
+test_mappend :: Assertion
+test_mappend = mappend (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
+
+test_unionWith :: Assertion
+test_unionWith = unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "aA"), (7, "C")]
+
+test_unionWithKey :: Assertion
+test_unionWithKey = unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
+ where
+ f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
+
+test_unions :: Assertion
+test_unions = do
+ unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+ @?= fromList [(3, "b"), (5, "a"), (7, "C")]
+ unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
+ @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
+
+test_mconcat :: Assertion
+test_mconcat = do
+ mconcat [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+ @?= fromList [(3, "b"), (5, "a"), (7, "C")]
+ mconcat [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
+ @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
+
+test_unionsWith :: Assertion
+test_unionsWith = unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+ @?= fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
+
+test_difference :: Assertion
+test_difference = difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 3 "b"
+
+test_differenceWith :: Assertion
+test_differenceWith = differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
+ @?= singleton 3 "b:B"
+ where
+ f al ar = if al== "b" then Just (al ++ ":" ++ ar) else Nothing
+
+test_differenceWithKey :: Assertion
+test_differenceWithKey = differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
+ @?= singleton 3 "3:b|B"
+ where
+ f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
+
+test_intersection :: Assertion
+test_intersection = intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "a"
+
+
+test_intersectionWith :: Assertion
+test_intersectionWith = intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "aA"
+
+test_intersectionWithKey :: Assertion
+test_intersectionWithKey = intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "5:a|A"
+ where
+ f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
+
+----------------------------------------------------------------
+-- Traversal
+
+test_map :: Assertion
+test_map = map (++ "x") (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "bx"), (5, "ax")]
+
+test_mapWithKey :: Assertion
+test_mapWithKey = mapWithKey f (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "3:b"), (5, "5:a")]
+ where
+ f key x = (show key) ++ ":" ++ x
+
+test_mapAccum :: Assertion
+test_mapAccum = mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) @?= ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
+ where
+ f a b = (a ++ b, b ++ "X")
+
+test_mapAccumWithKey :: Assertion
+test_mapAccumWithKey = mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
+ where
+ f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
+
+test_mapAccumRWithKey :: Assertion
+test_mapAccumRWithKey = mapAccumRWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 5-a 3-b", fromList [(3, "bX"), (5, "aX")])
+ where
+ f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
+
+{-
+test_mapKeys :: Assertion
+test_mapKeys = do
+ mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
+ mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "c"
+ mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "c"
+
+test_mapKeysWith :: Assertion
+test_mapKeysWith = do
+ mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "cdab"
+ mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "cdab"
+-}
+
+{-
+test_mapKeysMonotonic :: Assertion
+test_mapKeysMonotonic = do
+ mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")]
+ valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) @?= True
+ valid (mapKeysMonotonic (\ _ -> 1) (fromList [(5,"a"), (3,"b")])) @?= False
+-}
+
+test_fold :: Assertion
+test_fold = fold f 0 (fromList [(5,"a"), (3,"bbb")]) @?= 4
+ where
+ f a len = len + (length a)
+
+test_foldWithKey :: Assertion
+test_foldWithKey = foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) @?= "Map: (5:a)(3:b)"
+ where
+ f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
+
+----------------------------------------------------------------
+-- Conversion
+
+test_elems :: Assertion
+test_elems = do
+ elems (fromList [(5,"a"), (3,"b")]) @?= ["b","a"]
+ elems (empty :: UMap) @?= []
+
+test_keys :: Assertion
+test_keys = do
+ keys (fromList [(5,"a"), (3,"b")]) @?= [3,5]
+ keys (empty :: UMap) @?= []
+
+test_keysSet :: Assertion
+test_keysSet = do
+ keysSet (fromList [(5,"a"), (3,"b")]) @?= Data.IntSet.fromList [3,5]
+ keysSet (empty :: UMap) @?= Data.IntSet.empty
+
+test_assocs :: Assertion
+test_assocs = do
+ assocs (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
+ assocs (empty :: UMap) @?= []
+
+----------------------------------------------------------------
+-- Lists
+
+test_toList :: Assertion
+test_toList = do
+ toList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
+ toList (empty :: SMap) @?= []
+
+test_fromList :: Assertion
+test_fromList = do
+ fromList [] @?= (empty :: SMap)
+ fromList [(5,"a"), (3,"b"), (5, "c")] @?= fromList [(5,"c"), (3,"b")]
+ fromList [(5,"c"), (3,"b"), (5, "a")] @?= fromList [(5,"a"), (3,"b")]
+
+test_fromListWith :: Assertion
+test_fromListWith = do
+ fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "ab"), (5, "aba")]
+ fromListWith (++) [] @?= (empty :: SMap)
+
+test_fromListWithKey :: Assertion
+test_fromListWithKey = do
+ fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "3ab"), (5, "5a5ba")]
+ fromListWithKey f [] @?= (empty :: SMap)
+ where
+ f k a1 a2 = (show k) ++ a1 ++ a2
+
+----------------------------------------------------------------
+-- Ordered lists
+
+test_toAscList :: Assertion
+test_toAscList = toAscList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
+
+-- test_toDescList :: Assertion
+-- test_toDescList = toDescList (fromList [(5,"a"), (3,"b")]) @?= [(5,"a"), (3,"b")]
+
+test_showTree :: Assertion
+test_showTree =
+ (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
+ in showTree t) @?= "*\n+--*\n| +-- 1:=()\n| +--*\n| +-- 2:=()\n| +-- 3:=()\n+--*\n +-- 4:=()\n +-- 5:=()\n"
+
+{-
+test_showTree' :: Assertion
+test_showTree' =
+ (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
+ in s t ) @?= "+--5:=()\n|\n4:=()\n|\n| +--3:=()\n| |\n+--2:=()\n |\n +--1:=()\n"
+ where
+ showElem k x = show k ++ ":=" ++ show x
+
+ s = showTreeWith showElem False True
+-}
+
+
+test_fromAscList :: Assertion
+test_fromAscList = do
+ fromAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
+ fromAscList [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "b")]
+-- valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) @?= True
+-- valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) @?= False
+
+
+test_fromAscListWith :: Assertion
+test_fromAscListWith = do
+ fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "ba")]
+-- valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) @?= True
+-- valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) @?= False
+
+test_fromAscListWithKey :: Assertion
+test_fromAscListWithKey = do
+ fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] @?= fromList [(3, "b"), (5, "5:b5:ba")]
+-- valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) @?= True
+-- valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) @?= False
+ where
+ f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
+
+test_fromDistinctAscList :: Assertion
+test_fromDistinctAscList = do
+ fromDistinctAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
+-- valid (fromDistinctAscList [(3,"b"), (5,"a")]) @?= True
+-- valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) @?= False
+
+----------------------------------------------------------------
+-- Filter
+
+test_filter :: Assertion
+test_filter = do
+ filter (> "a") (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+ filter (> "x") (fromList [(5,"a"), (3,"b")]) @?= empty
+ filter (< "a") (fromList [(5,"a"), (3,"b")]) @?= empty
+
+test_filteWithKey :: Assertion
+test_filteWithKey = filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+
+test_partition :: Assertion
+test_partition = do
+ partition (> "a") (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
+ partition (< "x") (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
+ partition (> "x") (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
+
+test_partitionWithKey :: Assertion
+test_partitionWithKey = do
+ partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) @?= (singleton 5 "a", singleton 3 "b")
+ partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
+ partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
+
+test_mapMaybe :: Assertion
+test_mapMaybe = mapMaybe f (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "new a"
+ where
+ f x = if x == "a" then Just "new a" else Nothing
+
+test_mapMaybeWithKey :: Assertion
+test_mapMaybeWithKey = mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "key : 3"
+ where
+ f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
+
+test_mapEither :: Assertion
+test_mapEither = do
+ mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ @?= (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
+ mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ @?= ((empty :: SMap), fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ where
+ f a = if a < "c" then Left a else Right a
+
+test_mapEitherWithKey :: Assertion
+test_mapEitherWithKey = do
+ mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ @?= (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
+ mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+ @?= ((empty :: SMap), fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
+ where
+ f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
+
+test_split :: Assertion
+test_split = do
+ split 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3,"b"), (5,"a")])
+ split 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, singleton 5 "a")
+ split 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
+ split 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", empty)
+ split 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], empty)
+
+test_splitLookup :: Assertion
+test_splitLookup = do
+ splitLookup 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, Nothing, fromList [(3,"b"), (5,"a")])
+ splitLookup 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, Just "b", singleton 5 "a")
+ splitLookup 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Nothing, singleton 5 "a")
+ splitLookup 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Just "a", empty)
+ splitLookup 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], Nothing, empty)
+
+----------------------------------------------------------------
+-- Submap
+
+test_isSubmapOfBy :: Assertion
+test_isSubmapOfBy = do
+ isSubmapOfBy (==) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
+ isSubmapOfBy (<=) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
+ isSubmapOfBy (==) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
+ isSubmapOfBy (==) (fromList [(fromEnum 'a',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
+ isSubmapOfBy (<) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
+ isSubmapOfBy (==) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1)]) @?= False
+
+test_isSubmapOf :: Assertion
+test_isSubmapOf = do
+ isSubmapOf (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
+ isSubmapOf (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
+ isSubmapOf (fromList [(fromEnum 'a',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
+ isSubmapOf (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1)]) @?= False
+
+test_isProperSubmapOfBy :: Assertion
+test_isProperSubmapOfBy = do
+ isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
+ isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
+ isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
+ isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
+ isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= False
+
+test_isProperSubmapOf :: Assertion
+test_isProperSubmapOf = do
+ isProperSubmapOf (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
+ isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
+ isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
+
+----------------------------------------------------------------
+-- Indexed
+
+{-
+test_lookupIndex :: Assertion
+test_lookupIndex = do
+ isJust (lookupIndex 2 (fromList [(5,"a"), (3,"b")])) @?= False
+ fromJust (lookupIndex 3 (fromList [(5,"a"), (3,"b")])) @?= 0
+ fromJust (lookupIndex 5 (fromList [(5,"a"), (3,"b")])) @?= 1
+ isJust (lookupIndex 6 (fromList [(5,"a"), (3,"b")])) @?= False
+-}
+
+-- test_findIndex :: Assertion
+-- test_findIndex = do
+-- findIndex 3 (fromList [(5,"a"), (3,"b")]) @?= 0
+-- findIndex 5 (fromList [(5,"a"), (3,"b")]) @?= 1
+
+-- test_elemAt :: Assertion
+-- test_elemAt = do
+-- elemAt 0 (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
+-- elemAt 1 (fromList [(5,"a"), (3,"b")]) @?= (5, "a")
+
+-- test_updateAt :: Assertion
+-- test_updateAt = do
+-- updateAt (\ _ _ -> Just "x") 0 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "x"), (5, "a")]
+-- updateAt (\ _ _ -> Just "x") 1 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "x")]
+-- updateAt (\_ _ -> Nothing) 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+-- updateAt (\_ _ -> Nothing) 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+
+-- test_deleteAt :: Assertion
+-- test_deleteAt = do
+-- deleteAt 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+-- deleteAt 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+
+----------------------------------------------------------------
+-- Min/Max
+
+test_findMin :: Assertion
+test_findMin = findMin (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
+
+test_findMax :: Assertion
+test_findMax = findMax (fromList [(5,"a"), (3,"b")]) @?= (5,"a")
+
+test_deleteMin :: Assertion
+test_deleteMin = do
+ deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(5,"a"), (7,"c")]
+ -- deleteMin (empty :: SMap) @?= empty
+
+test_deleteMax :: Assertion
+test_deleteMax = do
+ deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(3,"b"), (5,"a")]
+ -- deleteMax (empty :: SMap) @?= empty
+
+-- test_deleteFindMin :: Assertion
+-- test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((3,"b"), fromList[(5,"a"), (10,"c")])
+
+-- test_deleteFindMax :: Assertion
+-- test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((10,"c"), fromList [(3,"b"), (5,"a")])
+
+-- test_updateMin :: Assertion
+---- test_updateMin = do
+-- updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")]
+-- updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+
+-- test_updateMax :: Assertion
+-- test_updateMax = do
+-- updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")]
+-- updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+
+-- test_updateMinWithKey :: Assertion
+-- test_updateMinWithKey = do
+-- updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")]
+-- updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
+
+-- test_updateMaxWithKey :: Assertion
+-- test_updateMaxWithKey = do
+-- updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")]
+-- updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
+
+test_minView :: Assertion
+test_minView = do
+ minView (fromList [(5,"a"), (3,"b")]) @?= Just ("b", singleton 5 "a")
+ minView (empty :: SMap) @?= Nothing
+
+test_maxView :: Assertion
+test_maxView = do
+ maxView (fromList [(5,"a"), (3,"b")]) @?= Just ("a", singleton 3 "b")
+ maxView (empty :: SMap) @?= Nothing
+
+test_minViewWithKey :: Assertion
+test_minViewWithKey = do
+ minViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((3,"b"), singleton 5 "a")
+ minViewWithKey (empty :: SMap) @?= Nothing
+
+test_maxViewWithKey :: Assertion
+test_maxViewWithKey = do
+ maxViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((5,"a"), singleton 3 "b")
+ maxViewWithKey (empty :: SMap) @?= Nothing
+
+----------------------------------------------------------------
+-- Debug
+
+-- test_valid :: Assertion
+-- test_valid = do
+-- valid (fromAscList [(3,"b"), (5,"a")]) @?= True
+-- valid (fromAscList [(5,"a"), (3,"b")]) @?= False
+
+----------------------------------------------------------------
+-- QuickCheck
+----------------------------------------------------------------
+
+-- prop_fromList :: UMap -> Bool
+-- prop_fromList t = valid t
+
+prop_singleton :: Int -> Int -> Bool
+prop_singleton k x = insert k x empty == singleton k x
+
+-- prop_insert :: Int -> UMap -> Bool
+-- prop_insert k t = valid $ insert k () t
+
+prop_lookup :: Int -> UMap -> Bool
+prop_lookup k t = lookup k (insert k () t) /= Nothing
+
+-- prop_insertDelete :: Int -> UMap -> Bool
+-- prop_insertDelete k t = valid $ delete k (insert k () t)
+
+prop_insertDelete2 :: Int -> UMap -> Property
+prop_insertDelete2 k t = (lookup k t == Nothing) ==> (delete k (insert k () t) == t)
+
+prop_deleteNonMember :: Int -> UMap -> Property
+prop_deleteNonMember k t = (lookup k t == Nothing) ==> (delete k t == t)
+
+-- prop_deleteMin :: UMap -> Bool
+-- prop_deleteMin t = valid $ deleteMin $ deleteMin t
+
+-- prop_deleteMax :: UMap -> Bool
+-- prop_deleteMax t = valid $ deleteMax $ deleteMax t
+
+----------------------------------------------------------------
+
+-- prop_split :: Int -> UMap -> Property
+-- prop_split k t = (lookup k t /= Nothing) ==> let (r,l) = split k t
+-- in (valid r, valid l) == (True, True)
+
+-- prop_join :: Int -> UMap -> Bool
+-- prop_join k t = let (l,r) = split k t
+-- in valid (join k () l r)
+
+-- prop_merge :: Int -> UMap -> Bool
+-- prop_merge k t = let (l,r) = split k t
+-- in valid (merge l r)
+
+----------------------------------------------------------------
+
+-- prop_union :: UMap -> UMap -> Bool
+-- prop_union t1 t2 = valid (union t1 t2)
+
+prop_unionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_unionModel xs ys
+ = sort (keys (union (fromList xs) (fromList ys)))
+ == sort (nub (P.map fst xs ++ P.map fst ys))
+
+prop_unionSingleton :: IMap -> Int -> Int -> Bool
+prop_unionSingleton t k x = union (singleton k x) t == insert k x t
+
+prop_unionAssoc :: IMap -> IMap -> IMap -> Bool
+prop_unionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
+
+prop_unionWith :: IMap -> IMap -> Bool
+prop_unionWith t1 t2 = (union t1 t2 == unionWith (\_ y -> y) t2 t1)
+
+-- prop_unionWith2 :: IMap -> IMap -> Bool
+-- prop_unionWith2 t1 t2 = valid (unionWithKey (\_ x y -> x+y) t1 t2)
+
+prop_unionSum :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_unionSum xs ys
+ = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
+ == (sum (P.map snd xs) + sum (P.map snd ys))
+
+-- prop_difference :: IMap -> IMap -> Bool
+-- prop_difference t1 t2 = valid (difference t1 t2)
+
+prop_differenceModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_differenceModel xs ys
+ = sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
+ == sort ((L.\\) (nub (P.map fst xs)) (nub (P.map fst ys)))
+
+-- prop_intersection :: IMap -> IMap -> Bool
+-- prop_intersection t1 t2 = valid (intersection t1 t2)
+
+prop_intersectionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_intersectionModel xs ys
+ = sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
+ == sort (nub ((L.intersect) (P.map fst xs) (P.map fst ys)))
+
+----------------------------------------------------------------
+
+prop_ordered :: Property
+prop_ordered
+ = forAll (choose (5,100)) $ \n ->
+ let xs = [(x,()) | x <- [0..n::Int]]
+ in fromAscList xs == fromList xs
+
+prop_list :: [Int] -> Bool
+prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
+
+----------------------------------------------------------------
+
+prop_alter :: UMap -> Int -> Bool
+prop_alter t k = {-balanced t' &&-} case lookup k t of
+ Just _ -> (size t - 1) == size t' && lookup k t' == Nothing
+ Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing
+ where
+ t' = alter f k t
+ f Nothing = Just ()
+ f (Just ()) = Nothing
addfile ./benchmarks/IntMap.hs
hunk ./benchmarks/IntMap.hs 1
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import Control.DeepSeq
+import Control.Exception (evaluate)
+import Control.Monad.Trans (liftIO)
+import Criterion.Config
+import Criterion.Main
+import Data.List (foldl')
+import qualified Data.IntMap as M
+import Data.Maybe (fromMaybe)
+import Prelude hiding (lookup)
+
+instance (NFData a) => NFData (M.IntMap a) where
+ rnf M.Nil = ()
+ rnf (M.Tip x y) = rnf x `seq` rnf y
+ rnf (M.Bin p m l r) = rnf p `seq` rnf m `seq` rnf l `seq` rnf r
+
+main = do
+ let m = M.fromAscList elems :: M.IntMap Int
+ defaultMainWith
+ defaultConfig
+ (liftIO . evaluate $ rnf [m])
+ [ bench "lookup" $ nf (lookup keys) m
+ , bench "insert" $ nf (ins elems) M.empty
+{- , bench "insertWith empty" $ nf (insWith elems) M.empty
+ , bench "insertWith update" $ nf (insWith elems) m
+ -- , bench "insertWith' empty" $ nf (insWith' elems) M.empty
+ -- , bench "insertWith' update" $ nf (insWith' elems) m
+ , bench "insertWithKey empty" $ nf (insWithKey elems) M.empty
+ , bench "insertWithKey update" $ nf (insWithKey elems) m
+ -- , bench "insertWithKey' empty" $ nf (insWithKey' elems) M.empty
+ -- , bench "insertWithKey' update" $ nf (insWithKey' elems) m
+ , bench "insertLookupWithKey empty" $
+ nf (insLookupWithKey elems) M.empty
+ , bench "insertLookupWithKey update" $
+ nf (insLookupWithKey elems) m
+-- , bench "insertLookupWithKey' empty" $
+-- nf (insLookupWithKey' elems) M.empty
+-- , bench "insertLookupWithKey' update" $
+-- nf (insLookupWithKey' elems) m
+-}
+ , bench "map" $ nf (M.map (+ 1)) m
+ , bench "mapWithKey" $ nf (M.mapWithKey (+)) m
+ , bench "foldlWithKey" $ nf (ins elems) m
+-- , bench "foldlWithKey'" $ nf (M.foldlWithKey' sum 0) m
+-- , bench "foldrWithKey" $ nf (M.foldrWithKey consPair []) m
+ , bench "delete" $ nf (del keys) m
+ , bench "update" $ nf (upd keys) m
+ , bench "updateLookupWithKey" $ nf (upd' keys) m
+ , bench "alter" $ nf (alt keys) m
+ , bench "mapMaybe" $ nf (M.mapMaybe maybeDel) m
+-- , bench "mapMaybeWithKey" $ nf (M.mapMaybeWithKey (const maybeDel)) m
+ ]
+ where
+ elems = zip keys values
+ keys = [1..2^12]
+ values = [1..2^12]
+ sum k v1 v2 = k + v1 + v2
+ consPair k v xs = (k, v) : xs
+
+add3 :: Int -> Int -> Int -> Int
+add3 x y z = x + y + z
+{-# INLINE add3 #-}
+
+lookup :: [Int] -> M.IntMap Int -> Int
+lookup xs m = foldl' (\n k -> fromMaybe n (M.lookup k m)) 0 xs
+
+-- lookupIndex :: [Int] -> M.IntMap Int -> Int
+-- lookupIndex xs m = foldl' (\n k -> fromMaybe n (M.lookupIndex k m)) 0 xs
+
+ins :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
+ins xs m = foldl' (\m (k, v) -> M.insert k v m) m xs
+
+insWith :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
+insWith xs m = foldl' (\m (k, v) -> M.insertWith (+) k v m) m xs
+
+insWithKey :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
+insWithKey xs m = foldl' (\m (k, v) -> M.insertWithKey add3 k v m) m xs
+
+-- insWith' :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
+-- insWith' xs m = foldl' (\m (k, v) -> M.insertWith' (+) k v m) m xs
+
+-- insWithKey' :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
+-- insWithKey' xs m = foldl' (\m (k, v) -> M.insertWithKey' add3 k v m) m xs
+
+data PairS a b = PS !a !b
+
+insLookupWithKey :: [(Int, Int)] -> M.IntMap Int -> (Int, M.IntMap Int)
+insLookupWithKey xs m = let !(PS a b) = foldl' f (PS 0 m) xs in (a, b)
+ where
+ f (PS n m) (k, v) = let !(n', m') = M.insertLookupWithKey add3 k v m
+ in PS (fromMaybe 0 n' + n) m'
+
+{-
+insLookupWithKey' :: [(Int, Int)] -> M.Map Int Int -> (Int, M.Map Int Int)
+insLookupWithKey' xs m = let !(PS a b) = foldl' f (PS 0 m) xs in (a, b)
+ where
+ f (PS n m) (k, v) = let !(n', m') = M.insertLookupWithKey' add3 k v m
+ in PS (fromMaybe 0 n' + n) m'
+-}
+
+del :: [Int] -> M.IntMap Int -> M.IntMap Int
+del xs m = foldl' (\m k -> M.delete k m) m xs
+
+upd :: [Int] -> M.IntMap Int -> M.IntMap Int
+upd xs m = foldl' (\m k -> M.update Just k m) m xs
+
+upd' :: [Int] -> M.IntMap Int -> M.IntMap Int
+upd' xs m = foldl' (\m k -> snd $ M.updateLookupWithKey (\_ a -> Just a) k m) m xs
+
+alt :: [Int] -> M.IntMap Int -> M.IntMap Int
+alt xs m = foldl' (\m k -> M.alter id k m) m xs
+
+maybeDel :: Int -> Maybe Int
+maybeDel n | n `mod` 3 == 0 = Nothing
+ | otherwise = Just n
hunk ./Data/IntMap.hs 1
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
hunk ./Data/IntMap.hs 47
+#if !defined(TESTING)
hunk ./Data/IntMap.hs 49
+#else
+ IntMap(..), Key -- instance Eq,Show
+#endif
hunk ./Data/IntMap.hs 61
- , lookup
+ , lookup
hunk ./Data/IntMap.hs 115
- , keysSet
+ , keysSet
hunk ./Data/IntMap.hs 210
-natFromInt i = fromIntegral i
+natFromInt = fromIntegral
+{-# INLINE natFromInt #-}
hunk ./Data/IntMap.hs 214
-intFromNat w = fromIntegral w
+intFromNat = fromIntegral
+{-# INLINE intFromNat #-}
hunk ./Data/IntMap.hs 227
+{-# INLINE shiftRL #-}
hunk ./Data/IntMap.hs 241
+{-# INLINE (!) #-}
hunk ./Data/IntMap.hs 246
+{-# INLINE (\\) #-}
hunk ./Data/IntMap.hs 304
+{-# INLINE null #-}
hunk ./Data/IntMap.hs 317
+{-# INLINE size #-}
hunk ./Data/IntMap.hs 329
+{-# INLINE member #-}
hunk ./Data/IntMap.hs 338
+{-# INLINE notMember #-}
hunk ./Data/IntMap.hs 344
+{-# INLINE lookup #-}
hunk ./Data/IntMap.hs 356
+-- ^ inlining lookup doesn't seem to help.
hunk ./Data/IntMap.hs 363
-
+{-# INLINE find' #-}
hunk ./Data/IntMap.hs 377
+{-# INLINE findWithDefault #-}
hunk ./Data/IntMap.hs 390
+{-# INLINE empty #-}
hunk ./Data/IntMap.hs 400
+{-# INLINE singleton #-}
hunk ./Data/IntMap.hs 440
+{-# INLINE insertWith #-}
hunk ./Data/IntMap.hs 454
-insertWithKey f k x t
- = case t of
- Bin p m l r
- | nomatch k p m -> join k (Tip k x) p t
- | zero k m -> Bin p m (insertWithKey f k x l) r
- | otherwise -> Bin p m l (insertWithKey f k x r)
- Tip ky y
- | k==ky -> Tip k (f k x y)
- | otherwise -> join k (Tip k x) ky t
- Nil -> Tip k x
+insertWithKey f k x = k `seq` go
+ where
+ go t@(Bin p m l r)
+ | nomatch k p m = join k (Tip k x) p t
+ | zero k m = Bin p m (go l) r
+ | otherwise = Bin p m l (go r)
+
+ go t@(Tip ky y)
+ | k==ky = Tip k (f k x y)
+ | otherwise = join k (Tip k x) ky t
+
+ go Nil = Tip k x
+{-# INLINE insertWithKey #-}
hunk ./Data/IntMap.hs 485
-insertLookupWithKey f k x t
- = case t of
- Bin p m l r
- | nomatch k p m -> (Nothing,join k (Tip k x) p t)
- | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
- | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
- Tip ky y
- | k==ky -> (Just y,Tip k (f k x y))
- | otherwise -> (Nothing,join k (Tip k x) ky t)
- Nil -> (Nothing,Tip k x)
+insertLookupWithKey f k x = k `seq` go
+ where
+ go t@(Bin p m l r)
+ | nomatch k p m = (Nothing,join k (Tip k x) p t)
+ | zero k m = case go l of (found, l') -> (found,Bin p m l' r)
+ | otherwise = case go r of (found, r') -> (found,Bin p m l r')
+
+ go t@(Tip ky y)
+ | k==ky = (Just y,Tip k (f k x y))
+ | otherwise = (Nothing,join k (Tip k x) ky t)
+
+ go Nil = (Nothing,Tip k x)
+{-# INLINE insertLookupWithKey #-}
hunk ./Data/IntMap.hs 512
-delete k t
- = case t of
- Bin p m l r
- | nomatch k p m -> t
- | zero k m -> bin p m (delete k l) r
- | otherwise -> bin p m l (delete k r)
- Tip ky _
- | k==ky -> Nil
- | otherwise -> t
- Nil -> Nil
+delete k = go
+ where
+ go t@(Bin p m l r)
+ | nomatch k p m = t
+ | zero k m = bin p m (go l) r
+ | otherwise = bin p m l (go r)
+
+ go t@(Tip ky _)
+ | k==ky = Nil
+ | otherwise = t
+
+ go Nil = Nil
+{-# INLINE delete #-}
hunk ./Data/IntMap.hs 536
+{-# INLINE adjust #-}
hunk ./Data/IntMap.hs 547
-adjustWithKey f k m
- = updateWithKey (\k' x -> Just (f k' x)) k m
+adjustWithKey f
+ = updateWithKey (\k' x -> Just (f k' x))
+{-# INLINE adjustWithKey #-}
hunk ./Data/IntMap.hs 561
-update f k m
- = updateWithKey (\_ x -> f x) k m
+update f
+ = updateWithKey (\_ x -> f x)
+{-# INLINE update #-}
hunk ./Data/IntMap.hs 575
-updateWithKey f k t
- = case t of
- Bin p m l r
- | nomatch k p m -> t
- | zero k m -> bin p m (updateWithKey f k l) r
- | otherwise -> bin p m l (updateWithKey f k r)
- Tip ky y
- | k==ky -> case (f k y) of
+updateWithKey f k = go
+ where
+ go t@(Bin p m l r)
+ | nomatch k p m = t
+ | zero k m = bin p m (go l) r
+ | otherwise = bin p m l (go r)
+
+ go t@(Tip ky y)
+ | k==ky = case f k y of
hunk ./Data/IntMap.hs 586
- | otherwise -> t
- Nil -> Nil
+ | otherwise = t
+
+ go Nil = Nil
+{-# INLINE updateWithKey #-}
hunk ./Data/IntMap.hs 602
-updateLookupWithKey f k t
- = case t of
- Bin p m l r
- | nomatch k p m -> (Nothing,t)
- | zero k m -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
- | otherwise -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
- Tip ky y
- | k==ky -> case (f k y) of
+updateLookupWithKey f k = go
+ where
+ go t@(Bin p m l r)
+ | nomatch k p m = (Nothing,t)
+ | zero k m = case updateLookupWithKey f k l of (found, l') -> (found,bin p m l' r)
+ | otherwise = case updateLookupWithKey f k r of (found, r') -> (found,bin p m l r')
+
+ go t@(Tip ky y)
+ | k==ky = case f k y of
hunk ./Data/IntMap.hs 613
- | otherwise -> (Nothing,t)
- Nil -> (Nothing,Nil)
-
+ | otherwise = (Nothing,t)
hunk ./Data/IntMap.hs 615
+ go Nil = (Nothing,Nil)
+{-# INLINE updateLookupWithKey #-}
hunk ./Data/IntMap.hs 622
-alter f k t
- = case t of
- Bin p m l r
- | nomatch k p m -> case f Nothing of
+alter f k = k `seq` go
+ where
+ go t@(Bin p m l r)
+ | nomatch k p m = case f Nothing of
hunk ./Data/IntMap.hs 627
- Just x -> join k (Tip k x) p t
- | zero k m -> bin p m (alter f k l) r
- | otherwise -> bin p m l (alter f k r)
- Tip ky y
- | k==ky -> case f (Just y) of
+ Just x -> join k (Tip k x) p t
+ | zero k m = bin p m (go l) r
+ | otherwise = bin p m l (go r)
+
+ go t@(Tip ky y)
+ | k==ky = case f (Just y) of
hunk ./Data/IntMap.hs 635
- | otherwise -> case f Nothing of
+
+ | otherwise = case f Nothing of
hunk ./Data/IntMap.hs 639
- Nil -> case f Nothing of
+
+ go Nil = case f Nothing of
hunk ./Data/IntMap.hs 644
+{-# INLINE alter #-}
hunk ./Data/IntMap.hs 659
+{-# INLINE unions #-}
hunk ./Data/IntMap.hs 669
+{-# INLINE unionsWith #-}
hunk ./Data/IntMap.hs 704
+{-# INLINE unionWith #-}
hunk ./Data/IntMap.hs 770
+{-# INLINE differenceWith #-}
hunk ./Data/IntMap.hs 847
+{-# INLINE intersectionWith #-}
hunk ./Data/IntMap.hs 891
-updateMinWithKey f t
- = case t of
- Bin p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
- Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
- Tip k y -> Tip k (f k y)
- Nil -> error "maxView: empty map has no maximal element"
+updateMinWithKey f = go
+ where
+ go (Bin p m l r) | m < 0 = let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
+ go (Bin p m l r) = let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
+ go (Tip k y) = Tip k (f k y)
+ go Nil = error "maxView: empty map has no maximal element"
+{-# INLINE updateMinWithKey #-}
hunk ./Data/IntMap.hs 900
-updateMinWithKeyUnsigned f t
- = case t of
- Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
- Tip k y -> Tip k (f k y)
- Nil -> error "updateMinWithKeyUnsigned Nil"
+updateMinWithKeyUnsigned f = go
+ where
+ go (Bin p m l r) = let t' = go l in Bin p m t' r
+ go (Tip k y) = Tip k (f k y)
+ go Nil = error "updateMinWithKeyUnsigned Nil"
+{-# INLINE updateMinWithKeyUnsigned #-}
hunk ./Data/IntMap.hs 913
-updateMaxWithKey f t
- = case t of
- Bin p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' r
- Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
- Tip k y -> Tip k (f k y)
- Nil -> error "maxView: empty map has no maximal element"
+updateMaxWithKey f = go
+ where
+ go (Bin p m l r) | m < 0 = let t' = updateMaxWithKeyUnsigned f l in Bin p m t' r
+ go (Bin p m l r) = let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
+ go (Tip k y) = Tip k (f k y)
+ go Nil = error "maxView: empty map has no maximal element"
+{-# INLINE updateMaxWithKey #-}
hunk ./Data/IntMap.hs 922
-updateMaxWithKeyUnsigned f t
- = case t of
- Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
- Tip k y -> Tip k (f k y)
- Nil -> error "updateMaxWithKeyUnsigned Nil"
+updateMaxWithKeyUnsigned f = go
+ where
+ go (Bin p m l r) = let t' = go r in Bin p m l t'
+ go (Tip k y) = Tip k (f k y)
+ go Nil = error "updateMaxWithKeyUnsigned Nil"
+{-# INLINE updateMaxWithKeyUnsigned #-}
hunk ./Data/IntMap.hs 980
+{-# INLINE updateMax #-}
hunk ./Data/IntMap.hs 989
+{-# INLINE updateMin #-}
hunk ./Data/IntMap.hs 994
+{-# INLINE first #-}
hunk ./Data/IntMap.hs 1036
--- | /O(log n)/. Delete the minimal key.
+-- | /O(log n)/. Delete the minimal key. An error is thrown if the IntMap is already empty.
+-- Note, this is not the same behavior Map.
hunk ./Data/IntMap.hs 1041
--- | /O(log n)/. Delete the maximal key.
+-- | /O(log n)/. Delete the maximal key. An error is thrown if the IntMap is already empty.
+-- Note, this is not the same behavior Map.
hunk ./Data/IntMap.hs 1055
+{-# INLINE isProperSubmapOf #-}
hunk ./Data/IntMap.hs 1078
+{-# INLINE isProperSubmapOfBy #-}
hunk ./Data/IntMap.hs 1106
+{-# INLINE submapCmp #-}
hunk ./Data/IntMap.hs 1113
+{-# INLINE isSubmapOf #-}
hunk ./Data/IntMap.hs 1151
-map f m
- = mapWithKey (\_ x -> f x) m
+map f = mapWithKey (\_ x -> f x)
+{-# INLINE map #-}
hunk ./Data/IntMap.hs 1160
-mapWithKey f t
- = case t of
- Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
- Tip k x -> Tip k (f k x)
- Nil -> Nil
+mapWithKey f = go
+ where
+ go (Bin p m l r) = Bin p m (go l) (go r)
+ go (Tip k x) = Tip k (f k x)
+ go Nil = Nil
+{-# INLINE mapWithKey #-}
hunk ./Data/IntMap.hs 1174
-mapAccum f a m
- = mapAccumWithKey (\a' _ x -> f a' x) a m
+mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)
+{-# INLINE mapAccum #-}
hunk ./Data/IntMap.hs 1186
+{-# INLINE mapAccumWithKey #-}
hunk ./Data/IntMap.hs 1222
+{-# INLINE filter #-}
hunk ./Data/IntMap.hs 1229
-filterWithKey predicate t
- = case t of
- Bin p m l r
- -> bin p m (filterWithKey predicate l) (filterWithKey predicate r)
- Tip k x
- | predicate k x -> t
- | otherwise -> Nil
- Nil -> Nil
+filterWithKey p = go
+ where
+ go (Bin p m l r) = bin p m (go l) (go r)
+ go t@(Tip k x)
+ | p k x = t
+ | otherwise = Nil
+ go Nil = Nil
+{-# INLINE filterWithKey #-}
hunk ./Data/IntMap.hs 1249
+{-# INLINE partition #-}
hunk ./Data/IntMap.hs 1277
-mapMaybe f m
- = mapMaybeWithKey (\_ x -> f x) m
+mapMaybe f = mapMaybeWithKey (\_ x -> f x)
+{-# INLINE mapMaybe #-}
hunk ./Data/IntMap.hs 1286
-mapMaybeWithKey f (Bin p m l r)
- = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
-mapMaybeWithKey f (Tip k x) = case f k x of
- Just y -> Tip k y
- Nothing -> Nil
-mapMaybeWithKey _ Nil = Nil
+mapMaybeWithKey f = go
+ where
+ go (Bin p m l r) = bin p m (go l) (go r)
+ go (Tip k x) = case f k x of
+ Just y -> Tip k y
+ Nothing -> Nil
+ go Nil = Nil
+{-# INLINE mapMaybeWithKey #-}
hunk ./Data/IntMap.hs 1307
+{-# INLINE mapEither #-}
hunk ./Data/IntMap.hs 1415
-fold f z t
- = foldWithKey (\_ x y -> f x y) z t
+fold f = foldWithKey (\_ x y -> f x y)
+{-# INLINE fold #-}
hunk ./Data/IntMap.hs 1428
-foldWithKey f z t
- = foldr f z t
+foldWithKey
+ = foldr
+{-# INLINE foldWithKey #-}
hunk ./Data/IntMap.hs 1439
+{-# INLINE foldr #-}
hunk ./Data/IntMap.hs 1442
-foldr' f z t
- = case t of
- Bin _ _ l r -> foldr' f (foldr' f z r) l
- Tip k x -> f k x z
- Nil -> z
-
-
+foldr' f = go
+ where
+ go z (Bin _ _ l r) = go (go z r) l
+ go z (Tip k x) = f k x z
+ go z Nil = z
+{-# INLINE foldr' #-}
hunk ./Data/IntMap.hs 1459
-elems m
- = foldWithKey (\_ x xs -> x:xs) [] m
+elems
+ = foldWithKey (\_ x xs -> x:xs) []
+{-# INLINE elems #-}
hunk ./Data/IntMap.hs 1469
-keys m
- = foldWithKey (\k _ ks -> k:ks) [] m
+keys
+ = foldWithKey (\k _ ks -> k:ks) []
+{-# INLINE keys #-}
hunk ./Data/IntMap.hs 1490
+{-# INLINE assocs #-}
hunk ./Data/IntMap.hs 1502
-toList t
- = foldWithKey (\k x xs -> (k,x):xs) [] t
+toList
+ = foldWithKey (\k x xs -> (k,x):xs) []
+{-# INLINE toList #-}
hunk ./Data/IntMap.hs 1527
+{-# INLINE fromList #-}
hunk ./Data/IntMap.hs 1537
+{-# INLINE fromListWith #-}
hunk ./Data/IntMap.hs 1549
+{-# INLINE fromListWithKey #-}
hunk ./Data/IntMap.hs 1560
+{-# INLINE fromAscList #-}
hunk ./Data/IntMap.hs 1571
+{-# INLINE fromAscListWith #-}
hunk ./Data/IntMap.hs 1792
+{-# INLINE join #-}
hunk ./Data/IntMap.hs 1801
+{-# INLINE bin #-}
hunk ./Data/IntMap.hs 1810
+{-# INLINE zero #-}
hunk ./Data/IntMap.hs 1815
+{-# INLINE nomatch #-}
hunk ./Data/IntMap.hs 1819
+{-# INLINE match #-}
hunk ./Data/IntMap.hs 1824
+{-# INLINE mask #-}
hunk ./Data/IntMap.hs 1829
+{-# INLINE zeroN #-}
hunk ./Data/IntMap.hs 1837
+{-# INLINE maskW #-}
hunk ./Data/IntMap.hs 1842
+{-# INLINE shorter #-}
hunk ./Data/IntMap.hs 1847
+{-# INLINE branchMask #-}
hunk ./Data/IntMap.hs 1900
+{-# INLINE highestBitMask #-}
hunk ./Data/IntMap.hs 1906
-foldlStrict :: (a -> b -> a) -> a -> [b] -> a
-foldlStrict f z xs
- = case xs of
- [] -> z
- (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
hunk ./Data/IntMap.hs 1907
-{-
-{--------------------------------------------------------------------
- Testing
---------------------------------------------------------------------}
-testTree :: [Int] -> IntMap Int
-testTree xs = fromList [(x,x*x*30696 `mod` 65521) | x <- xs]
-test1 = testTree [1..20]
-test2 = testTree [30,29..10]
-test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
-
-{--------------------------------------------------------------------
- QuickCheck
---------------------------------------------------------------------}
-qcheck prop
- = check config prop
+foldlStrict :: (a -> b -> a) -> a -> [b] -> a
+foldlStrict f = go
hunk ./Data/IntMap.hs 1910
- config = Config
- { configMaxTest = 500
- , configMaxFail = 5000
- , configSize = \n -> (div n 2 + 3)
- , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
- }
-
-
-{--------------------------------------------------------------------
- Arbitrary, reasonably balanced trees
---------------------------------------------------------------------}
-instance Arbitrary a => Arbitrary (IntMap a) where
- arbitrary = do{ ks <- arbitrary
- ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks
- ; return (fromList xs)
- }
-
-
-{--------------------------------------------------------------------
- Single, Insert, Delete
---------------------------------------------------------------------}
-prop_Single :: Key -> Int -> Bool
-prop_Single k x
- = (insert k x empty == singleton k x)
-
-prop_InsertDelete :: Key -> Int -> IntMap Int -> Property
-prop_InsertDelete k x t
- = not (member k t) ==> delete k (insert k x t) == t
-
-prop_UpdateDelete :: Key -> IntMap Int -> Bool
-prop_UpdateDelete k t
- = update (const Nothing) k t == delete k t
-
-
-{--------------------------------------------------------------------
- Union
---------------------------------------------------------------------}
-prop_UnionInsert :: Key -> Int -> IntMap Int -> Bool
-prop_UnionInsert k x t
- = union (singleton k x) t == insert k x t
-
-prop_UnionAssoc :: IntMap Int -> IntMap Int -> IntMap Int -> Bool
-prop_UnionAssoc t1 t2 t3
- = union t1 (union t2 t3) == union (union t1 t2) t3
-
-prop_UnionComm :: IntMap Int -> IntMap Int -> Bool
-prop_UnionComm t1 t2
- = (union t1 t2 == unionWith (\x y -> y) t2 t1)
-
-
-prop_Diff :: [(Key,Int)] -> [(Key,Int)] -> Bool
-prop_Diff xs ys
- = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
- == List.sort ((List.\\) (nub (Prelude.map fst xs)) (nub (Prelude.map fst ys)))
-
-prop_Int :: [(Key,Int)] -> [(Key,Int)] -> Bool
-prop_Int xs ys
- = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
- == List.sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
-
-{--------------------------------------------------------------------
- Lists
---------------------------------------------------------------------}
-prop_Ordered
- = forAll (choose (5,100)) $ \n ->
- let xs = concat [[(x-n,()),(x-n,())] | x <- [0..2*n::Int]]
- in fromAscList xs == fromList xs
-
-prop_List :: [Key] -> Bool
-prop_List xs
- = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
-
-
-{--------------------------------------------------------------------
- updateMin / updateMax
---------------------------------------------------------------------}
-prop_UpdateMinMax :: [Key] -> Bool
-prop_UpdateMinMax xs =
- let m = fromList [(x,0)|x<-xs]
- minKey = fst . head . Prelude.filter ((==1).snd) . assocs . updateMin succ $ m
- maxKey = fst . head . Prelude.filter ((==1).snd) . assocs . updateMax succ $ m
- in all (>=minKey) xs && all (<=maxKey) xs
-
--}
+ go z [] = z
+ go z (x:xs) = z `seq` go (f z x) xs
+{-# INLINE foldlStrict #-}
hunk ./Data/IntSet.hs 1
-{-# OPTIONS -cpp #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
hunk ./Data/IntMap.hs 1231
- go (Bin p m l r) = bin p m (go l) (go r)
+ go (Bin pr m l r) = bin pr m (go l) (go r)
hunk ./Data/Map.hs 731
-updateAt f i t = i `seq` go i t
+updateAt f i0 t = i0 `seq` go i0 t