Revert to the original strictness properties of...
authorMilan Straka <fox@ucw.cz>
Sat, 10 Nov 2012 20:47:36 +0000 (21:47 +0100)
committerMilan Straka <fox@ucw.cz>
Sun, 11 Nov 2012 21:25:16 +0000 (22:25 +0100)
deprecated functions, notably
* Data.Map.insertWith'
* Data.Map.insertWithKey'
* Data.Map.insertLookupWithKey'
* Data.IntMap.insertWith'
* Data.IntMap.insertWithKey'
The original behaviour was _not_ to evaluate the given value. Some
people are depending on this, using insertWith' as a strict version of
adjust -- undefined has to be passed as a value in that case.

Data/IntMap.hs
Data/Map.hs

index 5be3c13..8a5bc6b 100644 (file)
 -- (dictionaries).
 --
 -- This module re-exports the value lazy 'Data.IntMap.Lazy' API, plus
--- several value strict functions from 'Data.IntMap.Strict'.
+-- several obsolete value strict functions. Please note that these functions
+-- have different strictness properties than those in "Data.IntMap.Strict":
+-- they only evaluate the result of the combining function. For example, the
+-- default value to 'insertWith'' is only evaluated if the combining function
+-- is called and uses it.
 --
 -- These modules are intended to be imported qualified, to avoid name
 -- clashes with Prelude functions, e.g.
@@ -55,26 +59,44 @@ module Data.IntMap
     ) where
 
 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
+import Data.IntMap.Base (IntMap(..), join, nomatch, zero)
 import Data.IntMap.Lazy
-import qualified Data.IntMap.Strict as S
 
--- | /Deprecated./ As of version 0.5, replaced by 'S.insertWith'.
+-- | /Deprecated./ As of version 0.5, replaced by
+-- 'Data.IntMap.Strict.insertWith'.
 --
--- /O(log n)/. Same as 'insertWith', but the combining function is
--- applied strictly.  This function is deprecated, use 'insertWith' in
--- "Data.IntMap.Strict" instead.
+-- /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.
+
 insertWith' :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWith' = S.insertWith
-{-# INLINE insertWith' #-}
+-- 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
 
--- | /Deprecated./ As of version 0.5, replaced by 'S.insertWithKey'.
+-- | /Deprecated./ As of version 0.5, replaced by
+-- 'Data.IntMap.Strict.insertWithKey'.
 --
--- /O(log n)/. Same as 'insertWithKey', but the combining function is
--- applied strictly.  This function is deprecated, use 'insertWithKey'
--- in "Data.IntMap.Strict" instead.
+-- /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.
+
 insertWithKey' :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWithKey' = S.insertWithKey
-{-# INLINE insertWithKey' #-}
+-- 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
 
 -- | /Deprecated./ As of version 0.5, replaced by 'foldr'.
 --
index 910dc40..56a4239 100644 (file)
 -- (dictionaries).
 --
 -- This module re-exports the value lazy 'Data.Map.Lazy' API, plus
--- several value strict functions from 'Data.Map.Strict'.
+-- several obsolete 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.
@@ -51,50 +56,103 @@ module Data.Map
     , foldWithKey
     ) where
 
+import Prelude hiding (foldr)
+import Data.Map.Base (Map(..), balanceL, balanceR)
 import Data.Map.Lazy
-import qualified Data.Map.Lazy as L
-import qualified Data.Map.Strict as S
+import Data.StrictPair
 
--- | /Deprecated./ As of version 0.5, replaced by 'S.insertWith'.
+-- | /Deprecated./ As of version 0.5, replaced by 'Data.Map.Strict.insertWith'.
 --
--- /O(log n)/. Same as 'insertWith', but the combining function is
--- applied strictly.  This is often the most desirable behavior.
+-- /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.
 --
 -- For example, to update a counter:
 --
 -- > insertWith' (+) k 1 m
 --
+
 insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWith' = S.insertWith
+-- 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')
+#if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE insertWith' #-}
+#else
+{-# INLINE insertWith' #-}
+#endif
 
--- | /Deprecated./ As of version 0.5, replaced by 'S.insertWithKey'.
+-- | /Deprecated./ As of version 0.5, replaced by
+-- 'Data.Map.Strict.insertWithKey'.
 --
--- /O(log n)/. Same as 'insertWithKey', but the combining function is
--- applied strictly.
+-- /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.
+
 insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWithKey' = S.insertWithKey
+-- 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
+#if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE insertWithKey' #-}
+#else
+{-# INLINE insertWithKey' #-}
+#endif
 
 -- | /Deprecated./ As of version 0.5, replaced by
--- 'S.insertLookupWithKey'.
+-- 'Data.Map.Strict.insertLookupWithKey'.
 --
--- /O(log n)/. A strict version of '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.
+
 insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a
                      -> (Maybe a, Map k a)
-insertLookupWithKey' = S.insertLookupWithKey
+-- 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)
+#if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE insertLookupWithKey' #-}
+#else
+{-# INLINE insertLookupWithKey' #-}
+#endif
 
--- | /Deprecated./ As of version 0.5, replaced by 'L.foldr'.
+-- | /Deprecated./ As of version 0.5, replaced by 'foldr'.
 --
 -- /O(n)/. Fold the values in the map using the given right-associative
 -- binary operator. This function is an equivalent of 'foldr' and is present
 -- for compatibility only.
 fold :: (a -> b -> b) -> b -> Map k a -> b
-fold = L.foldr
+fold = foldr
 {-# INLINE fold #-}
 
--- | /Deprecated./ As of version 0.4, replaced by 'L.foldrWithKey'.
+-- | /Deprecated./ As of version 0.4, replaced by 'foldrWithKey'.
 --
 -- /O(n)/. Fold the keys and values in the map using the given right-associative
 -- binary operator. This function is an equivalent of 'foldrWithKey' and is present