strict-containers 0.2 → 0.2.1

raw patch · 27 files changed

+1078/−461 lines, 27 filesdep ~QuickCheckdep ~basenew-uploader

Dependency ranges changed: QuickCheck, base

Files

• CHANGELOG.md +5/−0
• src/Data/Strict/ContainersUtils/Autogen/Prelude.hs +12/−0
• src/Data/Strict/ContainersUtils/Autogen/State.hs +3/−3
• src/Data/Strict/HashMap/Autogen/Internal.hs +194/−130
• src/Data/Strict/HashMap/Autogen/Internal/Array.hs +3/−8
• src/Data/Strict/HashMap/Autogen/Internal/Debug.hs +149/−0
• src/Data/Strict/HashMap/Autogen/Internal/List.hs +2/−2
• src/Data/Strict/HashMap/Autogen/Internal/Strict.hs +35/−28
• src/Data/Strict/IntMap/Autogen/Internal.hs +182/−28
• src/Data/Strict/IntMap/Autogen/Strict.hs +4/−0
• src/Data/Strict/IntMap/Autogen/Strict/Internal.hs +66/−6
• src/Data/Strict/Map/Autogen/Internal.hs +151/−69
• src/Data/Strict/Map/Autogen/Internal/Debug.hs +3/−3
• src/Data/Strict/Map/Autogen/Internal/DeprecatedShowTree.hs +1/−9
• src/Data/Strict/Map/Autogen/Strict/Internal.hs +86/−42
• src/Data/Strict/Sequence/Autogen.hs +0/−1
• src/Data/Strict/Sequence/Autogen/Internal.hs +21/−15
• src/Data/Strict/Vector/Autogen.hs +25/−19
• src/Data/Strict/Vector/Autogen/Internal/Check.hs +4/−1
• src/Data/Strict/Vector/Autogen/Mutable.hs +7/−2
• strict-containers.cabal +34/−29
• tests/Tests/Bundle.hs +1/−0
• tests/Tests/Vector/Property.hs +2/−0
• tests/Utilities.hs +35/−51
• tests/intmap-properties.hs +35/−1
• tests/map-properties.hs +17/−13
• tests/seq-properties.hs +1/−1

@@ -1,5 +1,10 @@ # Revision history for strict-containers +## 0.2.1 -- 2024-08-05++- Update to containers v0.6.7, unordered-containers v0.2.20, vector+  v0.13.1.0. Includes support for GHC 9.10.+ ## 0.2 -- 2022-12-12  - Update to containers v0.6.6, unordered-containers v0.2.19.1, vector

@@ -0,0 +1,12 @@+-- | This hideous module lets us avoid dealing with the fact that+-- @liftA2@ and @foldl'@ were not previously exported from the standard prelude.+module Data.Strict.ContainersUtils.Autogen.Prelude+  ( module Prelude+  , Applicative (..)+  , Foldable (..)+  )+  where++import Prelude hiding (Applicative(..), Foldable(..))+import Control.Applicative(Applicative(..))+import Data.Foldable (Foldable(elem, foldMap, foldr, foldl, foldl', foldr1, foldl1, maximum, minimum, product, sum, null, length))

@@ -6,7 +6,9 @@ module Data.Strict.ContainersUtils.Autogen.State where  import Control.Monad (ap, liftM2)-import Control.Applicative (Applicative(..), liftA)+import Control.Applicative (liftA)+import Data.Strict.ContainersUtils.Autogen.Prelude+import Prelude ()  newtype State s a = State {runState :: s -> (s, a)} @@ -26,9 +28,7 @@     (<*>) = ap     m *> n = State $ \s -> case runState m s of       (s', _) -> runState n s'-#if MIN_VERSION_base(4,10,0)     liftA2 = liftM2-#endif  execState :: State s a -> s -> a execState m x = snd (runState m x)

@@ -107,16 +107,21 @@     , fromListWith     , fromListWithKey -      -- Internals used by the strict version+      -- ** Internals used by the strict version     , Hash     , Bitmap+    , Shift     , bitmapIndexedOrFull     , collision     , hash     , mask     , index     , bitsPerSubkey-    , fullNodeMask+    , maxChildren+    , isLeafOrCollision+    , fullBitmap+    , subkeyMask+    , nextShift     , sparseIndex     , two     , unionArrayBy@@ -129,6 +134,7 @@     , equalKeys1     , lookupRecordCollision     , LookupRes(..)+    , lookupResToMaybe     , insert'     , delete'     , lookup'@@ -158,8 +164,8 @@ import Data.Semigroup             (Semigroup (..), stimesIdempotentMonoid) import GHC.Exts                   (Int (..), Int#, TYPE, (==#)) import GHC.Stack                  (HasCallStack)-import Prelude                    hiding (filter, foldl, foldr, lookup, map,-                                   null, pred)+import Prelude                    hiding (Foldable(..), filter, lookup, map,+                                   pred) import Text.Read                  hiding (step)  import qualified Data.Data                   as Data@@ -172,9 +178,6 @@ import qualified GHC.Exts                    as Exts import qualified Language.Haskell.TH.Syntax  as TH --- | A set of values.  A set cannot contain duplicate values.-------------------------------------------------------------------------- -- | Convenience function.  Compute a hash value for the given value. hash :: H.Hashable a => a -> Hash hash = fromIntegral . H.hash@@ -201,17 +204,46 @@ instance NFData2 Leaf where     liftRnf2 rnf1 rnf2 (L k v) = rnf1 k `seq` rnf2 v --- Invariant: The length of the 1st argument to 'Full' is--- 2^bitsPerSubkey- -- | A map from keys to values.  A map cannot contain duplicate keys; -- each key can map to at most one value. data HashMap k v     = Empty+    -- ^ Invariants:+    --+    -- * 'Empty' is not a valid sub-node. It can only appear at the root. (INV1)     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))+    -- ^ Invariants:+    --+    -- * Only the lower @maxChildren@ bits of the 'Bitmap' may be set. The+    --   remaining upper bits must be 0. (INV2)+    -- * The array of a 'BitmapIndexed' node stores at least 1 and at most+    --   @'maxChildren' - 1@ sub-nodes. (INV3)+    -- * The number of sub-nodes is equal to the number of 1-bits in its+    --   'Bitmap'. (INV4)+    -- * If a 'BitmapIndexed' node has only one sub-node, this sub-node must+    --   be a 'BitmapIndexed' or a 'Full' node. (INV5)     | Leaf !Hash !(Leaf k v)+    -- ^ Invariants:+    --+    -- * The location of a 'Leaf' or 'Collision' node in the tree must be+    --   compatible with its 'Hash'. (INV6)+    --   (TODO: Document this properly (#425))+    -- * The 'Hash' of a 'Leaf' node must be the 'hash' of its key. (INV7)     | Full !(A.Array (HashMap k v))+    -- ^ Invariants:+    --+    -- * The array of a 'Full' node stores exactly 'maxChildren' sub-nodes. (INV8)     | Collision !Hash !(A.Array (Leaf k v))+    -- ^ Invariants:+    --+    -- * The location of a 'Leaf' or 'Collision' node in the tree must be+    --   compatible with its 'Hash'. (INV6)+    --   (TODO: Document this properly (#425))+    -- * The array of a 'Collision' node must contain at least two sub-nodes. (INV9)+    -- * The 'hash' of each key in a 'Collision' node must be the one stored in+    --   the node. (INV7)+    -- * No two keys stored in a 'Collision' can be equal according to their+    --   'Eq' instance. (INV10)  type role HashMap nominal representational @@ -314,7 +346,7 @@ -- | This type is used to store the hash of a key, as produced with 'hash'. type Hash   = Word --- | A bitmap as contained by a 'BitmapIndexed' node, or a 'fullNodeMask'+-- | A bitmap as contained by a 'BitmapIndexed' node, or a 'fullBitmap' -- corresponding to a 'Full' node. -- -- Only the lower 'maxChildren' bits are used. The remaining bits must be zeros.@@ -366,7 +398,7 @@     liftEq = equal1  -- | Note that, in the presence of hash collisions, equal @HashMap@s may--- behave differently, i.e. substitutivity may be violated:+-- behave differently, i.e. extensionality may be violated: -- -- >>> data D = A | B deriving (Eq, Show) -- >>> instance Hashable D where hashWithSalt salt _d = salt@@ -381,14 +413,11 @@ -- >>> toList y -- [(B,2),(A,1)] ----- In general, the lack of substitutivity can be observed with any function+-- In general, the lack of extensionality can be observed with any function -- that depends on the key ordering, such as folds and traversals. instance (Eq k, Eq v) => Eq (HashMap k v) where     (==) = equal1 (==) --- We rely on there being no Empty constructors in the tree!--- This ensures that two equal HashMaps will have the same--- shape, modulo the order of entries in Collisions. equal1 :: Eq k        => (v -> v' -> Bool)        -> HashMap k v -> HashMap k v' -> Bool@@ -417,8 +446,8 @@       | k1 == k2 &&         leafEq l1 l2       = go tl1 tl2-    go (Collision k1 ary1 : tl1) (Collision k2 ary2 : tl2)-      | k1 == k2 &&+    go (Collision h1 ary1 : tl1) (Collision h2 ary2 : tl2)+      | h1 == h2 &&         A.length ary1 == A.length ary2 &&         isPermutationBy leafEq (A.toList ary1) (A.toList ary2)       = go tl1 tl2@@ -447,8 +476,8 @@       = compare k1 k2 `mappend`         leafCompare l1 l2 `mappend`         go tl1 tl2-    go (Collision k1 ary1 : tl1) (Collision k2 ary2 : tl2)-      = compare k1 k2 `mappend`+    go (Collision h1 ary1 : tl1) (Collision h2 ary2 : tl2)+      = compare h1 h2 `mappend`         compare (A.length ary1) (A.length ary2) `mappend`         unorderedCompare leafCompare (A.toList ary1) (A.toList ary2) `mappend`         go tl1 tl2@@ -468,8 +497,8 @@     go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)       | k1 == k2 && leafEq l1 l2       = go tl1 tl2-    go (Collision k1 ary1 : tl1) (Collision k2 ary2 : tl2)-      | k1 == k2 && A.length ary1 == A.length ary2 &&+    go (Collision h1 ary1 : tl1) (Collision h2 ary2 : tl2)+      | h1 == h2 && A.length ary1 == A.length ary2 &&         isPermutationBy leafEq (A.toList ary1) (A.toList ary2)       = go tl1 tl2     go [] [] = True@@ -623,10 +652,15 @@   (# | (# a, _i #) #) -> Just a {-# INLINE lookup' #-} --- The result of a lookup, keeping track of if a hash collision occured.+-- The result of a lookup, keeping track of if a hash collision occurred. -- If a collision did not occur then it will have the Int value (-1). data LookupRes a = Absent | Present a !Int +lookupResToMaybe :: LookupRes a -> Maybe a+lookupResToMaybe Absent        = Nothing+lookupResToMaybe (Present x _) = Just x+{-# INLINE lookupResToMaybe #-}+ -- Internal helper for lookup. This version takes the precomputed hash so -- that functions that make multiple calls to lookup and related functions -- (insert, delete) only need to calculate the hash once.@@ -688,10 +722,10 @@     go h k s (BitmapIndexed b v)         | b .&. m == 0 = absent (# #)         | otherwise    =-            go h k (s+bitsPerSubkey) (A.index v (sparseIndex b m))+            go h k (nextShift s) (A.index v (sparseIndex b m))       where m = mask h s     go h k s (Full v) =-      go h k (s+bitsPerSubkey) (A.index v (index h s))+      go h k (nextShift s) (A.index v (index h s))     go h k _ (Collision hx v)         | h == hx   = lookupInArrayCont absent present k v         | otherwise = absent (# #)@@ -757,7 +791,7 @@ -- @unionWith[Key]@ with GHC 9.2.2. See the Core diffs in -- https://github.com/haskell-unordered-containers/unordered-containers/pull/376. bitmapIndexedOrFull b !ary-    | b == fullNodeMask = Full ary+    | b == fullBitmap = Full ary     | otherwise         = BitmapIndexed b ary {-# INLINE bitmapIndexedOrFull #-} @@ -785,7 +819,7 @@             in bitmapIndexedOrFull (b .|. m) ary'         | otherwise =             let !st  = A.index ary i-                !st' = go h k x (s+bitsPerSubkey) st+                !st' = go h k x (nextShift s) st             in if st' `ptrEq` st                then t                else BitmapIndexed b (A.update ary i st')@@ -793,7 +827,7 @@             i = sparseIndex b m     go h k x s t@(Full ary) =         let !st  = A.index ary i-            !st' = go h k x (s+bitsPerSubkey) st+            !st' = go h k x (nextShift s) st         in if st' `ptrEq` st             then t             else Full (update32 ary i st')@@ -823,13 +857,13 @@             in bitmapIndexedOrFull (b .|. m) ary'         | otherwise =             let !st  = A.index ary i-                !st' = go h k x (s+bitsPerSubkey) st+                !st' = go h k x (nextShift s) st             in BitmapIndexed b (A.update ary i st')       where m = mask h s             i = sparseIndex b m     go h k x s (Full ary) =         let !st  = A.index ary i-            !st' = go h k x (s+bitsPerSubkey) st+            !st' = go h k x (nextShift s) st         in Full (update32 ary i st')       where i = index h s     go h k x s t@(Collision hy v)@@ -843,36 +877,42 @@ -- -- It is only valid to call this when the key exists in the map and you know the -- hash collision position if there was one. This information can be obtained--- from 'lookupRecordCollision'. If there is no collision pass (-1) as collPos+-- from 'lookupRecordCollision'. If there is no collision, pass (-1) as collPos -- (first argument).------ We can skip the key equality check on a Leaf because we know the leaf must be--- for this key. insertKeyExists :: Int -> Hash -> k -> v -> HashMap k v -> HashMap k v-insertKeyExists !collPos0 !h0 !k0 x0 !m0 = go collPos0 h0 k0 x0 0 m0+insertKeyExists !collPos0 !h0 !k0 x0 !m0 = go collPos0 h0 k0 x0 m0   where-    go !_collPos !h !k x !_s (Leaf _hy _kx)+    go !_collPos !_shiftedHash !k x (Leaf h _kx)         = Leaf h (L k x)-    go collPos h k x s (BitmapIndexed b ary)-        | b .&. m == 0 =-            let !ary' = A.insert ary i $ Leaf h (L k x)-            in bitmapIndexedOrFull (b .|. m) ary'-        | otherwise =-            let !st  = A.index ary i-                !st' = go collPos h k x (s+bitsPerSubkey) st-            in BitmapIndexed b (A.update ary i st')-      where m = mask h s+    go collPos shiftedHash k x (BitmapIndexed b ary) =+        let !st  = A.index ary i+            !st' = go collPos (shiftHash shiftedHash) k x st+        in BitmapIndexed b (A.update ary i st')+      where m = mask' shiftedHash             i = sparseIndex b m-    go collPos h k x s (Full ary) =+    go collPos shiftedHash k x (Full ary) =         let !st  = A.index ary i-            !st' = go collPos h k x (s+bitsPerSubkey) st+            !st' = go collPos (shiftHash shiftedHash) k x st         in Full (update32 ary i st')-      where i = index h s-    go collPos h k x _s (Collision _hy v)+      where i = index' shiftedHash+    go collPos _shiftedHash k x (Collision h v)         | collPos >= 0 = Collision h (setAtPosition collPos k x v)         | otherwise = Empty -- error "Internal error: go {collPos negative}"-    go _ _ _ _ _ Empty = Empty -- error "Internal error: go Empty"+    go _ _ _ _ Empty = Empty -- error "Internal error: go Empty" +    -- Customized version of 'index' that doesn't require a 'Shift'.+    index' :: Hash -> Int+    index' w = fromIntegral $ w .&. subkeyMask+    {-# INLINE index' #-}++    -- Customized version of 'mask' that doesn't require a 'Shift'.+    mask' :: Word -> Bitmap+    mask' w = 1 `unsafeShiftL` index' w+    {-# INLINE mask' #-}++    shiftHash h = h `unsafeShiftR` bitsPerSubkey+    {-# INLINE shiftHash #-}+ {-# NOINLINE insertKeyExists #-}  -- Replace the ith Leaf with Leaf k v.@@ -902,14 +942,14 @@             return $! bitmapIndexedOrFull (b .|. m) ary'         | otherwise = do             st <- A.indexM ary i-            st' <- go h k x (s+bitsPerSubkey) st+            st' <- go h k x (nextShift s) st             A.unsafeUpdateM ary i st'             return t       where m = mask h s             i = sparseIndex b m     go h k x s t@(Full ary) = do         st <- A.indexM ary i-        st' <- go h k x (s+bitsPerSubkey) st+        st' <- go h k x (nextShift s) st         A.unsafeUpdateM ary i st'         return t       where i = index h s@@ -931,7 +971,7 @@   where     go s h1 k1 v1 h2 t2         | bp1 == bp2 = do-            st <- go (s+bitsPerSubkey) h1 k1 v1 h2 t2+            st <- go (nextShift s) h1 k1 v1 h2 t2             ary <- A.singletonM st             return $ BitmapIndexed bp1 ary         | otherwise  = do@@ -942,8 +982,15 @@       where         bp1  = mask h1 s         bp2  = mask h2 s-        idx2 | index h1 s < index h2 s = 1-             | otherwise               = 0+        !(I# i1) = index h1 s+        !(I# i2) = index h2 s+        idx2 = I# (i1 Exts.<# i2)+        -- This way of computing idx2 saves us a branch compared to the previous approach:+        --+        -- idx2 | index h1 s < index h2 s = 1+        --      | otherwise               = 0+        --+        -- See https://github.com/haskell-unordered-containers/unordered-containers/issues/75#issuecomment-1128419337 {-# INLINE two #-}  -- | \(O(\log n)\) Associate the value with the key in this map.  If@@ -984,7 +1031,7 @@             in bitmapIndexedOrFull (b .|. m) ary'         | otherwise =             let !st   = A.index ary i-                !st'  = go h k (s+bitsPerSubkey) st+                !st'  = go h k (nextShift s) st                 ary'  = A.update ary i $! st'             in if ptrEq st st'                then t@@ -993,7 +1040,7 @@             i = sparseIndex b m     go h k s t@(Full ary) =         let !st   = A.index ary i-            !st'  = go h k (s+bitsPerSubkey) st+            !st'  = go h k (nextShift s) st             ary' = update32 ary i $! st'         in if ptrEq st st'            then t@@ -1051,14 +1098,14 @@             return $! bitmapIndexedOrFull (b .|. m) ary'         | otherwise = do             st <- A.indexM ary i-            st' <- go h k x (s+bitsPerSubkey) st+            st' <- go h k x (nextShift s) st             A.unsafeUpdateM ary i st'             return t       where m = mask h s             i = sparseIndex b m     go h k x s t@(Full ary) = do         st <- A.indexM ary i-        st' <- go h k x (s+bitsPerSubkey) st+        st' <- go h k x (nextShift s) st         A.unsafeUpdateM ary i st'         return t       where i = index h s@@ -1084,7 +1131,7 @@         | b .&. m == 0 = t         | otherwise =             let !st = A.index ary i-                !st' = go h k (s+bitsPerSubkey) st+                !st' = go h k (nextShift s) st             in if st' `ptrEq` st                 then t                 else case st' of@@ -1103,13 +1150,13 @@             i = sparseIndex b m     go h k s t@(Full ary) =         let !st   = A.index ary i-            !st' = go h k (s+bitsPerSubkey) st+            !st' = go h k (nextShift s) st         in if st' `ptrEq` st             then t             else case st' of             Empty ->                 let ary' = A.delete ary i-                    bm   = fullNodeMask .&. complement (1 `unsafeShiftL` i)+                    bm   = fullBitmap .&. complement (1 `unsafeShiftL` i)                 in BitmapIndexed bm ary'             _ -> Full (A.update ary i st')       where i = index h s@@ -1129,18 +1176,15 @@ -- -- It is only valid to call this when the key exists in the map and you know the -- hash collision position if there was one. This information can be obtained--- from 'lookupRecordCollision'. If there is no collision pass (-1) as collPos.------ We can skip:---  - the key equality check on the leaf, if we reach a leaf it must be the key+-- from 'lookupRecordCollision'. If there is no collision, pass (-1) as collPos. deleteKeyExists :: Int -> Hash -> k -> HashMap k v -> HashMap k v-deleteKeyExists !collPos0 !h0 !k0 !m0 = go collPos0 h0 k0 0 m0+deleteKeyExists !collPos0 !h0 !k0 !m0 = go collPos0 h0 k0 m0   where-    go :: Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v-    go !_collPos !_h !_k !_s (Leaf _ _) = Empty-    go collPos h k s (BitmapIndexed b ary) =+    go :: Int -> Word -> k -> HashMap k v -> HashMap k v+    go !_collPos !_shiftedHash !_k (Leaf _ _) = Empty+    go collPos shiftedHash k (BitmapIndexed b ary) =             let !st = A.index ary i-                !st' = go collPos h k (s+bitsPerSubkey) st+                !st' = go collPos (shiftHash shiftedHash) k st             in case st' of                 Empty | A.length ary == 1 -> Empty                       | A.length ary == 2 ->@@ -1153,25 +1197,39 @@                       bIndexed = BitmapIndexed (b .&. complement m) (A.delete ary i)                 l | isLeafOrCollision l && A.length ary == 1 -> l                 _ -> BitmapIndexed b (A.update ary i st')-      where m = mask h s+      where m = mask' shiftedHash             i = sparseIndex b m-    go collPos h k s (Full ary) =+    go collPos shiftedHash k (Full ary) =         let !st   = A.index ary i-            !st' = go collPos h k (s+bitsPerSubkey) st+            !st' = go collPos (shiftHash shiftedHash) k st         in case st' of             Empty ->                 let ary' = A.delete ary i-                    bm   = fullNodeMask .&. complement (1 `unsafeShiftL` i)+                    bm   = fullBitmap .&. complement (1 `unsafeShiftL` i)                 in BitmapIndexed bm ary'             _ -> Full (A.update ary i st')-      where i = index h s-    go collPos h _ _ (Collision _hy v)+      where i = index' shiftedHash+    go collPos _shiftedHash _k (Collision h v)       | A.length v == 2       = if collPos == 0         then Leaf h (A.index v 1)         else Leaf h (A.index v 0)       | otherwise = Collision h (A.delete v collPos)-    go !_ !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty"+    go !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty"++    -- Customized version of 'index' that doesn't require a 'Shift'.+    index' :: Hash -> Int+    index' w = fromIntegral $ w .&. subkeyMask+    {-# INLINE index' #-}++    -- Customized version of 'mask' that doesn't require a 'Shift'.+    mask' :: Word -> Bitmap+    mask' w = 1 `unsafeShiftL` index' w+    {-# INLINE mask' #-}++    shiftHash h = h `unsafeShiftR` bitsPerSubkey+    {-# INLINE shiftHash #-}+ {-# NOINLINE deleteKeyExists #-}  -- | \(O(\log n)\) Adjust the value tied to a given key in this map only@@ -1201,7 +1259,7 @@     go h k s t@(BitmapIndexed b ary)         | b .&. m == 0 = t         | otherwise = let !st   = A.index ary i-                          !st'  = go h k (s+bitsPerSubkey) st+                          !st'  = go h k (nextShift s) st                           ary' = A.update ary i $! st'                       in if ptrEq st st'                          then t@@ -1211,7 +1269,7 @@     go h k s t@(Full ary) =         let i    = index h s             !st   = A.index ary i-            !st'  = go h k (s+bitsPerSubkey) st+            !st'  = go h k (nextShift s) st             ary' = update32 ary i $! st'         in if ptrEq st st'            then t@@ -1241,11 +1299,19 @@ -- 'lookup' k ('alter' f k m) = f ('lookup' k m) -- @ alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v--- TODO(m-renaud): Consider using specialized insert and delete for alter. alter f k m =-  case f (lookup k m) of-    Nothing -> delete k m-    Just v  -> insert k v m+    let !h = hash k+        !lookupRes = lookupRecordCollision h k m+    in case f (lookupResToMaybe lookupRes) of+        Nothing -> case lookupRes of+            Absent            -> m+            Present _ collPos -> deleteKeyExists collPos h k m+        Just v' -> case lookupRes of+            Absent            -> insertNewKey h k v' m+            Present v collPos ->+                if v `ptrEq` v'+                    then m+                    else insertKeyExists collPos h k v' m {-# INLINABLE alter #-}  -- | \(O(\log n)\)  The expression @('alterF' f k map)@ alters the value @x@ at@@ -1388,9 +1454,7 @@    where !h = hash k         !lookupRes = lookupRecordCollision h k m-        !mv = case lookupRes of-           Absent -> Nothing-           Present v _ -> Just v+        !mv = lookupResToMaybe lookupRes {-# INLINABLE alterFEager #-}  -- | \(O(n \log m)\) Inclusion of maps. A map is included in another map if the keys@@ -1458,21 +1522,21 @@     go s t1@(Collision h1 _) (BitmapIndexed b ls2)         | b .&. m == 0 = False         | otherwise    =-            go (s+bitsPerSubkey) t1 (A.index ls2 (sparseIndex b m))+            go (nextShift s) t1 (A.index ls2 (sparseIndex b m))       where m = mask h1 s      -- Similar to the previous case we need to traverse l2 at the index for the hash h1.     go s t1@(Collision h1 _) (Full ls2) =-      go (s+bitsPerSubkey) t1 (A.index ls2 (index h1 s))+      go (nextShift s) t1 (A.index ls2 (index h1 s))      -- In cases where the first and second map are BitmapIndexed or Full,     -- traverse down the tree at the appropriate indices.     go s (BitmapIndexed b1 ls1) (BitmapIndexed b2 ls2) =-      submapBitmapIndexed (go (s+bitsPerSubkey)) b1 ls1 b2 ls2+      submapBitmapIndexed (go (nextShift s)) b1 ls1 b2 ls2     go s (BitmapIndexed b1 ls1) (Full ls2) =-      submapBitmapIndexed (go (s+bitsPerSubkey)) b1 ls1 fullNodeMask ls2+      submapBitmapIndexed (go (nextShift s)) b1 ls1 fullBitmap ls2     go s (Full ls1) (Full ls2) =-      submapBitmapIndexed (go (s+bitsPerSubkey)) fullNodeMask ls1 fullNodeMask ls2+      submapBitmapIndexed (go (nextShift s)) fullBitmap ls1 fullBitmap ls2      -- Collision and Full nodes always contain at least two entries. Hence it     -- cannot be a map of a leaf.@@ -1518,14 +1582,14 @@ -- -- >>> union (fromList [(1,'a'),(2,'b')]) (fromList [(2,'c'),(3,'d')]) -- fromList [(1,'a'),(2,'b'),(3,'d')]-union :: (Eq k, Hashable k) => HashMap k v -> HashMap k v -> HashMap k v+union :: Eq k => HashMap k v -> HashMap k v -> HashMap k v union = unionWith const {-# INLINABLE union #-}  -- | \(O(n+m)\) The union of two maps.  If a key occurs in both maps, -- the provided function (first argument) will be used to compute the -- result.-unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v+unionWith :: Eq k => (v -> v -> v) -> HashMap k v -> HashMap k v           -> HashMap k v unionWith f = unionWithKey (const f) {-# INLINE unionWith #-}@@ -1533,7 +1597,7 @@ -- | \(O(n+m)\) The union of two maps.  If a key occurs in both maps, -- the provided function (first argument) will be used to compute the -- result.-unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v+unionWithKey :: Eq k => (k -> v -> v -> v) -> HashMap k v -> HashMap k v           -> HashMap k v unionWithKey f = go 0   where@@ -1558,16 +1622,16 @@     -- branch vs. branch     go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =         let b'   = b1 .|. b2-            ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2+            ary' = unionArrayBy (go (nextShift s)) b1 b2 ary1 ary2         in bitmapIndexedOrFull b' ary'     go s (BitmapIndexed b1 ary1) (Full ary2) =-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2+        let ary' = unionArrayBy (go (nextShift s)) b1 fullBitmap ary1 ary2         in Full ary'     go s (Full ary1) (BitmapIndexed b2 ary2) =-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2+        let ary' = unionArrayBy (go (nextShift s)) fullBitmap b2 ary1 ary2         in Full ary'     go s (Full ary1) (Full ary2) =-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask+        let ary' = unionArrayBy (go (nextShift s)) fullBitmap fullBitmap                    ary1 ary2         in Full ary'     -- leaf vs. branch@@ -1576,7 +1640,7 @@                                b'   = b1 .|. m2                            in bitmapIndexedOrFull b' ary'         | otherwise      = let ary' = A.updateWith' ary1 i $ \st1 ->-                                   go (s+bitsPerSubkey) st1 t2+                                   go (nextShift s) st1 t2                            in BitmapIndexed b1 ary'         where           h2 = leafHashCode t2@@ -1587,7 +1651,7 @@                                b'   = b2 .|. m1                            in bitmapIndexedOrFull b' ary'         | otherwise      = let ary' = A.updateWith' ary2 i $ \st2 ->-                                   go (s+bitsPerSubkey) t1 st2+                                   go (nextShift s) t1 st2                            in BitmapIndexed b2 ary'       where         h1 = leafHashCode t1@@ -1596,12 +1660,12 @@     go s (Full ary1) t2 =         let h2   = leafHashCode t2             i    = index h2 s-            ary' = update32With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2+            ary' = update32With' ary1 i $ \st1 -> go (nextShift s) st1 t2         in Full ary'     go s t1 (Full ary2) =         let h1   = leafHashCode t1             i    = index h1 s-            ary' = update32With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2+            ary' = update32With' ary2 i $ \st2 -> go (nextShift s) t1 st2         in Full ary'      leafHashCode (Leaf h _) = h@@ -1609,7 +1673,7 @@     leafHashCode _ = error "leafHashCode"      goDifferentHash s h1 h2 t1 t2-        | m1 == m2  = BitmapIndexed m1 (A.singleton $! goDifferentHash (s+bitsPerSubkey) h1 h2 t1 t2)+        | m1 == m2  = BitmapIndexed m1 (A.singleton $! goDifferentHash (nextShift s) h1 h2 t1 t2)         | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)         | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1)       where@@ -1654,7 +1718,7 @@ -- TODO: Figure out the time complexity of 'unions'.  -- | Construct a set containing all elements from a list of sets.-unions :: (Eq k, Hashable k) => [HashMap k v] -> HashMap k v+unions :: Eq k => [HashMap k v] -> HashMap k v unions = List.foldl' union empty {-# INLINE unions #-} @@ -1703,9 +1767,6 @@ map f = mapWithKey (const f) {-# INLINE map #-} --- TODO: We should be able to use mutation to create the new--- 'HashMap'.- -- | \(O(n)\) Perform an 'Applicative' action for each key-value pair -- in a 'HashMap' and produce a 'HashMap' of all the results. --@@ -1772,21 +1833,21 @@  -- | \(O(n \log m)\) Intersection of two maps. Return elements of the first -- map for keys existing in the second.-intersection :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v+intersection :: Eq k => HashMap k v -> HashMap k w -> HashMap k v intersection = Exts.inline intersectionWith const {-# INLINABLE intersection #-}  -- | \(O(n \log m)\) Intersection of two maps. If a key occurs in both maps -- the provided function is used to combine the values from the two -- maps.-intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3+intersectionWith :: Eq k => (v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3 intersectionWith f = Exts.inline intersectionWithKey $ const f {-# INLINABLE intersectionWith #-}  -- | \(O(n \log m)\) Intersection of two maps. If a key occurs in both maps -- the provided function is used to combine the values from the two -- maps.-intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3+intersectionWithKey :: Eq k => (k -> v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3 intersectionWithKey f = intersectionWithKey# $ \k v1 v2 -> (# f k v1 v2 #) {-# INLINABLE intersectionWithKey #-} @@ -1811,30 +1872,30 @@     go _ (Collision h1 ls1) (Collision h2 ls2) = intersectionCollisions f h1 h2 ls1 ls2     -- branch vs. branch     go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =-      intersectionArrayBy (go (s + bitsPerSubkey)) b1 b2 ary1 ary2+      intersectionArrayBy (go (nextShift s)) b1 b2 ary1 ary2     go s (BitmapIndexed b1 ary1) (Full ary2) =-      intersectionArrayBy (go (s + bitsPerSubkey)) b1 fullNodeMask ary1 ary2+      intersectionArrayBy (go (nextShift s)) b1 fullBitmap ary1 ary2     go s (Full ary1) (BitmapIndexed b2 ary2) =-      intersectionArrayBy (go (s + bitsPerSubkey)) fullNodeMask b2 ary1 ary2+      intersectionArrayBy (go (nextShift s)) fullBitmap b2 ary1 ary2     go s (Full ary1) (Full ary2) =-      intersectionArrayBy (go (s + bitsPerSubkey)) fullNodeMask fullNodeMask ary1 ary2+      intersectionArrayBy (go (nextShift s)) fullBitmap fullBitmap ary1 ary2     -- collision vs. branch     go s (BitmapIndexed b1 ary1) t2@(Collision h2 _ls2)       | b1 .&. m2 == 0 = Empty-      | otherwise = go (s + bitsPerSubkey) (A.index ary1 i) t2+      | otherwise = go (nextShift s) (A.index ary1 i) t2       where         m2 = mask h2 s         i = sparseIndex b1 m2     go s t1@(Collision h1 _ls1) (BitmapIndexed b2 ary2)       | b2 .&. m1 == 0 = Empty-      | otherwise = go (s + bitsPerSubkey) t1 (A.index ary2 i)+      | otherwise = go (nextShift s) t1 (A.index ary2 i)       where         m1 = mask h1 s         i = sparseIndex b2 m1-    go s (Full ary1) t2@(Collision h2 _ls2) = go (s + bitsPerSubkey) (A.index ary1 i) t2+    go s (Full ary1) t2@(Collision h2 _ls2) = go (nextShift s) (A.index ary1 i) t2       where         i = index h2 s-    go s t1@(Collision h1 _ls1) (Full ary2) = go (s + bitsPerSubkey) t1 (A.index ary2 i)+    go s t1@(Collision h1 _ls1) (Full ary2) = go (nextShift s) t1 (A.index ary2 i)       where         i = index h1 s {-# INLINE intersectionWithKey# #-}@@ -2080,7 +2141,7 @@         | Just t' <- onLeaf t = t'         | otherwise = Empty     go (BitmapIndexed b ary) = filterA ary b-    go (Full ary) = filterA ary fullNodeMask+    go (Full ary) = filterA ary fullBitmap     go (Collision h ary) = filterC ary h      filterA ary0 b0 =@@ -2099,9 +2160,9 @@                     ch <- A.read mary 0                     case ch of                       t | isLeafOrCollision t -> return t-                      _                       -> BitmapIndexed b <$> A.trim mary 1+                      _                       -> BitmapIndexed b <$> (A.unsafeFreeze =<< A.shrink mary 1)                 _ -> do-                    ary2 <- A.trim mary j+                    ary2 <- A.unsafeFreeze =<< A.shrink mary j                     return $! if j == maxChildren                               then Full ary2                               else BitmapIndexed b ary2@@ -2128,7 +2189,7 @@                         return $! Leaf h l                 _ | i == j -> do ary2 <- A.unsafeFreeze mary                                  return $! Collision h ary2-                  | otherwise -> do ary2 <- A.trim mary j+                  | otherwise -> do ary2 <- A.unsafeFreeze =<< A.shrink mary j                                     return $! Collision h ary2             | Just el <- onColl $! A.index ary i                 = A.write mary j el >> step ary mary (i+1) (j+1) n@@ -2197,7 +2258,7 @@ -- > = fromList [('a', [3, 1]), ('b', [2])] -- -- Note that the lists in the resulting map contain elements in reverse order--- from their occurences in the original list.+-- from their occurrences in the original list. -- -- More generally, duplicate entries are accumulated as follows; -- this matters when @f@ is not commutative or not associative.@@ -2411,7 +2472,7 @@ mask w s = 1 `unsafeShiftL` index w s {-# INLINE mask #-} --- | This array index is computed by counting the number of bits below the+-- | This array index is computed by counting the number of 1-bits below the -- 'index' represented by the mask. -- -- >>> sparseIndex 0b0110_0110 0b0010_0000@@ -2426,15 +2487,18 @@ sparseIndex b m = popCount (b .&. (m - 1)) {-# INLINE sparseIndex #-} --- TODO: Should be named _(bit)map_ instead of _mask_- -- | A bitmap with the 'maxChildren' least significant bits set, i.e. -- @0xFF_FF_FF_FF@.-fullNodeMask :: Bitmap+fullBitmap :: Bitmap -- This needs to use 'shiftL' instead of 'unsafeShiftL', to avoid UB. -- See issue #412.-fullNodeMask = complement (complement 0 `shiftL` maxChildren)-{-# INLINE fullNodeMask #-}+fullBitmap = complement (complement 0 `shiftL` maxChildren)+{-# INLINE fullBitmap #-}++-- | Increment a 'Shift' for use at the next deeper level.+nextShift :: Shift -> Shift+nextShift s = s + bitsPerSubkey+{-# INLINE nextShift #-}  ------------------------------------------------------------------------ -- Pointer equality

@@ -52,7 +52,6 @@     , insertM     , delete     , sameArray1-    , trim      , unsafeFreeze     , unsafeThaw@@ -60,6 +59,7 @@     , run     , copy     , copyM+    , cloneM        -- * Folds     , foldl@@ -94,7 +94,7 @@                             unsafeFreezeSmallArray#, unsafeThawSmallArray#,                             writeSmallArray#) import GHC.ST              (ST (..))-import Prelude             hiding (all, filter, foldMap, foldl, foldr, length,+import Prelude             hiding (Foldable(..), all, filter,                             map, read, traverse)  import qualified GHC.Exts                   as Exts@@ -322,11 +322,6 @@     case cloneSmallMutableArray# mary# off# len# s of       (# s', mary'# #) -> (# s', MArray mary'# #) --- | Create a new array of the @n@ first elements of @mary@.-trim :: MArray s a -> Int -> ST s (Array a)-trim mary n = cloneM mary 0 n >>= unsafeFreeze-{-# INLINE trim #-}- -- | \(O(n)\) Insert an element at the given position in this array, -- increasing its size by one. insert :: Array e -> Int -> e -> Array e@@ -360,7 +355,7 @@   where !count = length ary {-# INLINE updateM #-} --- | \(O(n)\) Update the element at the given positio in this array, by+-- | \(O(n)\) Update the element at the given position in this array, by -- applying a function to it.  Evaluates the element to WHNF before -- inserting it into the array. updateWith' :: Array e -> Int -> (e -> e) -> Array e

@@ -0,0 +1,149 @@+{-# LANGUAGE CPP              #-}+{-# LANGUAGE TypeApplications #-}++-- | = WARNING+--+-- This module is considered __internal__.+--+-- The Package Versioning Policy __does not apply__.+--+-- The contents of this module may change __in any way whatsoever__+-- and __without any warning__ between minor versions of this package.+--+-- Authors importing this module are expected to track development+-- closely.+--+-- = Description+--+-- Debugging utilities for 'HashMap's.++module Data.Strict.HashMap.Autogen.Internal.Debug+    ( valid+    , Validity(..)+    , Error(..)+    , SubHash+    , SubHashPath+    ) where++import Data.Bits             (complement, countTrailingZeros, popCount, shiftL,+                              unsafeShiftL, (.&.), (.|.))+import Data.Hashable         (Hashable)+import Data.Strict.HashMap.Autogen.Internal (Bitmap, Hash, HashMap (..), Leaf (..),+                              bitsPerSubkey, fullBitmap, hash,+                              isLeafOrCollision, maxChildren, sparseIndex)+import Data.Semigroup        (Sum (..))++import qualified Data.Strict.HashMap.Autogen.Internal.Array as A+++#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup (..))+#endif++data Validity k = Invalid (Error k) SubHashPath | Valid+  deriving (Eq, Show)++instance Semigroup (Validity k) where+  Valid <> y = y+  x     <> _ = x++instance Monoid (Validity k) where+  mempty = Valid+  mappend = (<>)++-- | An error corresponding to a broken invariant.+--+-- See 'HashMap' for the documentation of the invariants.+data Error k+  = INV1_internal_Empty+  | INV2_Bitmap_unexpected_1_bits !Bitmap+  | INV3_bad_BitmapIndexed_size !Int+  | INV4_bitmap_array_size_mismatch !Bitmap !Int+  | INV5_BitmapIndexed_invalid_single_subtree+  | INV6_misplaced_hash !Hash+  | INV7_key_hash_mismatch k !Hash+  | INV8_bad_Full_size !Int+  | INV9_Collision_size !Int+  | INV10_Collision_duplicate_key k !Hash+  deriving (Eq, Show)++-- TODO: Name this 'Index'?!+-- (https://github.com/haskell-unordered-containers/unordered-containers/issues/425)+-- | A part of a 'Hash' with 'bitsPerSubkey' bits.+type SubHash = Word++data SubHashPath = SubHashPath+  { partialHash :: !Word+    -- ^ The bits we already know, starting from the lower bits.+    -- The unknown upper bits are @0@.+  , lengthInBits :: !Int+    -- ^ The number of bits known.+  } deriving (Eq, Show)++initialSubHashPath :: SubHashPath+initialSubHashPath = SubHashPath 0 0++addSubHash :: SubHashPath -> SubHash -> SubHashPath+addSubHash (SubHashPath ph l) sh =+  SubHashPath (ph .|. (sh `unsafeShiftL` l)) (l + bitsPerSubkey)++hashMatchesSubHashPath :: SubHashPath -> Hash -> Bool+hashMatchesSubHashPath (SubHashPath ph l) h = maskToLength h l == ph+  where+    -- Note: This needs to use `shiftL` instead of `unsafeShiftL` because+    -- @l'@ may be greater than 32/64 at the deepest level.+    maskToLength h' l' = h' .&. complement (complement 0 `shiftL` l')++valid :: Hashable k => HashMap k v -> Validity k+valid Empty = Valid+valid t     = validInternal initialSubHashPath t+  where+    validInternal p Empty                 = Invalid INV1_internal_Empty p+    validInternal p (Leaf h l)            = validHash p h <> validLeaf p h l+    validInternal p (Collision h ary)     = validHash p h <> validCollision p h ary+    validInternal p (BitmapIndexed b ary) = validBitmapIndexed p b ary+    validInternal p (Full ary)            = validFull p ary++    validHash p h | hashMatchesSubHashPath p h = Valid+                  | otherwise                  = Invalid (INV6_misplaced_hash h) p++    validLeaf p h (L k _) | hash k == h = Valid+                          | otherwise   = Invalid (INV7_key_hash_mismatch k h) p++    validCollision p h ary = validCollisionSize <> A.foldMap (validLeaf p h) ary <> distinctKeys+      where+        n = A.length ary+        validCollisionSize | n < 2     = Invalid (INV9_Collision_size n) p+                           | otherwise = Valid+        distinctKeys = A.foldMap (\(L k _) -> appearsOnce k) ary+        appearsOnce k | A.foldMap (\(L k' _) -> if k' == k then Sum @Int 1 else Sum 0) ary == 1 = Valid+                      | otherwise = Invalid (INV10_Collision_duplicate_key k h) p++    validBitmapIndexed p b ary = validBitmap <> validArraySize <> validSubTrees p b ary+      where+        validBitmap | b .&. complement fullBitmap == 0 = Valid+                    | otherwise                        = Invalid (INV2_Bitmap_unexpected_1_bits b) p+        n = A.length ary+        validArraySize | n < 1 || n >= maxChildren = Invalid (INV3_bad_BitmapIndexed_size n) p+                       | popCount b == n           = Valid+                       | otherwise                 = Invalid (INV4_bitmap_array_size_mismatch b n) p++    validSubTrees p b ary+      | A.length ary == 1+      , isLeafOrCollision (A.index ary 0)+      = Invalid INV5_BitmapIndexed_invalid_single_subtree p+      | otherwise = go b+      where+        go 0  = Valid+        go b' = validInternal (addSubHash p (fromIntegral c)) (A.index ary i) <> go b''+          where+            c = countTrailingZeros b'+            m = 1 `unsafeShiftL` c+            i = sparseIndex b m+            b'' = b' .&. complement m++    validFull p ary = validArraySize <> validSubTrees p fullBitmap ary+      where+        n = A.length ary+        validArraySize | n == maxChildren = Valid+                       | otherwise        = Invalid (INV8_bad_Full_size n) p

@@ -32,7 +32,7 @@ import Data.Semigroup ((<>)) #endif --- Note: previous implemenation isPermutation = null (as // bs)+-- Note: previous implementation isPermutation = null (as // bs) -- was O(n^2) too. -- -- This assumes lists are of equal length@@ -53,7 +53,7 @@  -- The idea: ----- Homogeonous version+-- Homogenous version -- -- uc :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering -- uc c as bs = compare (sortBy c as) (sortBy c bs)

@@ -130,8 +130,8 @@ -- See Note [Imports from Data.Strict.HashMap.Autogen.Internal] import Data.Hashable         (Hashable) import Data.Strict.HashMap.Autogen.Internal (Hash, HashMap (..), Leaf (..), LookupRes (..),-                              bitsPerSubkey, fullNodeMask, hash, index, mask,-                              ptrEq, sparseIndex)+                              fullBitmap, hash, index, mask, nextShift, ptrEq,+                              sparseIndex) import Prelude               hiding (lookup, map)  -- See Note [Imports from Data.Strict.HashMap.Autogen.Internal]@@ -203,14 +203,14 @@             in HM.bitmapIndexedOrFull (b .|. m) ary'         | otherwise =             let st   = A.index ary i-                st'  = go h k x (s+bitsPerSubkey) st+                st'  = go h k x (nextShift s) st                 ary' = A.update ary i $! st'             in BitmapIndexed b ary'       where m = mask h s             i = sparseIndex b m     go h k x s (Full ary) =         let st   = A.index ary i-            st'  = go h k x (s+bitsPerSubkey) st+            st'  = go h k x (nextShift s) st             ary' = HM.update32 ary i $! st'         in Full ary'       where i = index h s@@ -244,14 +244,14 @@             return $! HM.bitmapIndexedOrFull (b .|. m) ary'         | otherwise = do             st <- A.indexM ary i-            st' <- go h k x (s+bitsPerSubkey) st+            st' <- go h k x (nextShift s) st             A.unsafeUpdateM ary i st'             return t       where m = mask h s             i = sparseIndex b m     go h k x s t@(Full ary) = do         st <- A.indexM ary i-        st' <- go h k x (s+bitsPerSubkey) st+        st' <- go h k x (nextShift s) st         A.unsafeUpdateM ary i st'         return t       where i = index h s@@ -273,7 +273,7 @@     go h k s t@(BitmapIndexed b ary)         | b .&. m == 0 = t         | otherwise = let st   = A.index ary i-                          st'  = go h k (s+bitsPerSubkey) st+                          st'  = go h k (nextShift s) st                           ary' = A.update ary i $! st'                       in BitmapIndexed b ary'       where m = mask h s@@ -281,7 +281,7 @@     go h k s (Full ary) =         let i    = index h s             st   = A.index ary i-            st'  = go h k (s+bitsPerSubkey) st+            st'  = go h k (nextShift s) st             ary' = HM.update32 ary i $! st'         in Full ary'     go h k _ t@(Collision hy v)@@ -306,9 +306,18 @@ -- @ alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v alter f k m =-  case f (HM.lookup k m) of-    Nothing -> HM.delete k m-    Just v  -> insert k v m+    let !h = hash k+        !lookupRes = HM.lookupRecordCollision h k m+    in case f (HM.lookupResToMaybe lookupRes) of+        Nothing -> case lookupRes of+            Absent            -> m+            Present _ collPos -> HM.deleteKeyExists collPos h k m+        Just !v' -> case lookupRes of+            Absent             -> HM.insertNewKey h k v' m+            Present v collPos ->+                if v `ptrEq` v'+                    then m+                    else HM.insertKeyExists collPos h k v' m {-# INLINABLE alter #-}  -- | \(O(\log n)\)  The expression (@'alterF' f k map@) alters the value @x@ at@@ -429,9 +438,7 @@    where !h = hash k         !lookupRes = HM.lookupRecordCollision h k m-        !mv = case lookupRes of-          Absent -> Nothing-          Present v _ -> Just v+        !mv = HM.lookupResToMaybe lookupRes {-# INLINABLE alterFEager #-}  ------------------------------------------------------------------------@@ -439,14 +446,14 @@  -- | \(O(n+m)\) The union of two maps.  If a key occurs in both maps, -- the provided function (first argument) will be used to compute the result.-unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v+unionWith :: Eq k => (v -> v -> v) -> HashMap k v -> HashMap k v           -> HashMap k v unionWith f = unionWithKey (const f) {-# INLINE unionWith #-}  -- | \(O(n+m)\) The union of two maps.  If a key occurs in both maps, -- the provided function (first argument) will be used to compute the result.-unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v+unionWithKey :: Eq k => (k -> v -> v -> v) -> HashMap k v -> HashMap k v           -> HashMap k v unionWithKey f = go 0   where@@ -471,16 +478,16 @@     -- branch vs. branch     go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =         let b'   = b1 .|. b2-            ary' = HM.unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2+            ary' = HM.unionArrayBy (go (nextShift s)) b1 b2 ary1 ary2         in HM.bitmapIndexedOrFull b' ary'     go s (BitmapIndexed b1 ary1) (Full ary2) =-        let ary' = HM.unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2+        let ary' = HM.unionArrayBy (go (nextShift s)) b1 fullBitmap ary1 ary2         in Full ary'     go s (Full ary1) (BitmapIndexed b2 ary2) =-        let ary' = HM.unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2+        let ary' = HM.unionArrayBy (go (nextShift s)) fullBitmap b2 ary1 ary2         in Full ary'     go s (Full ary1) (Full ary2) =-        let ary' = HM.unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask+        let ary' = HM.unionArrayBy (go (nextShift s)) fullBitmap fullBitmap                    ary1 ary2         in Full ary'     -- leaf vs. branch@@ -489,7 +496,7 @@                                b'   = b1 .|. m2                            in HM.bitmapIndexedOrFull b' ary'         | otherwise      = let ary' = A.updateWith' ary1 i $ \st1 ->-                                   go (s+bitsPerSubkey) st1 t2+                                   go (nextShift s) st1 t2                            in BitmapIndexed b1 ary'         where           h2 = leafHashCode t2@@ -500,7 +507,7 @@                                b'   = b2 .|. m1                            in HM.bitmapIndexedOrFull b' ary'         | otherwise      = let ary' = A.updateWith' ary2 i $ \st2 ->-                                   go (s+bitsPerSubkey) t1 st2+                                   go (nextShift s) t1 st2                            in BitmapIndexed b2 ary'       where         h1 = leafHashCode t1@@ -509,12 +516,12 @@     go s (Full ary1) t2 =         let h2   = leafHashCode t2             i    = index h2 s-            ary' = HM.update32With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2+            ary' = HM.update32With' ary1 i $ \st1 -> go (nextShift s) st1 t2         in Full ary'     go s t1 (Full ary2) =         let h1   = leafHashCode t1             i    = index h1 s-            ary' = HM.update32With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2+            ary' = HM.update32With' ary2 i $ \st2 -> go (nextShift s) t1 st2         in Full ary'      leafHashCode (Leaf h _) = h@@ -522,7 +529,7 @@     leafHashCode _ = error "leafHashCode"      goDifferentHash s h1 h2 t1 t2-        | m1 == m2  = BitmapIndexed m1 (A.singleton $! goDifferentHash (s+bitsPerSubkey) h1 h2 t1 t2)+        | m1 == m2  = BitmapIndexed m1 (A.singleton $! goDifferentHash (nextShift s) h1 h2 t1 t2)         | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)         | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1)       where@@ -615,7 +622,7 @@ -- | \(O(n+m)\) Intersection of two maps. If a key occurs in both maps -- the provided function is used to combine the values from the two -- maps.-intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1+intersectionWith :: Eq k => (v1 -> v2 -> v3) -> HashMap k v1                  -> HashMap k v2 -> HashMap k v3 intersectionWith f = Exts.inline intersectionWithKey $ const f {-# INLINABLE intersectionWith #-}@@ -623,7 +630,7 @@ -- | \(O(n+m)\) Intersection of two maps. If a key occurs in both maps -- the provided function is used to combine the values from the two -- maps.-intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3)+intersectionWithKey :: Eq k => (k -> v1 -> v2 -> v3)                     -> HashMap k v1 -> HashMap k v2 -> HashMap k v3 intersectionWithKey f = HM.intersectionWithKey# $ \k v1 v2 -> let !v3 = f k v1 v2 in (# v3 #) {-# INLINABLE intersectionWithKey #-}@@ -661,7 +668,7 @@ -- > = fromList [('a', [3, 1]), ('b', [2])] -- -- Note that the lists in the resulting map contain elements in reverse order--- from their occurences in the original list.+-- from their occurrences in the original list. -- -- More generally, duplicate entries are accumulated as follows; -- this matters when @f@ is not commutative or not associative.

@@ -72,6 +72,7 @@ -- constructors are ordered by frequency. -- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil -- improves the benchmark by circa 10%.+--  module Data.Strict.IntMap.Autogen.Internal (     -- * Map type@@ -228,6 +229,10 @@     , partition     , partitionWithKey +    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone+     , mapMaybe     , mapMaybeWithKey     , mapEither@@ -294,7 +299,6 @@     ) where  import Data.Functor.Identity (Identity (..))-import Control.Applicative (liftA2) import Data.Semigroup (Semigroup(stimes)) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>)))@@ -306,7 +310,9 @@ import Data.Bits import qualified Data.Foldable as Foldable import Data.Maybe (fromMaybe)-import Prelude hiding (lookup, map, filter, foldr, foldl, null)+import Data.Strict.ContainersUtils.Autogen.Prelude hiding+  (lookup, map, filter, foldr, foldl, foldl', null)+import Prelude ()  import Data.IntSet.Internal (Key) import qualified Data.IntSet.Internal as IntSet@@ -321,6 +327,8 @@ import qualified GHC.Exts as GHCExts import Text.Read import Language.Haskell.TH.Syntax (Lift)+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () #endif import qualified Control.Category as Category @@ -371,7 +379,7 @@ type IntSetPrefix = Int type IntSetBitMap = Word --- | @since FIXME+-- | @since 0.6.6 deriving instance Lift a => Lift (IntMap a)  bitmapOf :: Int -> IntSetBitMap@@ -610,7 +618,7 @@                   | otherwise = def     go Nil = def --- | \(O(\log n)\). Find largest key smaller than the given one and return the+-- | \(O(\min(n,W))\). Find largest key smaller than the given one and return the -- corresponding (key, value) pair. -- -- > lookupLT 3 (fromList [(3,'a'), (5,'b')]) == Nothing@@ -631,7 +639,7 @@       | otherwise = Just (ky, y)     go def Nil = unsafeFindMax def --- | \(O(\log n)\). Find smallest key greater than the given one and return the+-- | \(O(\min(n,W))\). Find smallest key greater than the given one and return the -- corresponding (key, value) pair. -- -- > lookupGT 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')@@ -652,7 +660,7 @@       | otherwise = Just (ky, y)     go def Nil = unsafeFindMin def --- | \(O(\log n)\). Find largest key smaller or equal to the given one and return+-- | \(O(\min(n,W))\). Find largest key smaller or equal to the given one and return -- the corresponding (key, value) pair. -- -- > lookupLE 2 (fromList [(3,'a'), (5,'b')]) == Nothing@@ -674,7 +682,7 @@       | otherwise = Just (ky, y)     go def Nil = unsafeFindMax def --- | \(O(\log n)\). Find smallest key greater or equal to the given one and return+-- | \(O(\min(n,W))\). Find smallest key greater or equal to the given one and return -- the corresponding (key, value) pair. -- -- > lookupGE 3 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')@@ -822,6 +830,8 @@ -- > 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"+--+-- Also see the performance note on 'fromListWith'.  insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWith f k x t@@ -837,6 +847,8 @@ -- > 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"+--+-- Also see the performance note on 'fromListWith'.  insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWithKey f !k x t@(Bin p m l r)@@ -862,6 +874,8 @@ -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")]) -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])+--+-- Also see the performance note on 'fromListWith'.  insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a) insertLookupWithKey f !k x t@(Bin p m l r)@@ -1004,7 +1018,7 @@                       Just x -> Tip k x                       Nothing -> Nil --- | \(O(\log n)\). The expression (@'alterF' f k map@) alters the value @x@ at+-- | \(O(\min(n,W))\). The expression (@'alterF' f k map@) alters the value @x@ at -- @k@, or absence thereof.  'alterF' can be used to inspect, insert, delete, -- or update a value in an 'IntMap'.  In short : @'lookup' k <$> 'alterF' f k m = f -- ('lookup' k m)@.@@ -1077,6 +1091,8 @@ -- | \(O(n+m)\). The union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWith f m1 m2@@ -1086,6 +1102,8 @@ -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWithKey f m1 m2@@ -1130,7 +1148,7 @@ -- | \(O(n+m)\). Remove all the keys in a given set from a map. -- -- @--- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``IntSet.notMember`` s) m+-- m \`withoutKeys\` s = 'filterWithKey' (\\k _ -> k ``IntSet.notMember`` s) m -- @ -- -- @since 0.5.8@@ -1208,7 +1226,7 @@ -- | \(O(n+m)\). The restriction of a map to the keys in a set. -- -- @--- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``IntSet.member`` s) m+-- m \`restrictKeys\` s = 'filterWithKey' (\\k _ -> k ``IntSet.member`` s) m -- @ -- -- @since 0.5.8@@ -2532,12 +2550,14 @@ -- -- > 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"+--+-- Also see the performance note on 'fromListWith'.  mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a mapKeysWith c f   = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) [] --- | \(O(n \min(n,W))\).+-- | \(O(n)\). -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ -- is strictly monotonic. -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.@@ -2615,6 +2635,101 @@           | otherwise     -> (Nil :*: t)         Nil -> (Nil :*: Nil) +-- | \(O(\min(n,W))\). Take while a predicate on the keys holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' (p . fst) . 'toList'+-- takeWhileAntitone p = 'filterWithKey' (\\k _ -> p k)+-- @+--+-- @since 0.6.7+takeWhileAntitone :: (Key -> Bool) -> IntMap a -> IntMap a+takeWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then bin p m (go predicate l) r+        else go predicate r+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = bin p m l (go predicate' r)+      | otherwise         = go predicate' l+    go predicate' t'@(Tip ky _)+      | predicate' ky = t'+      | otherwise     = Nil+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Drop while a predicate on the keys holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' (p . fst) . 'toList'+-- dropWhileAntitone p = 'filterWithKey' (\\k _ -> not (p k))+-- @+--+-- @since 0.6.7+dropWhileAntitone :: (Key -> Bool) -> IntMap a -> IntMap a+dropWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then go predicate l+        else bin p m l (go predicate r)+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = go predicate' r+      | otherwise         = bin p m (go predicate' l) r+    go predicate' t'@(Tip ky _)+      | predicate' ky = Nil+      | otherwise     = t'+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Divide a map at the point where a predicate on the keys stops holding.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+--+-- @+-- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)+-- spanAntitone p xs = 'partitionWithKey' (\\k _ -> p k) xs+-- @+--+-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map+-- at some /unspecified/ point.+--+-- @since 0.6.7+spanAntitone :: (Key -> Bool) -> IntMap a -> (IntMap a, IntMap a)+spanAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then+          case go predicate l of+            (lt :*: gt) ->+              let !lt' = bin p m lt r+              in (lt', gt)+        else+          case go predicate r of+            (lt :*: gt) ->+              let !gt' = bin p m l gt+              in (lt, gt')+    _ -> case go predicate t of+          (lt :*: gt) -> (lt, gt)+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = case go predicate' r of (lt :*: gt) -> bin p m l lt :*: gt+      | otherwise         = case go predicate' l of (lt :*: gt) -> lt :*: bin p m gt r+    go predicate' t'@(Tip ky _)+      | predicate' ky = (t' :*: Nil)+      | otherwise     = (Nil :*: t')+    go _ Nil = (Nil :*: Nil)+ -- | \(O(n)\). Map values and collect the 'Just' results. -- -- > let f x = if x == "a" then Just "new a" else Nothing@@ -2684,26 +2799,26 @@ split :: Key -> IntMap a -> (IntMap a, IntMap a) split k t =   case t of-    Bin _ m l r+    Bin p m l r       | m < 0 ->         if k >= 0 -- handle negative numbers.         then           case go k l of             (lt :*: gt) ->-              let !lt' = union r lt+              let !lt' = bin p m lt r               in (lt', gt)         else           case go k r of             (lt :*: gt) ->-              let !gt' = union gt l+              let !gt' = bin p m l gt               in (lt, gt')     _ -> case go k t of           (lt :*: gt) -> (lt, gt)   where     go k' t'@(Bin p m l r)       | nomatch k' p m = if k' > p then t' :*: Nil else Nil :*: t'-      | zero k' m = case go k' l of (lt :*: gt) -> lt :*: union gt r-      | otherwise = case go k' r of (lt :*: gt) -> union l lt :*: gt+      | zero k' m = case go k' l of (lt :*: gt) -> lt :*: bin p m gt r+      | otherwise = case go k' r of (lt :*: gt) -> bin p m l lt :*: gt     go k' t'@(Tip ky _)       | k' > ky   = (t' :*: Nil)       | k' < ky   = (Nil :*: t')@@ -2734,11 +2849,11 @@ splitLookup k t =   case     case t of-      Bin _ m l r+      Bin p m l r         | m < 0 ->           if k >= 0 -- handle negative numbers.-          then mapLT (union r) (go k l)-          else mapGT (`union` l) (go k r)+          then mapLT (flip (bin p m) r) (go k l)+          else mapGT (bin p m l) (go k r)       _ -> go k t   of SplitLookup lt fnd gt -> (lt, fnd, gt)   where@@ -2747,8 +2862,8 @@           if k' > p           then SplitLookup t' Nothing Nil           else SplitLookup Nil Nothing t'-      | zero k' m = mapGT (`union` r) (go k' l)-      | otherwise = mapLT (union l) (go k' r)+      | zero k' m = mapGT (flip (bin p m) r) (go k' l)+      | otherwise = mapLT (bin p m l) (go k' r)     go k' t'@(Tip ky y)       | k' > ky   = SplitLookup t'  Nothing  Nil       | k' < ky   = SplitLookup Nil Nothing  t'@@ -2960,7 +3075,7 @@ assocs :: IntMap a -> [(Key,a)] assocs = toAscList --- | \(O(n \min(n,W))\). The set of all keys of the map.+-- | \(O(n)\). The set of all keys of the map. -- -- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.IntSet.fromList [3,5] -- > keysSet empty == Data.IntSet.empty@@ -3092,10 +3207,41 @@   where     ins t (k,x)  = insert k x t --- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+-- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "ab"), (5, "cba")]+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"x"), (5,"c")] == fromList [(3, "x"), (5, "cba")] -- > fromListWith (++) [] == empty+--+-- Note the reverse ordering of @"cba"@ in the example.+--+-- The symmetric combining function @f@ is applied in a left-fold over the list, as @f new old@.+--+-- === Performance+--+-- You should ensure that the given @f@ is fast with this order of arguments.+--+-- Symmetric functions may be slow in one order, and fast in another.+-- For the common case of collecting values of matching keys in a list, as above:+--+-- The complexity of @(++) a b@ is \(O(a)\), so it is fast when given a short list as its first argument.+-- Thus:+--+-- > fromListWith       (++)  (replicate 1000000 (3, "x"))   -- O(n),  fast+-- > fromListWith (flip (++)) (replicate 1000000 (3, "x"))   -- O(n²), extremely slow+--+-- because they evaluate as, respectively:+--+-- > fromList [(3, "x" ++ ("x" ++ "xxxxx..xxxxx"))]   -- O(n)+-- > fromList [(3, ("xxxxx..xxxxx" ++ "x") ++ "x")]   -- O(n²)+--+-- Thus, to get good performance with an operation like @(++)@ while also preserving+-- the same order as in the input list, reverse the input:+--+-- > fromListWith (++) (reverse [(5,"a"), (5,"b"), (5,"c")]) == fromList [(5, "abc")]+--+-- and it is always fast to combine singleton-list values @[v]@ with @fromListWith (++)@, as in:+--+-- > fromListWith (++) $ reverse $ map (\(k, v) -> (k, [v])) someListOfTuples  fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromListWith f xs@@ -3103,9 +3249,11 @@  -- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'. ----- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value+-- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")] -- > fromListWithKey f [] == empty+--+-- Also see the performance note on 'fromListWith'.  fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromListWithKey f xs@@ -3128,6 +3276,8 @@ -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+--+-- Also see the performance note on 'fromListWith'.  fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWith f = fromMonoListWithKey Nondistinct (\_ x y -> f x y)@@ -3139,6 +3289,8 @@ -- -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value -- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "5:b|a")]+--+-- Also see the performance note on 'fromListWith'.  fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWithKey f = fromMonoListWithKey Nondistinct f@@ -3160,6 +3312,8 @@ -- The precise conditions under which this function works are subtle: -- For any branch mask, keys with the same prefix w.r.t. the branch -- mask must occur consecutively in the list.+--+-- Also see the performance note on 'fromListWith'.  fromMonoListWithKey :: Distinct -> (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromMonoListWithKey distinct f = go@@ -3449,14 +3603,14 @@   Debugging --------------------------------------------------------------------} --- | \(O(n)\). Show the tree that implements the map. The tree is shown+-- | \(O(n \min(n,W))\). Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. showTree :: Show a => IntMap a -> String showTree s   = showTreeWith True False s  -{- | \(O(n)\). The expression (@'showTreeWith' hang wide map@) shows+{- | \(O(n \min(n,W))\). The expression (@'showTreeWith' hang wide map@) shows  the tree that implements the map. If @hang@ is  'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If  @wide@ is 'True', an extra wide version is shown.@@ -3505,7 +3659,7 @@ showsBars bars   = case bars of       [] -> id-      _  -> showString (concat (reverse (tail bars))) . showString node+      _ : tl -> showString (concat (reverse tl)) . showString node  node :: String node = "+--"

@@ -217,6 +217,10 @@     , partition     , partitionWithKey +    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone+     , mapMaybe     , mapMaybeWithKey     , mapEither

@@ -217,6 +217,10 @@     , partition     , partitionWithKey +    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone+     , mapMaybe     , mapMaybeWithKey     , mapEither@@ -255,7 +259,9 @@ #endif     ) where -import Prelude hiding (lookup,map,filter,foldr,foldl,null)+import Data.Strict.ContainersUtils.Autogen.Prelude hiding+  (lookup,map,filter,foldr,foldl,foldl',null)+import Prelude ()  import Data.Bits import qualified Data.Strict.IntMap.Autogen.Internal as L@@ -327,6 +333,9 @@   , null   , partition   , partitionWithKey+  , takeWhileAntitone+  , dropWhileAntitone+  , spanAntitone   , restrictKeys   , size   , split@@ -345,7 +354,6 @@ import qualified Data.IntSet.Internal as IntSet import Data.Strict.ContainersUtils.Autogen.BitUtil import Data.Strict.ContainersUtils.Autogen.StrictPair-import Control.Applicative (Applicative (..), liftA2) import qualified Data.Foldable as Foldable  {--------------------------------------------------------------------@@ -417,6 +425,8 @@ -- > 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"+--+-- Also see the performance note on 'fromListWith'.  insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWith f k x t@@ -435,6 +445,8 @@ -- -- If the key exists in the map, this function is lazy in @value@ but strict -- in the result of @f@.+--+-- Also see the performance note on 'fromListWith'.  insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWithKey f !k x t =@@ -462,6 +474,8 @@ -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")]) -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])+--+-- Also see the performance note on 'fromListWith'.  insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a) insertLookupWithKey f0 !k0 x0 t0 = toPair $ go f0 k0 x0 t0@@ -652,6 +666,8 @@ -- | \(O(n+m)\). The union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWith f m1 m2@@ -661,6 +677,8 @@ -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWithKey f m1 m2@@ -978,6 +996,8 @@ -- -- > 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"+--+-- Also see the performance note on 'fromListWith'.  mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []@@ -1087,10 +1107,41 @@   where     ins t (k,x)  = insert k x t --- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+-- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"x"), (5,"c")] == fromList [(3, "x"), (5, "cba")] -- > fromListWith (++) [] == empty+--+-- Note the reverse ordering of @"cba"@ in the example.+--+-- The symmetric combining function @f@ is applied in a left-fold over the list, as @f new old@.+--+-- === Performance+--+-- You should ensure that the given @f@ is fast with this order of arguments.+--+-- Symmetric functions may be slow in one order, and fast in another.+-- For the common case of collecting values of matching keys in a list, as above:+--+-- The complexity of @(++) a b@ is \(O(a)\), so it is fast when given a short list as its first argument.+-- Thus:+--+-- > fromListWith       (++)  (replicate 1000000 (3, "x"))   -- O(n),  fast+-- > fromListWith (flip (++)) (replicate 1000000 (3, "x"))   -- O(n²), extremely slow+--+-- because they evaluate as, respectively:+--+-- > fromList [(3, "x" ++ ("x" ++ "xxxxx..xxxxx"))]   -- O(n)+-- > fromList [(3, ("xxxxx..xxxxx" ++ "x") ++ "x")]   -- O(n²)+--+-- Thus, to get good performance with an operation like @(++)@ while also preserving+-- the same order as in the input list, reverse the input:+--+-- > fromListWith (++) (reverse [(5,"a"), (5,"b"), (5,"c")]) == fromList [(5, "abc")]+--+-- and it is always fast to combine singleton-list values @[v]@ with @fromListWith (++)@, as in:+--+-- > fromListWith (++) $ reverse $ map (\(k, v) -> (k, [v])) someListOfTuples  fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromListWith f xs@@ -1098,8 +1149,11 @@  -- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]--- > fromListWith (++) [] == empty+-- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value+-- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")]+-- > fromListWithKey f [] == empty+--+-- Also see the performance note on 'fromListWith'.  fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromListWithKey f xs@@ -1122,6 +1176,8 @@ -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+--+-- Also see the performance note on 'fromListWith'.  fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWith f = fromMonoListWithKey Nondistinct (\_ x y -> f x y)@@ -1132,6 +1188,8 @@ -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+--+-- Also see the performance note on 'fromListWith'.  fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWithKey f = fromMonoListWithKey Nondistinct f@@ -1153,6 +1211,8 @@ -- The precise conditions under which this function works are subtle: -- For any branch mask, keys with the same prefix w.r.t. the branch -- mask must occur consecutively in the list.+--+-- Also see the performance note on 'fromListWith'.  fromMonoListWithKey :: Distinct -> (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromMonoListWithKey distinct f = go

@@ -355,8 +355,15 @@     , link     , link2     , glue+    , fromDistinctAscList_linkTop+    , fromDistinctAscList_linkAll+    , fromDistinctDescList_linkTop+    , fromDistinctDescList_linkAll     , MaybeS(..)     , Identity(..)+    , FromDistinctMonoState(..)+    , Stack(..)+    , foldl'Stack      -- Used by Map.Merge.Lazy     , mapWhenMissing@@ -380,10 +387,10 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR) import qualified Data.Foldable as Foldable-#if MIN_VERSION_base(4,10,0) import Data.Bifoldable-#endif-import Prelude hiding (lookup, map, filter, foldr, foldl, null, splitAt, take, drop)+import Data.Strict.ContainersUtils.Autogen.Prelude hiding+  (lookup, map, filter, foldr, foldl, foldl', null, splitAt, take, drop)+import Prelude ()  import qualified Data.Set.Internal as Set import Data.Set.Internal (Set)@@ -398,6 +405,8 @@ #if __GLASGOW_HASKELL__ import GHC.Exts (build, lazy) import Language.Haskell.TH.Syntax (Lift)+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () #  ifdef USE_MAGIC_PROXY import GHC.Exts (Proxy#, proxy# ) #  endif@@ -468,7 +477,7 @@ #endif  #ifdef __GLASGOW_HASKELL__--- | @since FIXME+-- | @since 0.6.6 deriving instance (Lift k, Lift a) => Lift (Map k a) #endif @@ -844,6 +853,8 @@ -- > 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"+--+-- Also see the performance note on 'fromListWith'.  insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith = go@@ -870,6 +881,8 @@ -- the map, the key is left alone, not replaced. The combining -- function is flipped--it is applied to the old value and then the -- new value.+--+-- Also see the performance note on 'fromListWith'.  insertWithR :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithR = go@@ -898,6 +911,8 @@ -- > 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"+--+-- Also see the performance note on 'fromListWith'.  -- See Note: Type of local 'go' function insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a@@ -920,6 +935,9 @@ -- the map, the key is left alone, not replaced. The combining -- function is flipped--it is applied to the old value and then the -- new value.+--+-- Also see the performance note on 'fromListWith'.+ insertWithKeyR :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithKeyR = go   where@@ -951,6 +969,8 @@ -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")]) -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])+--+-- Also see the performance note on 'fromListWith'.  -- See Note: Type of local 'go' function insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a@@ -1487,7 +1507,7 @@   where     sizeL = size l --- | Take a given number of entries in key order, beginning+-- | \(O(\log n)\). Take a given number of entries in key order, beginning -- with the smallest keys. -- -- @@@ -1509,7 +1529,7 @@         EQ -> l       where sizeL = size l --- | Drop a given number of entries in key order, beginning+-- | \(O(\log n)\). Drop a given number of entries in key order, beginning -- with the smallest keys. -- -- @@@ -1629,11 +1649,6 @@   | Just r <- lookupMin t = r   | otherwise = error "Map.findMin: empty map has no minimal element" --- | \(O(\log n)\). The maximal key of the map. Calls 'error' if the map is empty.------ > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")--- > findMax empty                            Error: empty map has no maximal element- lookupMaxSure :: k -> a -> Map k a -> (k, a) lookupMaxSure k a Tip = (k, a) lookupMaxSure _ _ (Bin _ k a _ r) = lookupMaxSure k a r@@ -1649,6 +1664,11 @@ lookupMax Tip = Nothing lookupMax (Bin _ k x _ r) = Just $! lookupMaxSure k x r +-- | \(O(\log n)\). The maximal key of the map. Calls 'error' if the map is empty.+--+-- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")+-- > findMax empty                            Error: empty map has no maximal element+ findMax :: Map k a -> (k,a) findMax t   | Just r <- lookupMax t = r@@ -1802,7 +1822,7 @@ {-# INLINABLE unionsWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. -- It prefers @t1@ when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@).@@ -1826,9 +1846,11 @@ {--------------------------------------------------------------------   Union with a combining function --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Union with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a -- QuickCheck says pointer equality never happens here.@@ -1846,11 +1868,13 @@ {-# INLINABLE unionWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- Union with a combining function. -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a unionWithKey _f t1 Tip = t1@@ -1877,7 +1901,7 @@ -- relies on doing it the way we do, and it's not clear whether that -- bound holds the other way. --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Difference of two maps.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Difference of two maps. -- Return elements of the first map not existing in the second map. -- -- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"@@ -1896,10 +1920,10 @@ {-# INLINABLE difference #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Remove all keys in a 'Set' from a 'Map'.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Remove all keys in a 'Set' from a 'Map'. -- -- @--- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m+-- m \`withoutKeys\` s = 'filterWithKey' (\\k _ -> k ``Set.notMember`` s) m -- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s -- @ --@@ -1955,7 +1979,7 @@ {--------------------------------------------------------------------   Intersection --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection of two maps.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection of two maps. -- Return data in the first map for the keys existing in both maps. -- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). --@@ -1977,11 +2001,11 @@ {-# INLINABLE intersection #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Restrict a 'Map' to only those keys+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Restrict a 'Map' to only those keys -- found in a 'Set'. -- -- @--- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m+-- m \`restrictKeys\` s = 'filterWithKey' (\\k _ -> k ``Set.member`` s) m -- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s -- @ --@@ -2002,7 +2026,7 @@ {-# INLINABLE restrictKeys #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" @@ -2022,7 +2046,7 @@ {-# INLINABLE intersectionWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection with a combining function. -- -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"@@ -2044,7 +2068,7 @@ {--------------------------------------------------------------------   Disjoint --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Check whether the key sets of two+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Check whether the key sets of two -- maps are disjoint (i.e., their 'intersection' is empty). -- -- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())])   == True@@ -2467,10 +2491,8 @@ -- | Filter the entries whose keys are missing from the other map -- using some 'Applicative' action. ----- @--- filterAMissing f = Merge.Lazy.traverseMaybeMissing $---   \k x -> (\b -> guard b *> Just x) <$> f k x--- @+-- > filterAMissing f = Merge.Lazy.traverseMaybeMissing $+-- >   \k x -> (\b -> guard b *> Just x) <$> f k x -- -- but this should be a little faster. --@@ -2745,7 +2767,7 @@ {--------------------------------------------------------------------   Submap --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). -- isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool@@ -2754,7 +2776,7 @@ {-# INLINABLE isSubmapOf #-} #endif -{- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+{- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\).  The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if  all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when  applied to their respective values. For example, the following@@ -2803,7 +2825,7 @@ {-# INLINABLE submap' #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Is this a proper submap? (ie. a submap but not equal).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Is this a proper submap? (ie. a submap but not equal). -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@). isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool isProperSubmapOf m1 m2@@ -2812,7 +2834,7 @@ {-# INLINABLE isProperSubmapOf #-} #endif -{- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Is this a proper submap? (ie. a submap but not equal).+{- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Is this a proper submap? (ie. a submap but not equal).  The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when  @keys m1@ and @keys m2@ are not equal,  all keys in @m1@ are in @m2@, and when @f@ returns 'True' when@@ -2899,7 +2921,7 @@ -- -- @ -- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' (p . fst) . 'toList'--- dropWhileAntitone p = 'filterWithKey' (\k -> not (p k))+-- dropWhileAntitone p = 'filterWithKey' (\\k _ -> not (p k)) -- @ -- -- @since 0.5.8@@ -2916,7 +2938,7 @@ -- -- @ -- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)--- spanAntitone p xs = partitionWithKey (\k _ -> p k) xs+-- spanAntitone p xs = partitionWithKey (\\k _ -> p k) xs -- @ -- -- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map@@ -3082,7 +3104,7 @@ #endif  -- | \(O(n)\).--- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@+-- @'traverseWithKey' f m == 'fromList' \<$\> 'traverse' (\\(k, v) -> (,) k \<$\> f k v) ('toList' m)@ -- That is, behaves exactly like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value. --@@ -3163,6 +3185,8 @@ -- -- > 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"+--+-- Also see the performance note on 'fromListWith'.  mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []@@ -3383,7 +3407,7 @@ fromSet _ Set.Tip = Tip fromSet f (Set.Bin sz x l r) = Bin sz x (f x) (fromSet f l) (fromSet f r) --- | /O(n)/. Build a map from a set of elements contained inside 'Arg's.+-- | \(O(n)\). Build a map from a set of elements contained inside 'Arg's. -- -- > fromArgSet (Data.Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) == fromList [(5,"aaaaa"), (3,"aaa")] -- > fromArgSet Data.Set.empty == empty@@ -3408,8 +3432,7 @@ -- If the list contains more than one value for the same key, the last value -- for the key is retained. ----- If the keys of the list are ordered, linear-time implementation is used,--- with the performance equal to 'fromDistinctAscList'.+-- If the keys of the list are ordered, a linear-time implementation is used. -- -- > fromList [] == empty -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]@@ -3458,8 +3481,39 @@  -- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"x"), (5,"c")] == fromList [(3, "x"), (5, "cba")] -- > fromListWith (++) [] == empty+--+-- Note the reverse ordering of @"cba"@ in the example.+--+-- The symmetric combining function @f@ is applied in a left-fold over the list, as @f new old@.+--+-- === Performance+--+-- You should ensure that the given @f@ is fast with this order of arguments.+--+-- Symmetric functions may be slow in one order, and fast in another.+-- For the common case of collecting values of matching keys in a list, as above:+--+-- The complexity of @(++) a b@ is \(O(a)\), so it is fast when given a short list as its first argument.+-- Thus:+--+-- > fromListWith       (++)  (replicate 1000000 (3, "x"))   -- O(n),  fast+-- > fromListWith (flip (++)) (replicate 1000000 (3, "x"))   -- O(n²), extremely slow+--+-- because they evaluate as, respectively:+--+-- > fromList [(3, "x" ++ ("x" ++ "xxxxx..xxxxx"))]   -- O(n)+-- > fromList [(3, ("xxxxx..xxxxx" ++ "x") ++ "x")]   -- O(n²)+--+-- Thus, to get good performance with an operation like @(++)@ while also preserving+-- the same order as in the input list, reverse the input:+--+-- > fromListWith (++) (reverse [(5,"a"), (5,"b"), (5,"c")]) == fromList [(5, "abc")]+--+-- and it is always fast to combine singleton-list values @[v]@ with @fromListWith (++)@, as in:+--+-- > fromListWith (++) $ reverse $ map (\(k, v) -> (k, [v])) someListOfTuples  fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a fromListWith f xs@@ -3470,9 +3524,11 @@  -- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'. ----- > let f k a1 a2 = (show k) ++ a1 ++ a2--- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]+-- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value+-- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")] -- > fromListWithKey f [] == empty+--+-- Also see the performance note on 'fromListWith'.  fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromListWithKey f xs@@ -3625,6 +3681,8 @@ -- > valid (fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")]) == True -- > valid (fromDescListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False --+-- Also see the performance note on 'fromListWith'.+-- -- @since 0.5.8  fromDescListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a@@ -3642,6 +3700,8 @@ -- > 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+--+-- Also see the performance note on 'fromListWith'.  fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromAscListWithKey f xs@@ -3670,6 +3730,9 @@ -- > fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "5:b5:ba")] -- > valid (fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")]) == True -- > valid (fromDescListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.+ fromDescListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromDescListWithKey f xs   = fromDistinctDescList (combineEq f xs)@@ -3699,23 +3762,27 @@  -- For some reason, when 'singleton' is used in fromDistinctAscList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] in Data.Set.Internal. fromDistinctAscList :: [(k,a)] -> Map k a-fromDistinctAscList [] = Tip-fromDistinctAscList ((kx0, x0) : xs0) = go (1::Int) (Bin 1 kx0 x0 Tip Tip) xs0+fromDistinctAscList = fromDistinctAscList_linkAll . Foldable.foldl' next (State0 Nada)   where-    go !_ t [] = t-    go s l ((kx, x) : xs) = case create s xs of-                                (r :*: ys) -> let !t' = link kx x l r-                                              in go (s `shiftL` 1) t' ys+    next :: FromDistinctMonoState k a -> (k,a) -> FromDistinctMonoState k a+    next (State0 stk) (!kx, x) = fromDistinctAscList_linkTop (Bin 1 kx x Tip Tip) stk+    next (State1 l stk) (kx, x) = State0 (Push kx x l stk)+{-# INLINE fromDistinctAscList #-}  -- INLINE for fusion -    create !_ [] = (Tip :*: [])-    create s xs@(x' : xs')-      | s == 1 = case x' of (kx, x) -> (Bin 1 kx x Tip Tip :*: xs')-      | otherwise = case create (s `shiftR` 1) xs of-                      res@(_ :*: []) -> res-                      (l :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of-                        (r :*: zs) -> (link ky y l r :*: zs)+fromDistinctAscList_linkTop :: Map k a -> Stack k a -> FromDistinctMonoState k a+fromDistinctAscList_linkTop r@(Bin rsz _ _ _ _) (Push kx x l@(Bin lsz _ _ _ _) stk)+  | rsz == lsz = fromDistinctAscList_linkTop (bin kx x l r) stk+fromDistinctAscList_linkTop l stk = State1 l stk+{-# INLINABLE fromDistinctAscList_linkTop #-} +fromDistinctAscList_linkAll :: FromDistinctMonoState k a -> Map k a+fromDistinctAscList_linkAll (State0 stk)    = foldl'Stack (\r kx x l -> link kx x l r) Tip stk+fromDistinctAscList_linkAll (State1 r0 stk) = foldl'Stack (\r kx x l -> link kx x l r) r0 stk+{-# INLINABLE fromDistinctAscList_linkAll #-}+ -- | \(O(n)\). Build a map from a descending list of distinct elements in linear time. -- /The precondition is not checked./ --@@ -3727,23 +3794,40 @@  -- For some reason, when 'singleton' is used in fromDistinctDescList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] in Data.Set.Internal. fromDistinctDescList :: [(k,a)] -> Map k a-fromDistinctDescList [] = Tip-fromDistinctDescList ((kx0, x0) : xs0) = go (1 :: Int) (Bin 1 kx0 x0 Tip Tip) xs0+fromDistinctDescList = fromDistinctDescList_linkAll . Foldable.foldl' next (State0 Nada)   where-     go !_ t [] = t-     go s r ((kx, x) : xs) = case create s xs of-                               (l :*: ys) -> let !t' = link kx x l r-                                             in go (s `shiftL` 1) t' ys+    next :: FromDistinctMonoState k a -> (k,a) -> FromDistinctMonoState k a+    next (State0 stk) (!kx, x) = fromDistinctDescList_linkTop (Bin 1 kx x Tip Tip) stk+    next (State1 r stk) (kx, x) = State0 (Push kx x r stk)+{-# INLINE fromDistinctDescList #-}  -- INLINE for fusion -     create !_ [] = (Tip :*: [])-     create s xs@(x' : xs')-       | s == 1 = case x' of (kx, x) -> (Bin 1 kx x Tip Tip :*: xs')-       | otherwise = case create (s `shiftR` 1) xs of-                       res@(_ :*: []) -> res-                       (r :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of-                         (l :*: zs) -> (link ky y l r :*: zs)+fromDistinctDescList_linkTop :: Map k a -> Stack k a -> FromDistinctMonoState k a+fromDistinctDescList_linkTop l@(Bin lsz _ _ _ _) (Push kx x r@(Bin rsz _ _ _ _) stk)+  | lsz == rsz = fromDistinctDescList_linkTop (bin kx x l r) stk+fromDistinctDescList_linkTop r stk = State1 r stk+{-# INLINABLE fromDistinctDescList_linkTop #-} +fromDistinctDescList_linkAll :: FromDistinctMonoState k a -> Map k a+fromDistinctDescList_linkAll (State0 stk)    = foldl'Stack (\l kx x r -> link kx x l r) Tip stk+fromDistinctDescList_linkAll (State1 l0 stk) = foldl'Stack (\l kx x r -> link kx x l r) l0 stk+{-# INLINABLE fromDistinctDescList_linkAll #-}++data FromDistinctMonoState k a+  = State0 !(Stack k a)+  | State1 !(Map k a) !(Stack k a)++data Stack k a = Push !k a !(Map k a) !(Stack k a) | Nada++foldl'Stack :: (b -> k -> a -> Map k a -> b) -> b -> Stack k a -> b+foldl'Stack f = go+  where+    go !z Nada = z+    go z (Push kx x t stk) = go (f z kx x t) stk+{-# INLINE foldl'Stack #-}+ {- -- Functions very similar to these were used to implement -- hedge union, intersection, and difference algorithms that we no@@ -3831,7 +3915,7 @@ {-# INLINABLE splitLookup #-} #endif --- | A variant of 'splitLookup' that indicates only whether the+-- | \(O(\log n)\). A variant of 'splitLookup' that indicates only whether the -- key was present, rather than producing its value. This is used to -- implement 'intersection' to avoid allocating unnecessary 'Just' -- constructors.@@ -4254,7 +4338,6 @@   product = foldl' (*) 1   {-# INLINABLE product #-} -#if MIN_VERSION_base(4,10,0) -- | @since 0.6.3.1 instance Bifoldable Map where   bifold = go@@ -4275,7 +4358,6 @@           go (Bin 1 k v _ _) = f k `mappend` g v           go (Bin _ k v l r) = go l `mappend` (f k `mappend` (g v `mappend` go r))   {-# INLINE bifoldMap #-}-#endif  instance (NFData k, NFData a) => NFData (Map k a) where     rnf Tip = ()

@@ -6,7 +6,7 @@ import Data.Strict.Map.Autogen.Internal (Map (..), size, delta) import Control.Monad (guard) --- | \(O(n)\). Show the tree that implements the map. The tree is shown+-- | \(O(n \log n)\). Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. See 'showTreeWith'. showTree :: (Show k,Show a) => Map k a -> String showTree m@@ -15,7 +15,7 @@     showElem k x  = show k ++ ":=" ++ show x  -{- | \(O(n)\). The expression (@'showTreeWith' showelem hang wide map@) shows+{- | \(O(n \log n)\). The expression (@'showTreeWith' showelem hang wide map@) shows  the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is  'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If  @wide@ is 'True', an extra wide version is shown.@@ -91,7 +91,7 @@ showsBars bars   = case bars of       [] -> id-      _  -> showString (concat (reverse (tail bars))) . showString node+      _ : tl -> showString (concat (reverse tl)) . showString node  node :: String node           = "+--"

@@ -1,12 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts, DataKinds #-}-#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE MonoLocalBinds #-}-#endif-#if __GLASGOW_HASKELL__ < 710--- Why do we need this? Guess it doesn't matter; this is all--- going away soon.-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE CPP, FlexibleContexts, DataKinds, MonoLocalBinds #-}  #include "containers.h" 

@@ -308,7 +308,9 @@     , valid     ) where -import Prelude hiding (lookup,map,filter,foldr,foldl,null,take,drop,splitAt)+import Data.Strict.ContainersUtils.Autogen.Prelude hiding+  (lookup,map,filter,foldr,foldl,foldl',null,take,drop,splitAt)+import Prelude ()  import Data.Strict.Map.Autogen.Internal   ( Map (..)@@ -326,6 +328,12 @@   , filterAMissing   , merge   , mergeA+  , fromDistinctAscList_linkTop+  , fromDistinctAscList_linkAll+  , fromDistinctDescList_linkTop+  , fromDistinctDescList_linkAll+  , FromDistinctMonoState (..)+  , Stack (..)   , (!)   , (!?)   , (\\)@@ -538,6 +546,8 @@ -- > 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"+--+-- Also see the performance note on 'fromListWith'.  insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith = go@@ -582,6 +592,8 @@ -- > 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"+--+-- Also see the performance note on 'fromListWith'.  -- See Map.Internal.Note: Type of local 'go' function insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a@@ -637,6 +649,8 @@ -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")]) -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])+--+-- Also see the performance note on 'fromListWith'.  -- See Map.Internal.Note: Type of local 'go' function insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a@@ -972,9 +986,11 @@ {--------------------------------------------------------------------   Union with a combining function --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Union with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWith _f t1 Tip = t1@@ -988,11 +1004,13 @@ {-# INLINABLE unionWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- Union with a combining function. -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a unionWithKey _f t1 Tip = t1@@ -1046,7 +1064,7 @@   Intersection --------------------------------------------------------------------} --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" @@ -1064,7 +1082,7 @@ {-# INLINABLE intersectionWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection with a combining function. -- -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"@@ -1385,7 +1403,7 @@ #endif  -- | \(O(n)\).--- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (\v' -> v' \`seq\` (k,v')) <$> f k v) ('toList' m)@+-- @'traverseWithKey' f m == 'fromList' \<$\> 'traverse' (\\(k, v) -> (\v' -> v' \`seq\` (k,v')) \<$\> f k v) ('toList' m)@ -- That is, it behaves much like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value and the values are -- forced before they are installed in the result map.@@ -1450,6 +1468,8 @@ -- -- > 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"+--+-- Also see the performance note on 'fromListWith'.  mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []@@ -1471,7 +1491,7 @@ fromSet _ Set.Tip = Tip fromSet f (Set.Bin sz x l r) = case f x of v -> v `seq` Bin sz x v (fromSet f l) (fromSet f r) --- | /O(n)/. Build a map from a set of elements contained inside 'Arg's.+-- | \(O(n)\). Build a map from a set of elements contained inside 'Arg's. -- -- > fromArgSet (Data.Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) == fromList [(5,"aaaaa"), (3,"aaa")] -- > fromArgSet Data.Set.empty == empty@@ -1487,8 +1507,7 @@ -- If the list contains more than one value for the same key, the last value -- for the key is retained. ----- If the keys of the list are ordered, linear-time implementation is used,--- with the performance equal to 'fromDistinctAscList'.+-- If the keys of the list are ordered, a linear-time implementation is used. -- -- > fromList [] == empty -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]@@ -1537,8 +1556,39 @@  -- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"x"), (5,"c")] == fromList [(3, "x"), (5, "cba")] -- > fromListWith (++) [] == empty+--+-- Note the reverse ordering of @"cba"@ in the example.+--+-- The symmetric combining function @f@ is applied in a left-fold over the list, as @f new old@.+--+-- === Performance+--+-- You should ensure that the given @f@ is fast with this order of arguments.+--+-- Symmetric functions may be slow in one order, and fast in another.+-- For the common case of collecting values of matching keys in a list, as above:+--+-- The complexity of @(++) a b@ is \(O(a)\), so it is fast when given a short list as its first argument.+-- Thus:+--+-- > fromListWith       (++)  (replicate 1000000 (3, "x"))   -- O(n),  fast+-- > fromListWith (flip (++)) (replicate 1000000 (3, "x"))   -- O(n²), extremely slow+--+-- because they evaluate as, respectively:+--+-- > fromList [(3, "x" ++ ("x" ++ "xxxxx..xxxxx"))]   -- O(n)+-- > fromList [(3, ("xxxxx..xxxxx" ++ "x") ++ "x")]   -- O(n²)+--+-- Thus, to get good performance with an operation like @(++)@ while also preserving+-- the same order as in the input list, reverse the input:+--+-- > fromListWith (++) (reverse [(5,"a"), (5,"b"), (5,"c")]) == fromList [(5, "abc")]+--+-- and it is always fast to combine singleton-list values @[v]@ with @fromListWith (++)@, as in:+--+-- > fromListWith (++) $ reverse $ map (\(k, v) -> (k, [v])) someListOfTuples  fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a fromListWith f xs@@ -1549,9 +1599,11 @@  -- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'. ----- > let f k a1 a2 = (show k) ++ a1 ++ a2--- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]+-- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value+-- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")] -- > fromListWithKey f [] == empty+--+-- Also see the performance note on 'fromListWith'.  fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromListWithKey f xs@@ -1608,6 +1660,8 @@ -- > 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+--+-- Also see the performance note on 'fromListWith'.  fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a fromAscListWith f xs@@ -1622,6 +1676,8 @@ -- > fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "ba")] -- > valid (fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")]) == True -- > valid (fromDescListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.  fromDescListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a fromDescListWith f xs@@ -1638,6 +1694,8 @@ -- > 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+--+-- Also see the performance note on 'fromListWith'.  fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromAscListWithKey f xs@@ -1666,6 +1724,8 @@ -- > fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "5:b5:ba")] -- > valid (fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")]) == True -- > valid (fromDescListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.  fromDescListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromDescListWithKey f xs@@ -1695,23 +1755,15 @@  -- For some reason, when 'singleton' is used in fromDistinctAscList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] in Data.Set.Internal. fromDistinctAscList :: [(k,a)] -> Map k a-fromDistinctAscList [] = Tip-fromDistinctAscList ((kx0, x0) : xs0) = x0 `seq` go (1::Int) (Bin 1 kx0 x0 Tip Tip) xs0+fromDistinctAscList = fromDistinctAscList_linkAll . Foldable.foldl' next (State0 Nada)   where-    go !_ t [] = t-    go s l ((kx, x) : xs) =-      case create s xs of-        (r :*: ys) -> x `seq` let !t' = link kx x l r-                           in go (s `shiftL` 1) t' ys--    create !_ [] = (Tip :*: [])-    create s xs@(x' : xs')-      | s == 1 = case x' of (kx, x) -> x `seq` (Bin 1 kx x Tip Tip :*: xs')-      | otherwise = case create (s `shiftR` 1) xs of-                      res@(_ :*: []) -> res-                      (l :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of-                        (r :*: zs) -> y `seq` (link ky y l r :*: zs)+    next :: FromDistinctMonoState k a -> (k,a) -> FromDistinctMonoState k a+    next (State0 stk) (!kx, !x) = fromDistinctAscList_linkTop (Bin 1 kx x Tip Tip) stk+    next (State1 l stk) (kx, x) = State0 (Push kx x l stk)+{-# INLINE fromDistinctAscList #-}  -- INLINE for fusion  -- | \(O(n)\). Build a map from a descending list of distinct elements in linear time. -- /The precondition is not checked./@@ -1722,20 +1774,12 @@  -- For some reason, when 'singleton' is used in fromDistinctDescList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] in Data.Set.Internal. fromDistinctDescList :: [(k,a)] -> Map k a-fromDistinctDescList [] = Tip-fromDistinctDescList ((kx0, x0) : xs0) = x0 `seq` go (1::Int) (Bin 1 kx0 x0 Tip Tip) xs0+fromDistinctDescList = fromDistinctDescList_linkAll . Foldable.foldl' next (State0 Nada)   where-    go !_ t [] = t-    go s r ((kx, x) : xs) =-      case create s xs of-        (l :*: ys) -> x `seq` let !t' = link kx x l r-                              in go (s `shiftL` 1) t' ys--    create !_ [] = (Tip :*: [])-    create s xs@(x' : xs')-      | s == 1 = case x' of (kx, x) -> x `seq` (Bin 1 kx x Tip Tip :*: xs')-      | otherwise = case create (s `shiftR` 1) xs of-                      res@(_ :*: []) -> res-                      (r :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of-                        (l :*: zs) -> y `seq` (link ky y l r :*: zs)+    next :: FromDistinctMonoState k a -> (k,a) -> FromDistinctMonoState k a+    next (State0 stk) (!kx, !x) = fromDistinctDescList_linkTop (Bin 1 kx x Tip Tip) stk+    next (State1 r stk) (kx, x) = State0 (Push kx x r stk)+{-# INLINE fromDistinctDescList #-}  -- INLINE for fusion

@@ -249,7 +249,6 @@ import Prelude () #ifdef __HADDOCK_VERSION__ import Control.Monad (Monad (..))-import Control.Applicative (Applicative (..)) import Data.Functor (Functor (..)) #endif 

@@ -191,24 +191,25 @@     node3,     ) where -import Prelude hiding (+import Data.Strict.ContainersUtils.Autogen.Prelude hiding (     Functor(..), #if MIN_VERSION_base(4,11,0)     (<>), #endif-    Applicative, (<$>), foldMap, Monoid,-    null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1,+    (<$>), Monoid,+    null, length, lookup, take, drop, splitAt,     scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,     unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)-import Control.Applicative (Applicative(..), (<$>), (<**>),  Alternative,-                            liftA2, liftA3)+import Prelude ()+import Control.Applicative ((<$>), (<**>),  Alternative,+                            liftA3) import qualified Control.Applicative as Applicative import Control.DeepSeq (NFData(rnf)) import Control.Monad (MonadPlus(..)) import Data.Monoid (Monoid(..)) import Data.Functor (Functor(..)) import Data.Strict.ContainersUtils.Autogen.State (State(..), execState)-import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, foldl', foldr'), toList)+import Data.Foldable (foldr', toList) import qualified Data.Foldable as F  import qualified Data.Semigroup as Semigroup@@ -223,6 +224,8 @@ import Data.Data import Data.String (IsString(..)) import qualified Language.Haskell.TH.Syntax as TH+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () import GHC.Generics (Generic, Generic1) #endif @@ -269,10 +272,8 @@ infixr 5 :<| infixl 5 :|> -#if __GLASGOW_HASKELL__ >= 801 {-# COMPLETE (:<|), Empty #-} {-# COMPLETE (:|>), Empty #-}-#endif  -- | A bidirectional pattern synonym matching an empty sequence. --@@ -338,7 +339,7 @@ newtype Seq a = Seq (FingerTree (Elem a))  #ifdef __GLASGOW_HASKELL__--- | @since FIXME+-- | @since 0.6.6 instance TH.Lift a => TH.Lift (Seq a) where #  if MIN_VERSION_template_haskell(2,16,0)   liftTyped t = [|| coerceFT z ||]@@ -523,9 +524,7 @@     pure = singleton     xs *> ys = cycleNTimes (length xs) ys     (<*>) = apSeq-#if MIN_VERSION_base(4,10,0)     liftA2 = liftA2Seq-#endif     xs <* ys = beforeSeq xs ys  apSeq :: Seq (a -> b) -> Seq a -> Seq b@@ -1008,6 +1007,7 @@ -- | @since 0.6.1 deriving instance Generic (FingerTree a) +-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (FingerTree a) #endif @@ -1201,6 +1201,7 @@ -- | @since 0.6.1 deriving instance Generic (Digit a) +-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (Digit a) #endif @@ -1304,6 +1305,7 @@ -- | @since 0.6.1 deriving instance Generic (Node a) +-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (Node a) #endif @@ -1702,7 +1704,8 @@   | otherwise   = error "replicateA takes a nonnegative integer argument" {-# SPECIALIZE replicateA :: Int -> State a b -> State a (Seq b) #-} --- | 'replicateM' is a sequence counterpart of 'Control.Monad.replicateM'.+-- | 'replicateM' is the @Seq@ counterpart of+-- @Control.Monad.'Control.Monad.replicateM'@. -- -- > replicateM n x = sequence (replicate n x) --@@ -1879,7 +1882,8 @@ (><)            :: Seq a -> Seq a -> Seq a Seq xs >< Seq ys = Seq (appendTree0 xs ys) --- The appendTree/addDigits gunk below is machine generated+-- The appendTree/addDigits gunk below was originally machine generated via mkappend.hs,+-- but has since been manually edited to include strictness annotations.  appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a) appendTree0 EmptyT xs =@@ -2171,7 +2175,7 @@ -- | @since 0.5.8 deriving instance Generic (ViewL a) --- | @since FIXME+-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (ViewL a) #endif @@ -2238,7 +2242,7 @@ -- | @since 0.5.8 deriving instance Generic (ViewR a) --- | @since FIXME+-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (ViewR a) #endif @@ -4637,6 +4641,8 @@ -- | @ 'mzipWith' = 'zipWith' @ -- -- @ 'munzip' = 'unzip' @+--+-- @since 0.5.10.1 instance MonadZip Seq where   mzipWith = zipWith   munzip = unzip

@@ -125,7 +125,7 @@   partition, unstablePartition, partitionWith, span, break, groupBy, group,    -- ** Searching-  elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices,+  elem, notElem, find, findIndex, findIndexR, findIndices, elemIndex, elemIndices,    -- * Folding   foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1',@@ -187,6 +187,9 @@                        )  import Control.Monad ( MonadPlus(..), liftM, ap )+#if !MIN_VERSION_base(4,13,0)+import Control.Monad (fail)+#endif import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive import qualified Control.Monad.Fail as Fail@@ -194,19 +197,10 @@ import Control.Monad.Zip import Data.Function ( fix ) -import Prelude hiding ( length, null,-                        replicate, (++), concat,-                        head, last,-                        init, tail, take, drop, splitAt, reverse,-                        map, concatMap,-                        zipWith, zipWith3, zip, zip3, unzip, unzip3,-                        filter, takeWhile, dropWhile, span, break,-                        elem, notElem,-                        foldl, foldl1, foldr, foldr1, foldMap,-                        all, any, and, or, sum, product, minimum, maximum,-                        scanl, scanl1, scanr, scanr1,-                        enumFromTo, enumFromThenTo,-                        mapM, mapM_, sequence, sequence_ )+import Prelude+  ( Eq, Ord, Num, Enum, Monoid, Functor, Monad, Show, Bool, Ordering(..), Int, Maybe, Either+  , compare, mempty, mappend, mconcat, return, showsPrec, fmap, otherwise, id, flip, const, seq+  , (>>=), (+), (-), (<), (<=), (>), (>=), (==), (/=), (&&), (.), ($) )  import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) import Data.Typeable  ( Typeable )@@ -1068,13 +1062,16 @@ -- Safe destructive updates -- ------------------------ --- | Apply a destructive operation to a vector. The operation will be+-- | Apply a destructive operation to a vector. The operation may be -- performed in place if it is safe to do so and will modify a copy of the--- vector otherwise.+-- vector otherwise (see 'Data.Strict.Vector.Autogen.Generic.New.New' for details). ----- @--- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\>--- @+-- ==== __Examples__+--+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> import qualified Data.Strict.Vector.Autogen.Mutable as MV+-- >>> V.modify (\v -> MV.write v 0 'x') $ V.replicate 4 'a'+-- "xaaa" modify :: (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p@@ -1483,6 +1480,14 @@ {-# INLINE findIndex #-} findIndex = G.findIndex +-- | /O(n)/ Yield 'Just' the index of the /last/ element matching the predicate+-- or 'Nothing' if no such element exists.+--+-- Does not fuse.+findIndexR :: (a -> Bool) -> Vector a -> Maybe Int+{-# INLINE findIndexR #-}+findIndexR = G.findIndexR+ -- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending -- order. findIndices :: (a -> Bool) -> Vector a -> Vector Int@@ -2250,3 +2255,4 @@  -- $setup -- >>> :set -Wno-type-defaults+-- >>> import Prelude (Char, String, Bool(True, False), min, max, fst, even, undefined)

@@ -27,7 +27,10 @@ ) where  import GHC.Exts (Int(..), Int#)-import Prelude hiding( error, (&&), (||), not )+import Prelude+  ( Eq, Bool(..), Word, String+  , otherwise, fromIntegral, show, unlines+  , (-), (<), (<=), (>=), ($), (++) ) import qualified Prelude as P import GHC.Stack (HasCallStack) 

@@ -76,8 +76,10 @@ import           Data.Primitive.Array import           Control.Monad.Primitive -import Prelude hiding ( length, null, replicate, reverse, read,-                        take, drop, splitAt, init, tail, foldr, foldl, mapM_ )+import Prelude+  ( Ord, Monad, Bool, Ordering(..), Int, Maybe+  , compare, return, otherwise, error+  , (>>=), (+), (-), (*), (<), (>), (>=), (&&), (||), ($), (>>) )  import Data.Typeable ( Typeable ) @@ -742,3 +744,6 @@ toMutableArray :: PrimMonad m => MVector (PrimState m) a -> m (MutableArray (PrimState m) a) {-# INLINE toMutableArray #-} toMutableArray (MVector offset size marr) = cloneMutableArray marr offset size++-- $setup+-- >>> import Prelude (Integer)

@@ -1,6 +1,6 @@ Cabal-Version:  2.2 Name:           strict-containers-Version:        0.2+Version:        0.2.1 Synopsis:       Strict containers. Category:       Data, Data Structures Description:@@ -39,9 +39,9 @@   . -- generated list for versions -- DO NOT EDIT below, AUTOGEN versions-  * containers v0.6.6-  * unordered-containers v0.2.19.1-  * vector vector-0.13.0.0+  * containers v0.7+  * unordered-containers v0.2.20+  * vector vector-0.13.1.0 -- DO NOT EDIT above, AUTOGEN versions License:        BSD-3-Clause License-File:   LICENSE@@ -53,8 +53,8 @@     CHANGELOG.md     -- generated list for includes     -- DO NOT EDIT below, AUTOGEN includes-    include/vector.h     include/containers.h+    include/vector.h     -- DO NOT EDIT above, AUTOGEN includes tested-with:   GHC ==8.2.2@@ -63,8 +63,11 @@    || ==8.8.4    || ==8.10.7    || ==9.0.2-   || ==9.2.4-   || ==9.4.2+   || ==9.2.8+   || ==9.4.8+   || ==9.6.5+   || ==9.8.2+   || ==9.10.1  library   default-language: Haskell2010@@ -75,13 +78,13 @@       base                    >= 4.5.0.0   && < 5     , array                   >= 0.4.0.0     , binary                  >= 0.8.4.1   && < 0.9-    , containers              >= 0.6.6     && < 0.7-    , deepseq                 >= 1.2       && < 1.5+    , containers              >= 0.6.6     && < 0.8+    , deepseq                 >= 1.2       && < 1.6     , indexed-traversable     >= 0.1.1     && < 0.2-    , hashable                >= 1.2.7.0   && < 1.5-    , primitive               >= 0.6.4.0   && < 0.8+    , hashable                >= 1.2.7.0   && < 1.6+    , primitive               >= 0.6.4.0   && < 0.10     , unordered-containers    >= 0.2.19.1  && < 0.3-    , strict                  >= 0.4       && < 0.5+    , strict                  >= 0.4       && < 0.6     , template-haskell     , vector                  >= 0.13.0.0  && < 0.14     , vector-binary-instances >= 0.2.2.0   && < 0.3@@ -91,35 +94,36 @@     Data.Strict.HashMap.Internal     -- generated list for HashMap     -- DO NOT EDIT below, AUTOGEN HashMap-    Data.Strict.HashMap.Autogen.Strict     Data.Strict.HashMap.Autogen.Internal+    Data.Strict.HashMap.Autogen.Internal.List     Data.Strict.HashMap.Autogen.Internal.Array+    Data.Strict.HashMap.Autogen.Internal.Debug     Data.Strict.HashMap.Autogen.Internal.Strict-    Data.Strict.HashMap.Autogen.Internal.List+    Data.Strict.HashMap.Autogen.Strict     -- DO NOT EDIT above, AUTOGEN HashMap     Data.Strict.HashSet     Data.Strict.IntMap     Data.Strict.IntMap.Internal     -- generated list for IntMap     -- DO NOT EDIT below, AUTOGEN IntMap-    Data.Strict.IntMap.Autogen.Strict-    Data.Strict.IntMap.Autogen.Internal-    Data.Strict.IntMap.Autogen.Merge.Strict     Data.Strict.IntMap.Autogen.Strict.Internal-    Data.Strict.IntMap.Autogen.Internal.Debug+    Data.Strict.IntMap.Autogen.Internal     Data.Strict.IntMap.Autogen.Internal.DeprecatedDebug+    Data.Strict.IntMap.Autogen.Internal.Debug+    Data.Strict.IntMap.Autogen.Strict+    Data.Strict.IntMap.Autogen.Merge.Strict     -- DO NOT EDIT above, AUTOGEN IntMap     Data.Strict.IntSet     Data.Strict.Map     Data.Strict.Map.Internal     -- generated list for Map     -- DO NOT EDIT below, AUTOGEN Map-    Data.Strict.Map.Autogen.Strict-    Data.Strict.Map.Autogen.Internal-    Data.Strict.Map.Autogen.Merge.Strict     Data.Strict.Map.Autogen.Strict.Internal+    Data.Strict.Map.Autogen.Internal     Data.Strict.Map.Autogen.Internal.Debug     Data.Strict.Map.Autogen.Internal.DeprecatedShowTree+    Data.Strict.Map.Autogen.Strict+    Data.Strict.Map.Autogen.Merge.Strict     -- DO NOT EDIT above, AUTOGEN Map     Data.Strict.Sequence     Data.Strict.Sequence.Internal@@ -132,22 +136,23 @@     Data.Strict.Set     -- generated list for ContainersUtils     -- DO NOT EDIT below, AUTOGEN ContainersUtils-    Data.Strict.ContainersUtils.Autogen.Coercions-    Data.Strict.ContainersUtils.Autogen.BitUtil-    Data.Strict.ContainersUtils.Autogen.StrictPair-    Data.Strict.ContainersUtils.Autogen.StrictMaybe     Data.Strict.ContainersUtils.Autogen.PtrEquality-    Data.Strict.ContainersUtils.Autogen.State     Data.Strict.ContainersUtils.Autogen.BitQueue     Data.Strict.ContainersUtils.Autogen.TypeError+    Data.Strict.ContainersUtils.Autogen.StrictMaybe+    Data.Strict.ContainersUtils.Autogen.StrictPair+    Data.Strict.ContainersUtils.Autogen.State+    Data.Strict.ContainersUtils.Autogen.Prelude+    Data.Strict.ContainersUtils.Autogen.BitUtil+    Data.Strict.ContainersUtils.Autogen.Coercions     -- DO NOT EDIT above, AUTOGEN ContainersUtils     Data.Strict.Vector     Data.Strict.Vector.Internal     -- generated list for Vector     -- DO NOT EDIT below, AUTOGEN Vector     Data.Strict.Vector.Autogen-    Data.Strict.Vector.Autogen.Mutable     Data.Strict.Vector.Autogen.Internal.Check+    Data.Strict.Vector.Autogen.Mutable     -- DO NOT EDIT above, AUTOGEN Vector    include-dirs: include@@ -157,8 +162,8 @@ common containers-deps   build-depends:       array    >=0.4.0.0-    , base     >=4.9.1   && <5-    , deepseq  >=1.2     && <1.5+    , base     >=4.10    && <5+    , deepseq  >=1.2     && <1.6     , template-haskell  common containers-test-deps

@@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-} module Tests.Bundle ( tests ) where  import Boilerplater

@@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-} module Tests.Vector.Property   ( CommonContext   , VanillaContext@@ -31,6 +32,7 @@ import Control.Monad.ST import qualified Data.Traversable as T (Traversable(..)) import Data.Orphans ()+import Data.Maybe import Data.Foldable (foldrM) import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as MV

@@ -1,11 +1,15 @@+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeOperators #-} module Utilities where  import Test.QuickCheck  import Data.Foldable-import qualified Data.Strict.Vector as DV+import Data.Bifunctor+import qualified Data.Strict.Vector as DSV+import qualified Data.Vector as DV import qualified Data.Vector.Generic as DVG import qualified Data.Vector.Primitive as DVP import qualified Data.Vector.Storable as DVS@@ -14,7 +18,6 @@  import Control.Monad (foldM, foldM_, zipWithM, zipWithM_) import Control.Monad.Trans.Writer-import Data.Function (on) import Data.Functor.Identity import Data.List ( sortBy ) import Data.Maybe (catMaybes)@@ -67,68 +70,67 @@   unmodel :: Model a -> a    type EqTest a+  type instance EqTest a = Property   equal :: a -> a -> EqTest a+  default equal :: (Eq a, EqTest a ~ Property) => a -> a -> EqTest a+  equal x y = property (x == y) + instance (Eq a, TestData a) => TestData (S.Bundle v a) where   type Model (S.Bundle v a) = [Model a]   model   = map model  . S.toList   unmodel = S.fromList . map unmodel -  type EqTest (S.Bundle v a) = Property-  equal x y = property (x == y)- instance (Eq a, TestData a) => TestData (DV.Vector a) where   type Model (DV.Vector a) = [Model a]   model   = map model    . DV.toList   unmodel = DV.fromList . map unmodel -  type EqTest (DV.Vector a) = Property-  equal x y = property (x == y)- instance (Eq a, DVP.Prim a, TestData a) => TestData (DVP.Vector a) where   type Model (DVP.Vector a) = [Model a]   model   = map model    . DVP.toList   unmodel = DVP.fromList . map unmodel -  type EqTest (DVP.Vector a) = Property-  equal x y = property (x == y)- instance (Eq a, DVS.Storable a, TestData a) => TestData (DVS.Vector a) where   type Model (DVS.Vector a) = [Model a]   model   = map model    . DVS.toList   unmodel = DVS.fromList . map unmodel -  type EqTest (DVS.Vector a) = Property-  equal x y = property (x == y)- instance (Eq a, DVU.Unbox a, TestData a) => TestData (DVU.Vector a) where   type Model (DVU.Vector a) = [Model a]   model   = map model    . DVU.toList   unmodel = DVU.fromList . map unmodel -  type EqTest (DVU.Vector a) = Property-  equal x y = property (x == y)+instance (Eq a, TestData a) => TestData (DSV.Vector a) where+  type Model (DSV.Vector a) = [Model a]+  model   = map model    . DSV.toList+  unmodel = DSV.fromList . map unmodel  #define id_TestData(ty) \ instance TestData ty where { \   type Model ty = ty;        \   model = id;                \-  unmodel = id;              \-                             \-  type EqTest ty = Property; \-  equal x y = property (x == y) }+  unmodel = id }             \  id_TestData(()) id_TestData(Bool) id_TestData(Int)-id_TestData(Float)-id_TestData(Double) id_TestData(Ordering) -bimapEither :: (a -> b) -> (c -> d) -> Either a c -> Either b d-bimapEither f _ (Left a) = Left (f a)-bimapEither _ g (Right c) = Right (g c)+instance TestData Float where+  type Model Float = Float+  model = id+  unmodel = id +  equal x y = property (x == y || (isNaN x && isNaN y))++instance TestData Double where+  type Model Double = Double+  model = id+  unmodel = id++  equal x y = property (x == y || (isNaN x && isNaN y))+ -- Functorish models -- All of these need UndecidableInstances although they are actually well founded. Oh well. instance (Eq a, TestData a) => TestData (Maybe a) where@@ -136,57 +138,36 @@   model = fmap model   unmodel = fmap unmodel -  type EqTest (Maybe a) = Property-  equal x y = property (x == y)- instance (Eq a, TestData a, Eq b, TestData b) => TestData (Either a b) where   type Model (Either a b) = Either (Model a) (Model b)-  model = bimapEither model model-  unmodel = bimapEither unmodel unmodel--  type EqTest (Either a b) = Property-  equal x y = property (x == y)+  model = bimap model model+  unmodel = bimap unmodel unmodel  instance (Eq a, TestData a) => TestData [a] where   type Model [a] = [Model a]   model = fmap model   unmodel = fmap unmodel -  type EqTest [a] = Property-  equal x y = property (x == y)- instance (Eq a, TestData a) => TestData (Identity a) where   type Model (Identity a) = Identity (Model a)   model = fmap model   unmodel = fmap unmodel -  type EqTest (Identity a) = Property-  equal = (property .) . on (==) runIdentity- instance (Eq a, TestData a, Eq b, TestData b, Monoid a) => TestData (Writer a b) where   type Model (Writer a b) = Writer (Model a) (Model b)   model = mapWriter model   unmodel = mapWriter unmodel -  type EqTest (Writer a b) = Property-  equal = (property .) . on (==) runWriter- instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where   type Model (a,b) = (Model a, Model b)   model (a,b) = (model a, model b)   unmodel (a,b) = (unmodel a, unmodel b) -  type EqTest (a,b) = Property-  equal x y = property (x == y)- instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where   type Model (a,b,c) = (Model a, Model b, Model c)   model (a,b,c) = (model a, model b, model c)   unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c) -  type EqTest (a,b,c) = Property-  equal x y = property (x == y)- instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where   type Model (a -> b) = Model a -> Model b   model f = model . f . unmodel@@ -312,9 +293,6 @@ ifilter :: (Int -> a -> Bool) -> [a] -> [a] ifilter f = map snd . withIndexFirst filter f -mapMaybe :: (a -> Maybe b) -> [a] -> [b]-mapMaybe f = catMaybes . map f- imapMaybe :: (Int -> a -> Maybe b) -> [a] -> [b] imapMaybe f = catMaybes . withIndexFirst map f @@ -374,3 +352,9 @@     | ours >= 0     , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))     | otherwise                       = Nothing++instance Arbitrary a => Arbitrary (DSV.Vector a) where+  arbitrary = fmap DSV.fromList arbitrary++instance CoArbitrary a => CoArbitrary (DSV.Vector a) where+    coarbitrary = coarbitrary . DSV.toList

@@ -21,7 +21,7 @@ import Data.Foldable (foldMap) import Data.Function import Data.Traversable (Traversable(traverse), foldMapDefault)-import Prelude hiding (lookup, null, map, filter, foldr, foldl)+import Prelude hiding (lookup, null, map, filter, foldr, foldl, foldl') import qualified Prelude (map)  import Data.List (nub,sort)@@ -180,10 +180,14 @@              , testProperty "deleteMax"            prop_deleteMaxModel              , testProperty "filter"               prop_filter              , testProperty "partition"            prop_partition+             , testProperty "takeWhileAntitone"    prop_takeWhileAntitone+             , testProperty "dropWhileAntitone"    prop_dropWhileAntitone+             , testProperty "spanAntitone"         prop_spanAntitone              , testProperty "map"                  prop_map              , testProperty "fmap"                 prop_fmap              , testProperty "mapkeys"              prop_mapkeys              , testProperty "split"                prop_splitModel+             , testProperty "splitLookup"          prop_splitLookup              , testProperty "splitRoot"            prop_splitRoot              , testProperty "foldr"                prop_foldr              , testProperty "foldr'"               prop_foldr'@@ -1469,6 +1473,26 @@       m === let (a,b) = (List.partition (apply p . snd) xs)             in (fromList a, fromList b) +prop_takeWhileAntitone :: Int -> [(Int, Int)] -> Property+prop_takeWhileAntitone x ys =+  let l = takeWhileAntitone (<x) (fromList ys)+  in  valid l .&&.+      l === fromList (List.filter ((<x) . fst) ys)++prop_dropWhileAntitone :: Int -> [(Int, Int)] -> Property+prop_dropWhileAntitone x ys =+  let r = dropWhileAntitone (<x) (fromList ys)+  in  valid r .&&.+      r === fromList (List.filter ((>=x) . fst) ys)++prop_spanAntitone :: Int -> [(Int, Int)] -> Property+prop_spanAntitone x ys =+  let (l, r) = spanAntitone (<x) (fromList ys)+  in  valid l .&&.+      valid r .&&.+      l === fromList (List.filter ((<x) . fst) ys) .&&.+      r === fromList (List.filter ((>=x) . fst) ys)+ prop_map :: Fun Int Int -> [(Int, Int)] -> Property prop_map f ys = length ys > 0 ==>   let xs = List.nubBy ((==) `on` fst) ys@@ -1495,6 +1519,16 @@       valid r .&&.       toAscList l === sort [(k, v) | (k,v) <- xs, k < n] .&&.       toAscList r === sort [(k, v) | (k,v) <- xs, k > n]++prop_splitLookup :: Int -> [(Int, Int)] -> Property+prop_splitLookup n ys =+    let xs = List.nubBy ((==) `on` fst) ys+        (l, x, r) = splitLookup n (fromList xs)+    in  valid l .&&.+        valid r .&&.+        x === List.lookup n xs .&&.+        toAscList l === sort [(k, v) | (k,v) <- xs, k < n] .&&.+        toAscList r === sort [(k, v) | (k,v) <- xs, k > n]  prop_splitRoot :: IMap -> Bool prop_splitRoot s = loop ls && (s == unions ls)

@@ -22,10 +22,8 @@ import Data.Semigroup (Arg(..)) import Data.Function import qualified Data.Foldable as Foldable-#if MIN_VERSION_base(4,10,0) import qualified Data.Bifoldable as Bifoldable-#endif-import Prelude hiding (lookup, null, map, filter, foldr, foldl, take, drop, splitAt)+import Prelude hiding (lookup, null, map, filter, foldr, foldl, foldl', take, drop, splitAt) import qualified Prelude  import Data.List (nub,sort)@@ -187,6 +185,7 @@          , testProperty "mergeWithKey model"   prop_mergeWithKeyModel          , testProperty "mergeA effects"       prop_mergeA_effects          , testProperty "fromAscList"          prop_ordered+         , testProperty "fromDistinctAscList"  prop_fromDistinctAscList          , testProperty "fromDescList"         prop_rev_ordered          , testProperty "fromDistinctDescList" prop_fromDistinctDescList          , testProperty "fromList then toList" prop_list@@ -232,14 +231,12 @@          , testProperty "foldlWithKey"         prop_foldlWithKey          , testProperty "foldl'"               prop_foldl'          , testProperty "foldlWithKey'"        prop_foldlWithKey'-#if MIN_VERSION_base(4,10,0)          , testProperty "bifold"               prop_bifold          , testProperty "bifoldMap"            prop_bifoldMap          , testProperty "bifoldr"              prop_bifoldr          , testProperty "bifoldr'"             prop_bifoldr'          , testProperty "bifoldl"              prop_bifoldl          , testProperty "bifoldl'"             prop_bifoldl'-#endif          , testProperty "keysSet"              prop_keysSet          , testProperty "argSet"               prop_argSet          , testProperty "fromSet"              prop_fromSet@@ -1243,10 +1240,13 @@ prop_descList :: [Int] -> Bool prop_descList xs = (reverse (sort (nub xs)) == [x | (x,()) <- toDescList (fromList [(x,()) | x <- xs])]) -prop_fromDistinctDescList :: Int -> [A] -> Property-prop_fromDistinctDescList top lst = valid converted .&&. (toList converted === reverse original) where-  original = zip [top, (top-1)..0] lst-  converted = fromDistinctDescList original+prop_fromDistinctDescList :: [(Int, A)] -> Property+prop_fromDistinctDescList xs =+    valid t .&&.+    toList t === nub_sort_xs+  where+    t = fromDistinctDescList (reverse nub_sort_xs)+    nub_sort_xs = List.map List.head $ List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) xs  prop_ascDescList :: [Int] -> Bool prop_ascDescList xs = toAscList m == reverse (toDescList m)@@ -1256,11 +1256,17 @@ prop_fromList xs   = case fromList (zip xs xs) of       t -> t == fromAscList (zip sort_xs sort_xs) &&-           t == fromDistinctAscList (zip nub_sort_xs nub_sort_xs) &&            t == List.foldr (uncurry insert) empty (zip xs xs)   where sort_xs = sort xs-        nub_sort_xs = List.map List.head $ List.group sort_xs +prop_fromDistinctAscList :: [(Int, A)] -> Property+prop_fromDistinctAscList xs =+    valid t .&&.+    toList t === nub_sort_xs+  where+    t = fromDistinctAscList nub_sort_xs+    nub_sort_xs = List.map List.head $ List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) xs+ ----------------------------------------------------------------  prop_alter :: UMap -> Int -> Bool@@ -1531,7 +1537,6 @@   where     c' acc k v = apply c (acc, k, v) -#if MIN_VERSION_base(4,10,0) prop_bifold :: Map Int Int -> Property prop_bifold m = Bifoldable.bifold (mapKeys (:[]) ((:[]) <$> m)) === Foldable.fold ((\(k,v) -> [k,v]) <$> toList m) @@ -1565,7 +1570,6 @@     ck' = curry (apply ck)     cv' = curry (apply cv)     acc `c'` (k,v) = (acc `ck'` k) `cv'` v-#endif  prop_keysSet :: [(Int, Int)] -> Bool prop_keysSet xs =

@@ -30,7 +30,7 @@ import Data.Traversable (Traversable(traverse), sequenceA) import Prelude hiding (   lookup, null, length, take, drop, splitAt,-  foldl, foldl1, foldr, foldr1, scanl, scanl1, scanr, scanr1,+  foldl, foldl', foldl1, foldr, foldr1, scanl, scanl1, scanr, scanr1,   filter, reverse, replicate, zip, zipWith, zip3, zipWith3,   all, sum) import qualified Prelude