packages feed

containers 0.5.2.1 → 0.5.3.0

raw patch · 14 files changed

+408/−160 lines, 14 filesdep +ChasingBottomsdep +containersdep ~QuickCheckdep ~basedep ~test-frameworkPVP ok

version bump matches the API change (PVP)

Dependencies added: ChasingBottoms, containers

Dependency ranges changed: QuickCheck, base, test-framework, test-framework-quickcheck2

API changes (from Hackage documentation)

+ Data.IntMap.Lazy: foldMapWithKey :: Monoid m => (Key -> a -> m) -> IntMap a -> m
+ Data.IntMap.Strict: foldMapWithKey :: Monoid m => (Key -> a -> m) -> IntMap a -> m
+ Data.Map.Lazy: foldMapWithKey :: Monoid m => (k -> a -> m) -> Map k a -> m
+ Data.Map.Strict: foldMapWithKey :: Monoid m => (k -> a -> m) -> Map k a -> m

Files

Data/IntMap.hs view
@@ -59,44 +59,26 @@     ) where  import Prelude hiding (lookup,map,filter,foldr,foldl,null)-import Data.IntMap.Base (IntMap(..), join, nomatch, zero)+import qualified Data.IntMap.Strict as Strict import Data.IntMap.Lazy  -- | /Deprecated./ As of version 0.5, replaced by -- 'Data.IntMap.Strict.insertWith'. -- -- /O(log n)/. Same as 'insertWith', but the result of the combining function--- is evaluated to WHNF before inserted to the map. In contrast to--- 'Data.IntMap.Strict.insertWith', the value argument is not evaluted when not--- needed by the combining function.+-- is evaluated to WHNF before inserted to the map.  insertWith' :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a--- We do not reuse Data.IntMap.Strict.insertWith, because it is stricter -- it--- forces evaluation of the given value.-insertWith' f k x t-  = insertWithKey' (\_ x' y' -> f x' y') k x t+insertWith' = Strict.insertWith  -- | /Deprecated./ As of version 0.5, replaced by -- 'Data.IntMap.Strict.insertWithKey'. -- -- /O(log n)/. Same as 'insertWithKey', but the result of the combining--- function is evaluated to WHNF before inserted to the map. In contrast to--- 'Data.IntMap.Strict.insertWithKey', the value argument is not evaluted when--- not needed by the combining function.+-- function is evaluated to WHNF before inserted to the map.  insertWithKey' :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a--- We do not reuse Data.IntMap.Strict.insertWithKey, because it is stricter -- it--- forces evaluation of the given value.-insertWithKey' f k x t = k `seq`-  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' = Strict.insertWithKey  -- | /Deprecated./ As of version 0.5, replaced by 'foldr'. --
Data/IntMap/Base.hs view
@@ -123,6 +123,8 @@     , foldl     , foldrWithKey     , foldlWithKey+    , foldMapWithKey+     -- ** Strict folds     , foldr'     , foldl'@@ -295,17 +297,24 @@     mconcat = unions  instance Foldable.Foldable IntMap where-  fold Nil = mempty-  fold (Tip _ v) = v-  fold (Bin _ _ l r) = Foldable.fold l `mappend` Foldable.fold r+  fold t = go t+    where go Nil = mempty+          go (Tip _ v) = v+          go (Bin _ _ l r) = go l `mappend` go r+  {-# INLINABLE fold #-}   foldr = foldr+  {-# INLINE foldr #-}   foldl = foldl-  foldMap _ Nil = mempty-  foldMap f (Tip _k v) = f v-  foldMap f (Bin _ _ l r) = Foldable.foldMap f l `mappend` Foldable.foldMap f r+  {-# INLINE foldl #-}+  foldMap f t = go t+    where go Nil = mempty+          go (Tip _ v) = f v+          go (Bin _ _ l r) = go l `mappend` go r+  {-# INLINE foldMap #-}  instance Traversable IntMap where     traverse f = traverseWithKey (\_ -> f)+    {-# INLINE traverse #-}  instance NFData a => NFData (IntMap a) where     rnf Nil = ()@@ -1250,13 +1259,13 @@ -- -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')]) -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')])           == Nothing-{-# INLINE traverseWithKey #-} traverseWithKey :: Applicative t => (Key -> a -> t b) -> IntMap a -> t (IntMap b) traverseWithKey f = go   where     go Nil = pure Nil     go (Tip k v) = Tip k <$> f k v     go (Bin p m l r) = Bin p m <$> go l <*> go r+{-# INLINE traverseWithKey #-}  -- | /O(n)/. The function @'mapAccum'@ threads an accumulating -- argument through the map in ascending order of keys.@@ -1669,6 +1678,19 @@     go z' (Tip kx x)    = f z' kx x     go z' (Bin _ _ l r) = go (go z' l) r {-# INLINE foldlWithKey' #-}++-- | /O(n)/. Fold the keys and values in the map using the given monoid, such that+--+-- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@+--+-- This can be an asymptotically faster than 'foldrWithKey' or 'foldlWithKey' for some monoids.+foldMapWithKey :: Monoid m => (Key -> a -> m) -> IntMap a -> m+foldMapWithKey f = go+  where+    go Nil           = mempty+    go (Tip kx x)    = f kx x+    go (Bin _ _ l r) = go l `mappend` go r+{-# INLINE foldMapWithKey #-}  {--------------------------------------------------------------------   List variations
Data/IntMap/Lazy.hs view
@@ -133,6 +133,8 @@     , IM.foldl     , foldrWithKey     , foldlWithKey+    , foldMapWithKey+     -- ** Strict folds     , foldr'     , foldl'
Data/IntMap/Strict.hs view
@@ -139,6 +139,8 @@     , foldl     , foldrWithKey     , foldlWithKey+    , foldMapWithKey+     -- ** Strict folds     , foldr'     , foldl'@@ -261,14 +263,13 @@ -- -- This module satisfies the following strictness properties: ----- 1. Key and value arguments are evaluated to WHNF;+-- 1. Key arguments are evaluated to WHNF; -- -- 2. Keys and values are evaluated to WHNF before they are stored in --    the map. ----- Here are some examples that illustrate the first property:+-- Here's an example illustrating the first property: ----- > insertWith (\ new old -> old) k undefined m  ==  undefined -- > delete undefined m  ==  undefined -- -- Here are some examples that illustrate the second property:@@ -289,7 +290,7 @@  -- See IntMap.Base.Note: Local 'go' functions and capturing] findWithDefault :: a -> Key -> IntMap a -> a-findWithDefault def k = def `seq` k `seq` go+findWithDefault def k = k `seq` go   where     go (Bin p m l r) | nomatch k p m = def                      | zero k m  = go l@@ -365,16 +366,16 @@ -- in the result of @f@.  insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a-insertWithKey f k x t = k `seq` x `seq`+insertWithKey f k x t = k `seq`   case t of     Bin p m l r-      | nomatch k p m -> join k (Tip k x) p t+      | nomatch k p m -> join k (singleton 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+      | otherwise     -> join k (singleton k x) ky t+    Nil -> singleton k x  -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@) -- is a pair where the first element is equal to (@'lookup' k map@)@@ -392,18 +393,18 @@ -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])  insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)-insertLookupWithKey f0 k0 x0 t0 = k0 `seq` x0 `seq` toPair $ go f0 k0 x0 t0+insertLookupWithKey f0 k0 x0 t0 = k0 `seq` toPair $ go f0 k0 x0 t0   where     go f k x t =       case t of         Bin p m l r-          | nomatch k p m -> Nothing :*: join k (Tip k x) p t+          | nomatch k p m -> Nothing :*: join k (singleton k x) p t           | zero k m      -> let (found :*: l') = go f k x l in (found :*: Bin p m l' r)           | otherwise     -> let (found :*: r') = go 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+          | otherwise     -> (Nothing :*: join k (singleton k x) ky t)+        Nil -> Nothing :*: (singleton k x)   {--------------------------------------------------------------------
Data/Map.hs view
@@ -12,17 +12,16 @@ -- Stability   :  provisional -- Portability :  portable --+-- /Note:/ You should use "Data.Map.Strict" instead of this module if:+--+-- * You will eventually need all the values stored.+--+-- * The stored values don't represent large virtual data structures+-- to be lazily computed.+-- -- An efficient implementation of ordered maps from keys to values -- (dictionaries). ----- This module re-exports the value lazy "Data.Map.Lazy" API, plus--- several deprecated value strict functions. Please note that these functions--- have different strictness properties than those in "Data.Map.Strict":--- they only evaluate the values inserted into the map. For example, the--- default value to 'insertWith'' is only evaluated if it's used, i.e. because--- there's no value for the key already or because the higher-order argument--- that combines the old and new value uses it.--- -- These modules are intended to be imported qualified, to avoid name -- clashes with Prelude functions, e.g. --@@ -57,15 +56,13 @@     ) where  import Prelude hiding (foldr)-import Data.Map.Base (Map(..), balanceL, balanceR) import Data.Map.Lazy-import Data.StrictPair+import qualified Data.Map.Strict as Strict  -- | /Deprecated./ As of version 0.5, replaced by 'Data.Map.Strict.insertWith'. -- -- /O(log n)/. Same as 'insertWith', but the value being inserted to the map is--- evaluated to WHNF beforehand. In contrast to 'Data.Map.Strict.insertWith',--- the value argument is not evaluted when not needed.+-- evaluated to WHNF beforehand. -- -- For example, to update a counter: --@@ -73,12 +70,7 @@ --  insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a--- We do not reuse Data.Map.Strict.insertWith, because it is stricter -- it--- forces evaluation of the given value. Some people depend on the original--- behaviour, which forces only the key and the result of combining function.--- Particularly, people use insertWith' as a strict version of adjust, which--- requires to use undefined in the place of the value.-insertWith' f = insertWithKey' (\_ x' y' -> f x' y')+insertWith' = Strict.insertWith #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE insertWith' #-} #else@@ -89,23 +81,12 @@ -- 'Data.Map.Strict.insertWithKey'. -- -- /O(log n)/. Same as 'insertWithKey', but the value being inserted to the map is--- evaluated to WHNF beforehand. In contrast to 'Data.Map.Strict.insertWithKey',--- the value argument is not evaluted when not needed.+-- evaluated to WHNF beforehand.  insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a -- We do not reuse Data.Map.Strict.insertWithKey, because it is stricter -- it -- forces evaluation of the given value.-insertWithKey' = go-  where-    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a-    go _ kx _ _ | kx `seq` False = undefined-    go _ kx x Tip = x `seq` singleton kx x-    go f kx x (Bin sy ky y l r) =-        case compare kx ky of-            LT -> balanceL ky y (go f kx x l) r-            GT -> balanceR ky y l (go f kx x r)-            EQ -> let x' = f kx x y-                  in x' `seq` Bin sy kx x' l r+insertWithKey' = Strict.insertWithKey #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE insertWithKey' #-} #else@@ -116,27 +97,13 @@ -- 'Data.Map.Strict.insertLookupWithKey'. -- -- /O(log n)/. Same as 'insertLookupWithKey', but the value being inserted to--- the map is evaluated to WHNF beforehand. In contrast to--- 'Data.Map.Strict.insertLookupWithKey', the value argument is not evaluted--- when not needed.+-- the map is evaluated to WHNF beforehand.  insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a                      -> (Maybe a, Map k a) -- We do not reuse Data.Map.Strict.insertLookupWithKey, because it is stricter -- it -- forces evaluation of the given value.-insertLookupWithKey' f0 kx0 x0 t0 = toPair $ go f0 kx0 x0 t0-  where-    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)-    go _ kx _ _ | kx `seq` False = undefined-    go _ kx x Tip = x `seq` Nothing :*: singleton kx x-    go f kx x (Bin sy ky y l r) =-        case compare kx ky of-            LT -> let (found :*: l') = go f kx x l-                  in found :*: balanceL ky y l' r-            GT -> let (found :*: r') = go f kx x r-                  in found :*: balanceR ky y l r'-            EQ -> let x' = f kx x y-                  in x' `seq` (Just y :*: Bin sy kx x' l r)+insertLookupWithKey' = Strict.insertLookupWithKey #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE insertLookupWithKey' #-} #else
Data/Map/Base.hs view
@@ -169,6 +169,8 @@     , foldl     , foldrWithKey     , foldlWithKey+    , foldMapWithKey+     -- ** Strict folds     , foldr'     , foldl'@@ -1654,13 +1656,13 @@ -- -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')]) -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')])           == Nothing-{-# INLINE traverseWithKey #-} traverseWithKey :: Applicative t => (k -> a -> t b) -> Map k a -> t (Map k b) traverseWithKey f = go   where     go Tip = pure Tip-    go (Bin s k v l r)-      = flip (Bin s k) <$> go l <*> f k v <*> go r+    go (Bin 1 k v _ _) = (\v' -> Bin 1 k v' Tip Tip) <$> f k v+    go (Bin s k v l r) = flip (Bin s k) <$> go l <*> f k v <*> go r+{-# INLINE traverseWithKey #-}  -- | /O(n)/. The function 'mapAccum' threads an accumulating -- argument through the map in ascending order of keys.@@ -1873,6 +1875,19 @@     go z' (Bin _ kx x l r) = go (f (go z' l) kx x) r {-# INLINE foldlWithKey' #-} +-- | /O(n)/. Fold the keys and values in the map using the given monoid, such that+--+-- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@+--+-- This can be an asymptotically faster than 'foldrWithKey' or 'foldlWithKey' for some monoids.+foldMapWithKey :: Monoid m => (k -> a -> m) -> Map k a -> m+foldMapWithKey f = go+  where+    go Tip             = mempty+    go (Bin 1 k v _ _) = f k v+    go (Bin _ k v l r) = go l `mappend` (f k v `mappend` go r)+{-# INLINE foldMapWithKey #-}+ {--------------------------------------------------------------------   List variations --------------------------------------------------------------------}@@ -2601,14 +2616,23 @@  instance Traversable (Map k) where   traverse f = traverseWithKey (\_ -> f)+  {-# INLINE traverse #-}  instance Foldable.Foldable (Map k) where-  fold Tip = mempty-  fold (Bin _ _ v l r) = Foldable.fold l `mappend` v `mappend` Foldable.fold r+  fold t = go t+    where go Tip = mempty+          go (Bin 1 _ v _ _) = v+          go (Bin _ _ v l r) = go l `mappend` (v `mappend` go r)+  {-# INLINABLE fold #-}   foldr = foldr+  {-# INLINE foldr #-}   foldl = foldl-  foldMap _ Tip = mempty-  foldMap f (Bin _ _ v l r) = Foldable.foldMap f l `mappend` f v `mappend` Foldable.foldMap f r+  {-# INLINE foldl #-}+  foldMap f t = go t+    where go Tip = mempty+          go (Bin 1 _ v _ _) = f v+          go (Bin _ _ v l r) = go l `mappend` (f v `mappend` go r)+  {-# INLINE foldMap #-}  instance (NFData k, NFData a) => NFData (Map k a) where     rnf Tip = ()
Data/Map/Lazy.hs view
@@ -129,6 +129,8 @@     , M.foldl     , foldrWithKey     , foldlWithKey+    , foldMapWithKey+     -- ** Strict folds     , foldr'     , foldl'
Data/Map/Strict.hs view
@@ -136,6 +136,8 @@     , foldl     , foldrWithKey     , foldlWithKey+    , foldMapWithKey+     -- ** Strict folds     , foldr'     , foldl'@@ -279,20 +281,19 @@ #define STRICT_1_OF_3(fn) fn arg _ _ | arg `seq` False = undefined #define STRICT_2_OF_3(fn) fn _ arg _ | arg `seq` False = undefined #define STRICT_1_2_OF_3(fn) fn arg1 arg2 _ | arg1 `seq` arg2 `seq` False = undefined-#define STRICT_2_3_OF_4(fn) fn _ arg1 arg2 _ | arg1 `seq` arg2 `seq` False = undefined+#define STRICT_2_OF_4(fn) fn _ arg _ _ | arg `seq` False = undefined  -- $strictness -- -- This module satisfies the following strictness properties: ----- 1. Key and value arguments are evaluated to WHNF;+-- 1. Key arguments are evaluated to WHNF; -- -- 2. Keys and values are evaluated to WHNF before they are stored in --    the map. ----- Here are some examples that illustrate the first property:+-- Here's an example illustrating the first property: ----- > insertWith (\ new old -> old) k undefined m  ==  undefined -- > delete undefined m  ==  undefined -- -- Here are some examples that illustrate the second property:@@ -313,7 +314,7 @@  -- See Map.Base.Note: Local 'go' functions and capturing findWithDefault :: Ord k => a -> k -> Map k a -> a-findWithDefault def k = def `seq` k `seq` go+findWithDefault def k = k `seq` go   where     go Tip = def     go (Bin _ kx x l r) = case compare k kx of@@ -404,7 +405,7 @@ insertWithKey = go   where     go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a-    STRICT_2_3_OF_4(go)+    STRICT_2_OF_4(go)     go _ kx x Tip = singleton kx x     go f kx x (Bin sy ky y l r) =         case compare kx ky of@@ -440,7 +441,7 @@ insertLookupWithKey f0 kx0 x0 t0 = toPair $ go f0 kx0 x0 t0   where     go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)-    STRICT_2_3_OF_4(go)+    STRICT_2_OF_4(go)     go _ kx x Tip = Nothing :*: singleton kx x     go f kx x (Bin sy ky y l r) =         case compare kx ky of
Data/Set/Base.hs view
@@ -234,12 +234,20 @@     mconcat = unions  instance Foldable.Foldable Set where-    fold Tip = mempty-    fold (Bin _ k l r) = Foldable.fold l `mappend` k `mappend` Foldable.fold r+    fold t = go t+      where go Tip = mempty+            go (Bin 1 k _ _) = k+            go (Bin _ k l r) = go l `mappend` (k `mappend` go r)+    {-# INLINABLE fold #-}     foldr = foldr+    {-# INLINE foldr #-}     foldl = foldl-    foldMap _ Tip = mempty-    foldMap f (Bin _ k l r) = Foldable.foldMap f l `mappend` f k `mappend` Foldable.foldMap f r+    {-# INLINE foldl #-}+    foldMap f t = go t+      where go Tip = mempty+            go (Bin 1 k _ _) = f k+            go (Bin _ k l r) = go l `mappend` (f k `mappend` go r)+    {-# INLINE foldMap #-}  #if __GLASGOW_HASKELL__
LICENSE view
@@ -1,22 +1,3 @@-This library (libraries/containers) is derived from code from several-sources:--  * Code from the GHC project which is largely (c) The University of-    Glasgow, and distributable under a BSD-style license (see below),--  * Code from the Haskell 98 Report which is (c) Simon Peyton Jones-    and freely redistributable (but see the full license for-    restrictions).--  * Code from the Haskell Foreign Function Interface specification,-    which is (c) Manuel M. T. Chakravarty and freely redistributable-    (but see the full license for restrictions).--The full text of these licenses is reproduced below.  All of the-licenses are BSD-style or compatible.-------------------------------------------------------------------------------- The Glasgow Haskell Compiler License  Copyright 2004, The University Court of the University of Glasgow.@@ -48,36 +29,3 @@ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.---------------------------------------------------------------------------------Code derived from the document "Report on the Programming Language-Haskell 98", is distributed under the following license:--  Copyright (c) 2002 Simon Peyton Jones--  The authors intend this Report to belong to the entire Haskell-  community, and so we grant permission to copy and distribute it for-  any purpose, provided that it is reproduced in its entirety,-  including this Notice.  Modified versions of this Report may also be-  copied and distributed for any purpose, provided that the modified-  version is clearly presented as such, and that it does not claim to-  be a definition of the Haskell 98 Language.---------------------------------------------------------------------------------Code derived from the document "The Haskell 98 Foreign Function-Interface, An Addendum to the Haskell 98 Report" is distributed under-the following license:--  Copyright (c) 2002 Manuel M. T. Chakravarty--  The authors intend this Report to belong to the entire Haskell-  community, and so we grant permission to copy and distribute it for-  any purpose, provided that it is reproduced in its entirety,-  including this Notice.  Modified versions of this Report may also be-  copied and distributed for any purpose, provided that the modified-  version is clearly presented as such, and that it does not claim to-  be a definition of the Haskell 98 Foreign Function Interface.-------------------------------------------------------------------------------
containers.cabal view
@@ -1,5 +1,5 @@ name: containers-version: 0.5.2.1+version: 0.5.3.0 license: BSD3 license-file: LICENSE maintainer: fox@ucw.cz@@ -207,3 +207,33 @@         QuickCheck,         test-framework,         test-framework-quickcheck2++test-suite map-strictness-properties+  hs-source-dirs: tests+  main-is: MapStrictness.hs+  type: exitcode-stdio-1.0++  build-depends:+    base,+    ChasingBottoms,+    containers,+    QuickCheck >= 2.4.0.1,+    test-framework >= 0.3.3,+    test-framework-quickcheck2 >= 0.2.9++  ghc-options: -Wall++test-suite intmap-strictness-properties+  hs-source-dirs: tests+  main-is: IntMapStrictness.hs+  type: exitcode-stdio-1.0++  build-depends:+    base,+    ChasingBottoms,+    containers,+    QuickCheck >= 2.4.0.1,+    test-framework >= 0.3.3,+    test-framework-quickcheck2 >= 0.2.9++  ghc-options: -Wall
include/Typeable.h view
@@ -20,9 +20,15 @@ --  // generate the instances.  #define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon+#if __GLASGOW_HASKELL__ >= 707+#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable tycon+#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable tycon+#define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable tycon+#else #define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable1 tycon #define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable2 tycon #define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable3 tycon+#endif  #else /* !__GLASGOW_HASKELL__ */
+ tests/IntMapStrictness.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where++import Test.ChasingBottoms.IsBottom+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Arbitrary(arbitrary))++import Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as M++instance Arbitrary v => Arbitrary (IntMap v) where+    arbitrary = M.fromList `fmap` arbitrary++instance Show (Int -> Int) where+    show _ = "<function>"++instance Show (Int -> Int -> Int) where+    show _ = "<function>"++instance Show (Int -> Int -> Int -> Int) where+    show _ = "<function>"++------------------------------------------------------------------------+-- * Properties++------------------------------------------------------------------------+-- ** Strict module++pSingletonKeyStrict :: Int -> Bool+pSingletonKeyStrict v = isBottom $ M.singleton (bottom :: Int) v++pSingletonValueStrict :: Int -> Bool+pSingletonValueStrict k = isBottom $ (M.singleton k (bottom :: Int))++pFindWithDefaultKeyStrict :: Int -> IntMap Int -> Bool+pFindWithDefaultKeyStrict def m = isBottom $ M.findWithDefault def bottom m++pFindWithDefaultValueStrict :: Int -> IntMap Int -> Bool+pFindWithDefaultValueStrict k m =+    M.member k m || (isBottom $ M.findWithDefault bottom k m)++pAdjustKeyStrict :: (Int -> Int) -> IntMap Int -> Bool+pAdjustKeyStrict f m = isBottom $ M.adjust f bottom m++pAdjustValueStrict :: Int -> IntMap Int -> Bool+pAdjustValueStrict k m+    | k `M.member` m = isBottom $ M.adjust (const bottom) k m+    | otherwise       = case M.keys m of+        []     -> True+        (k':_) -> isBottom $ M.adjust (const bottom) k' m++pInsertKeyStrict :: Int -> IntMap Int -> Bool+pInsertKeyStrict v m = isBottom $ M.insert bottom v m++pInsertValueStrict :: Int -> IntMap Int -> Bool+pInsertValueStrict k m = isBottom $ M.insert k bottom m++pInsertWithKeyStrict :: (Int -> Int -> Int) -> Int -> IntMap Int -> Bool+pInsertWithKeyStrict f v m = isBottom $ M.insertWith f bottom v m++pInsertWithValueStrict :: (Int -> Int -> Int) -> Int -> Int -> IntMap Int+                       -> Bool+pInsertWithValueStrict f k v m+    | M.member k m = (isBottom $ M.insertWith (const2 bottom) k v m) &&+                     not (isBottom $ M.insertWith (const2 1) k bottom m)+    | otherwise    = isBottom $ M.insertWith f k bottom m++pInsertLookupWithKeyKeyStrict :: (Int -> Int -> Int -> Int) -> Int -> IntMap Int+                              -> Bool+pInsertLookupWithKeyKeyStrict f v m = isBottom $ M.insertLookupWithKey f bottom v m++pInsertLookupWithKeyValueStrict :: (Int -> Int -> Int -> Int) -> Int -> Int+                                -> IntMap Int -> Bool+pInsertLookupWithKeyValueStrict f k v m+    | M.member k m = (isBottom $ M.insertLookupWithKey (const3 bottom) k v m) &&+                     not (isBottom $ M.insertLookupWithKey (const3 1) k bottom m)+    | otherwise    = isBottom $ M.insertLookupWithKey f k bottom m++------------------------------------------------------------------------+-- * Test list++tests :: [Test]+tests =+    [+    -- Basic interface+      testGroup "IntMap.Strict"+      [ testProperty "singleton is key-strict" pSingletonKeyStrict+      , testProperty "singleton is value-strict" pSingletonValueStrict+      , testProperty "member is key-strict" $ keyStrict M.member+      , testProperty "lookup is key-strict" $ keyStrict M.lookup+      , testProperty "findWithDefault is key-strict" pFindWithDefaultKeyStrict+      , testProperty "findWithDefault is value-strict" pFindWithDefaultValueStrict+      , testProperty "! is key-strict" $ keyStrict (flip (M.!))+      , testProperty "delete is key-strict" $ keyStrict M.delete+      , testProperty "adjust is key-strict" pAdjustKeyStrict+      , testProperty "adjust is value-strict" pAdjustValueStrict+      , testProperty "insert is key-strict" pInsertKeyStrict+      , testProperty "insert is value-strict" pInsertValueStrict+      , testProperty "insertWith is key-strict" pInsertWithKeyStrict+      , testProperty "insertWith is value-strict" pInsertWithValueStrict+      , testProperty "insertLookupWithKey is key-strict"+        pInsertLookupWithKeyKeyStrict+      , testProperty "insertLookupWithKey is value-strict"+        pInsertLookupWithKeyValueStrict+      ]+    ]++------------------------------------------------------------------------+-- * Test harness++main :: IO ()+main = defaultMain tests++------------------------------------------------------------------------+-- * Utilities++keyStrict :: (Int -> IntMap Int -> a) -> IntMap Int -> Bool+keyStrict f m = isBottom $ f bottom m++const2 :: a -> b -> c -> a+const2 x _ _ = x++const3 :: a -> b -> c -> d -> a+const3 x _ _ _ = x
+ tests/MapStrictness.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where++import Test.ChasingBottoms.IsBottom+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Arbitrary(arbitrary))++import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M++instance (Arbitrary k, Arbitrary v, Eq k, Ord k) =>+         Arbitrary (Map k v) where+    arbitrary = M.fromList `fmap` arbitrary++instance Show (Int -> Int) where+    show _ = "<function>"++instance Show (Int -> Int -> Int) where+    show _ = "<function>"++instance Show (Int -> Int -> Int -> Int) where+    show _ = "<function>"++------------------------------------------------------------------------+-- * Properties++------------------------------------------------------------------------+-- ** Strict module++pSingletonKeyStrict :: Int -> Bool+pSingletonKeyStrict v = isBottom $ M.singleton (bottom :: Int) v++pSingletonValueStrict :: Int -> Bool+pSingletonValueStrict k = isBottom $ (M.singleton k (bottom :: Int))++pFindWithDefaultKeyStrict :: Int -> Map Int Int -> Bool+pFindWithDefaultKeyStrict def m = isBottom $ M.findWithDefault def bottom m++pFindWithDefaultValueStrict :: Int -> Map Int Int -> Bool+pFindWithDefaultValueStrict k m =+    M.member k m || (isBottom $ M.findWithDefault bottom k m)++pAdjustKeyStrict :: (Int -> Int) -> Map Int Int -> Bool+pAdjustKeyStrict f m = isBottom $ M.adjust f bottom m++pAdjustValueStrict :: Int -> Map Int Int -> Bool+pAdjustValueStrict k m+    | k `M.member` m = isBottom $ M.adjust (const bottom) k m+    | otherwise       = case M.keys m of+        []     -> True+        (k':_) -> isBottom $ M.adjust (const bottom) k' m++pInsertKeyStrict :: Int -> Map Int Int -> Bool+pInsertKeyStrict v m = isBottom $ M.insert bottom v m++pInsertValueStrict :: Int -> Map Int Int -> Bool+pInsertValueStrict k m = isBottom $ M.insert k bottom m++pInsertWithKeyStrict :: (Int -> Int -> Int) -> Int -> Map Int Int -> Bool+pInsertWithKeyStrict f v m = isBottom $ M.insertWith f bottom v m++pInsertWithValueStrict :: (Int -> Int -> Int) -> Int -> Int -> Map Int Int+                       -> Bool+pInsertWithValueStrict f k v m+    | M.member k m = (isBottom $ M.insertWith (const2 bottom) k v m) &&+                     not (isBottom $ M.insertWith (const2 1) k bottom m)+    | otherwise    = isBottom $ M.insertWith f k bottom m++pInsertLookupWithKeyKeyStrict :: (Int -> Int -> Int -> Int) -> Int+                              -> Map Int Int -> Bool+pInsertLookupWithKeyKeyStrict f v m = isBottom $ M.insertLookupWithKey f bottom v m++pInsertLookupWithKeyValueStrict :: (Int -> Int -> Int -> Int) -> Int -> Int+                                -> Map Int Int -> Bool+pInsertLookupWithKeyValueStrict f k v m+    | M.member k m = (isBottom $ M.insertLookupWithKey (const3 bottom) k v m) &&+                     not (isBottom $ M.insertLookupWithKey (const3 1) k bottom m)+    | otherwise    = isBottom $ M.insertLookupWithKey f k bottom m++------------------------------------------------------------------------+-- * Test list++tests :: [Test]+tests =+    [+    -- Basic interface+      testGroup "Map.Strict"+      [ testProperty "singleton is key-strict" pSingletonKeyStrict+      , testProperty "singleton is value-strict" pSingletonValueStrict+      , testProperty "member is key-strict" $ keyStrict M.member+      , testProperty "lookup is key-strict" $ keyStrict M.lookup+      , testProperty "findWithDefault is key-strict" pFindWithDefaultKeyStrict+      , testProperty "findWithDefault is value-strict" pFindWithDefaultValueStrict+      , testProperty "! is key-strict" $ keyStrict (flip (M.!))+      , testProperty "delete is key-strict" $ keyStrict M.delete+      , testProperty "adjust is key-strict" pAdjustKeyStrict+      , testProperty "adjust is value-strict" pAdjustValueStrict+      , testProperty "insert is key-strict" pInsertKeyStrict+      , testProperty "insert is value-strict" pInsertValueStrict+      , testProperty "insertWith is key-strict" pInsertWithKeyStrict+      , testProperty "insertWith is value-strict" pInsertWithValueStrict+      , testProperty "insertLookupWithKey is key-strict"+        pInsertLookupWithKeyKeyStrict+      , testProperty "insertLookupWithKey is value-strict"+        pInsertLookupWithKeyValueStrict+      ]+    ]++------------------------------------------------------------------------+-- * Test harness++main :: IO ()+main = defaultMain tests++------------------------------------------------------------------------+-- * Utilities++keyStrict :: (Int -> Map Int Int -> a) -> Map Int Int -> Bool+keyStrict f m = isBottom $ f bottom m++const2 :: a -> b -> c -> a+const2 x _ _ = x++const3 :: a -> b -> c -> d -> a+const3 x _ _ _ = x