unordered-containers 0.2.15.0 → 0.2.16.0
raw patch · 7 files changed
+72/−125 lines, 7 files
Files
- CHANGES.md +12/−0
- Data/HashMap/Internal.hs +28/−27
- Data/HashMap/Internal/Array.hs +23/−89
- Data/HashMap/Internal/Strict.hs +6/−6
- Data/HashMap/Lazy.hs +1/−1
- Data/HashSet/Internal.hs +1/−1
- unordered-containers.cabal +1/−1
CHANGES.md view
@@ -1,3 +1,15 @@+## [0.2.16.0]++* [Increase maximum branching factor from 16 to 32](https://github.com/haskell-unordered-containers/unordered-containers/pull/317)++* [Tweak `union.goDifferentHash`](https://github.com/haskell-unordered-containers/unordered-containers/pull/277)++* [Fix debug mode bounds check in `cloneM`](https://github.com/haskell-unordered-containers/unordered-containers/pull/331)++* [Remove some old internal compatibility code](https://github.com/haskell-unordered-containers/unordered-containers/pull/334)++[0.2.16.0]: https://github.com/haskell-unordered-containers/unordered-containers/compare/v0.2.15.0...v0.2.16.0+ ## [0.2.15.0] * [Add security advisory regarding hash collision attacks](https://github.com/haskell-unordered-containers/unordered-containers/pull/320)
Data/HashMap/Internal.hs view
@@ -116,9 +116,9 @@ , sparseIndex , two , unionArrayBy- , update16- , update16M- , update16With'+ , update32+ , update32M+ , update32With' , updateOrConcatWith , updateOrConcatWithKey , filterMapAux@@ -809,7 +809,7 @@ !st' = go h k x (s+bitsPerSubkey) st in if st' `ptrEq` st then t- else Full (update16 ary i st')+ else Full (update32 ary i st') where i = index h s go h k x s t@(Collision hy v) | h == hy = Collision h (updateOrSnocWith (\a _ -> (# a #)) k x v)@@ -843,7 +843,7 @@ go h k x s (Full ary) = let !st = A.index ary i !st' = go h k x (s+bitsPerSubkey) st- in Full (update16 ary i st')+ in Full (update32 ary i st') where i = index h s go h k x s t@(Collision hy v) | h == hy = Collision h (snocNewLeaf (L k x) v)@@ -887,7 +887,7 @@ go collPos h k x s (Full ary) = let !st = A.index ary i !st' = go collPos h k x (s+bitsPerSubkey) st- in Full (update16 ary i st')+ in Full (update32 ary i st') where i = index h s go collPos h k x _s (Collision _hy v) | collPos >= 0 = Collision h (setAtPosition collPos k x v)@@ -1015,7 +1015,7 @@ go h k s t@(Full ary) = let !st = A.index ary i !st' = go h k (s+bitsPerSubkey) st- ary' = update16 ary i $! st'+ ary' = update32 ary i $! st' in if ptrEq st st' then t else Full ary'@@ -1236,7 +1236,7 @@ let i = index h s !st = A.index ary i !st' = go h k (s+bitsPerSubkey) st- ary' = update16 ary i $! st'+ ary' = update32 ary i $! st' in if ptrEq st st' then t else Full ary'@@ -1622,12 +1622,12 @@ go s (Full ary1) t2 = let h2 = leafHashCode t2 i = index h2 s- ary' = update16With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2+ ary' = update32With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2 in Full ary' go s t1 (Full ary2) = let h1 = leafHashCode t1 i = index h1 s- ary' = update16With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2+ ary' = update32With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2 in Full ary' leafHashCode (Leaf h _) = h@@ -1635,7 +1635,7 @@ leafHashCode _ = error "leafHashCode" goDifferentHash s h1 h2 t1 t2- | m1 == m2 = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2)+ | m1 == m2 = BitmapIndexed m1 (A.singleton $! goDifferentHash (s+bitsPerSubkey) h1 h2 t1 t2) | m1 < m2 = BitmapIndexed (m1 .|. m2) (A.pair t1 t2) | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1) where@@ -2252,36 +2252,36 @@ -- Manually unrolled loops -- | /O(n)/ Update the element at the given position in this array.-update16 :: A.Array e -> Int -> e -> A.Array e-update16 ary idx b = runST (update16M ary idx b)-{-# INLINE update16 #-}+update32 :: A.Array e -> Int -> e -> A.Array e+update32 ary idx b = runST (update32M ary idx b)+{-# INLINE update32 #-} -- | /O(n)/ Update the element at the given position in this array.-update16M :: A.Array e -> Int -> e -> ST s (A.Array e)-update16M ary idx b = do- mary <- clone16 ary+update32M :: A.Array e -> Int -> e -> ST s (A.Array e)+update32M ary idx b = do+ mary <- clone ary A.write mary idx b A.unsafeFreeze mary-{-# INLINE update16M #-}+{-# INLINE update32M #-} -- | /O(n)/ Update the element at the given position in this array, by applying a function to it.-update16With' :: A.Array e -> Int -> (e -> e) -> A.Array e-update16With' ary idx f+update32With' :: A.Array e -> Int -> (e -> e) -> A.Array e+update32With' ary idx f | (# x #) <- A.index# ary idx- = update16 ary idx $! f x-{-# INLINE update16With' #-}+ = update32 ary idx $! f x+{-# INLINE update32With' #-} --- | Unsafely clone an array of 16 elements. The length of the input+-- | Unsafely clone an array of (2^bitsPerSubkey) elements. The length of the input -- array is not checked.-clone16 :: A.Array e -> ST s (A.MArray s e)-clone16 ary =- A.thaw ary 0 16+clone :: A.Array e -> ST s (A.MArray s e)+clone ary =+ A.thaw ary 0 (2^bitsPerSubkey) ------------------------------------------------------------------------ -- Bit twiddling bitsPerSubkey :: Int-bitsPerSubkey = 4+bitsPerSubkey = 5 maxChildren :: Int maxChildren = 1 `unsafeShiftL` bitsPerSubkey@@ -2291,6 +2291,7 @@ sparseIndex :: Bitmap -> Bitmap -> Int sparseIndex b m = popCount (b .&. (m - 1))+{-# INLINE sparseIndex #-} mask :: Word -> Shift -> Bitmap mask w s = 1 `unsafeShiftL` index w s
Data/HashMap/Internal/Array.hs view
@@ -73,7 +73,7 @@ import Control.Applicative (liftA2) import Control.DeepSeq (NFData (..))-import GHC.Exts(Int(..), Int#, reallyUnsafePtrEquality#, tagToEnum#, unsafeCoerce#, State#)+import GHC.Exts(Int(..), reallyUnsafePtrEquality#, tagToEnum#, unsafeCoerce#) import GHC.ST (ST(..)) import Control.Monad.ST (runST, stToIO) @@ -94,72 +94,6 @@ import Control.Monad ((>=>)) --type Array# a = SmallArray# a-type MutableArray# a = SmallMutableArray# a--newArray# :: Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)-newArray# = newSmallArray#--unsafeFreezeArray# :: SmallMutableArray# d a- -> State# d -> (# State# d, SmallArray# a #)-unsafeFreezeArray# = unsafeFreezeSmallArray#--readArray# :: SmallMutableArray# d a- -> Int# -> State# d -> (# State# d, a #)-readArray# = readSmallArray#--writeArray# :: SmallMutableArray# d a- -> Int# -> a -> State# d -> State# d-writeArray# = writeSmallArray#--indexArray# :: SmallArray# a -> Int# -> (# a #)-indexArray# = indexSmallArray#--unsafeThawArray# :: SmallArray# a- -> State# d -> (# State# d, SmallMutableArray# d a #)-unsafeThawArray# = unsafeThawSmallArray#--sizeofArray# :: SmallArray# a -> Int#-sizeofArray# = sizeofSmallArray#--copyArray# :: SmallArray# a- -> Int#- -> SmallMutableArray# d a- -> Int#- -> Int#- -> State# d- -> State# d-copyArray# = copySmallArray#--cloneMutableArray# :: SmallMutableArray# s a- -> Int#- -> Int#- -> State# s- -> (# State# s, SmallMutableArray# s a #)-cloneMutableArray# = cloneSmallMutableArray#--thawArray# :: SmallArray# a- -> Int#- -> Int#- -> State# d- -> (# State# d, SmallMutableArray# d a #)-thawArray# = thawSmallArray#--sizeofMutableArray# :: SmallMutableArray# s a -> Int#-sizeofMutableArray# = sizeofSmallMutableArray#--copyMutableArray# :: SmallMutableArray# d a- -> Int#- -> SmallMutableArray# d a- -> Int#- -> Int#- -> State# d- -> State# d-copyMutableArray# = copySmallMutableArray#--------------------------------------------------------------------------- #if defined(ASSERTS) -- This fugly hack is brought by GHC's apparent reluctance to deal -- with MagicHash and UnboxedTuples when inferring types. Eek!@@ -179,7 +113,7 @@ #endif data Array a = Array {- unArray :: !(Array# a)+ unArray :: !(SmallArray# a) } instance Show a => Show (Array a) where@@ -207,15 +141,15 @@ !lenys = length ys0 length :: Array a -> Int-length ary = I# (sizeofArray# (unArray ary))+length ary = I# (sizeofSmallArray# (unArray ary)) {-# INLINE length #-} data MArray s a = MArray {- unMArray :: !(MutableArray# s a)+ unMArray :: !(SmallMutableArray# s a) } lengthM :: MArray s a -> Int-lengthM mary = I# (sizeofMutableArray# (unMArray mary))+lengthM mary = I# (sizeofSmallMutableArray# (unMArray mary)) {-# INLINE lengthM #-} ------------------------------------------------------------------------@@ -255,10 +189,10 @@ -- state thread, with each element containing the specified initial -- value. new :: Int -> a -> ST s (MArray s a)-new (I# n#) b =- CHECK_GT("new",n,(0 :: Int))+new _n@(I# n#) b =+ CHECK_GT("new",_n,(0 :: Int)) ST $ \s ->- case newArray# n# b s of+ case newSmallArray# n# b s of (# s', ary #) -> (# s', MArray ary #) {-# INLINE new #-} @@ -283,43 +217,43 @@ read :: MArray s a -> Int -> ST s a read ary _i@(I# i#) = ST $ \ s -> CHECK_BOUNDS("read", lengthM ary, _i)- readArray# (unMArray ary) i# s+ readSmallArray# (unMArray ary) i# s {-# INLINE read #-} write :: MArray s a -> Int -> a -> ST s () write ary _i@(I# i#) b = ST $ \ s -> CHECK_BOUNDS("write", lengthM ary, _i)- case writeArray# (unMArray ary) i# b s of+ case writeSmallArray# (unMArray ary) i# b s of s' -> (# s' , () #) {-# INLINE write #-} index :: Array a -> Int -> a index ary _i@(I# i#) = CHECK_BOUNDS("index", length ary, _i)- case indexArray# (unArray ary) i# of (# b #) -> b+ case indexSmallArray# (unArray ary) i# of (# b #) -> b {-# INLINE index #-} index# :: Array a -> Int -> (# a #) index# ary _i@(I# i#) = CHECK_BOUNDS("index#", length ary, _i)- indexArray# (unArray ary) i#+ indexSmallArray# (unArray ary) i# {-# INLINE index# #-} indexM :: Array a -> Int -> ST s a indexM ary _i@(I# i#) = CHECK_BOUNDS("indexM", length ary, _i)- case indexArray# (unArray ary) i# of (# b #) -> return b+ case indexSmallArray# (unArray ary) i# of (# b #) -> return b {-# INLINE indexM #-} unsafeFreeze :: MArray s a -> ST s (Array a) unsafeFreeze mary- = ST $ \s -> case unsafeFreezeArray# (unMArray mary) s of+ = ST $ \s -> case unsafeFreezeSmallArray# (unMArray mary) s of (# s', ary #) -> (# s', Array ary #) {-# INLINE unsafeFreeze #-} unsafeThaw :: Array a -> ST s (MArray s a) unsafeThaw ary- = ST $ \s -> case unsafeThawArray# (unArray ary) s of+ = ST $ \s -> case unsafeThawSmallArray# (unArray ary) s of (# s', mary #) -> (# s', MArray mary #) {-# INLINE unsafeThaw #-} @@ -333,7 +267,7 @@ CHECK_LE("copy", _sidx + _n, length src) CHECK_LE("copy", _didx + _n, lengthM dst) ST $ \ s# ->- case copyArray# (unArray src) sidx# (unMArray dst) didx# n# s# of+ case copySmallArray# (unArray src) sidx# (unMArray dst) didx# n# s# of s2 -> (# s2, () #) -- | Unsafely copy the elements of an array. Array bounds are not checked.@@ -342,15 +276,15 @@ CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1) CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1) ST $ \ s# ->- case copyMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of+ case copySmallMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of s2 -> (# s2, () #) cloneM :: MArray s a -> Int -> Int -> ST s (MArray s a) cloneM _mary@(MArray mary#) _off@(I# off#) _len@(I# len#) =- CHECK_BOUNDS("cloneM_off", lengthM _mary, _off - 1)+ CHECK_BOUNDS("cloneM_off", lengthM _mary, _off) CHECK_BOUNDS("cloneM_end", lengthM _mary, _off + _len - 1) ST $ \ s ->- case cloneMutableArray# mary# off# len# s of+ case cloneSmallMutableArray# mary# off# len# s of (# s', mary'# #) -> (# s', MArray mary'# #) -- | Create a new array of the @n@ first elements of @mary@.@@ -474,9 +408,9 @@ {-# NOINLINE undefinedElem #-} thaw :: Array e -> Int -> Int -> ST s (MArray s e)-thaw !ary !_o@(I# o#) (I# n#) =- CHECK_LE("thaw", _o + n, length ary)- ST $ \ s -> case thawArray# (unArray ary) o# n# s of+thaw !ary !_o@(I# o#) _n@(I# n#) =+ CHECK_LE("thaw", _o + _n, length ary)+ ST $ \ s -> case thawSmallArray# (unArray ary) o# n# s of (# s2, mary# #) -> (# s2, MArray mary# #) {-# INLINE thaw #-} @@ -543,7 +477,7 @@ toList :: Array a -> [a] toList = foldr (:) [] -newtype STA a = STA {_runSTA :: forall s. MutableArray# s a -> ST s (Array a)}+newtype STA a = STA {_runSTA :: forall s. SmallMutableArray# s a -> ST s (Array a)} runSTA :: Int -> STA a -> Array a runSTA !n (STA m) = runST $ new_ n >>= \ (MArray ar) -> m ar
Data/HashMap/Internal/Strict.hs view
@@ -35,7 +35,7 @@ -- strings. -- -- Many operations have a average-case complexity of /O(log n)/. The--- implementation uses a large base (i.e. 16) so in practice these+-- implementation uses a large base (i.e. 32) so in practice these -- operations are constant time. module Data.HashMap.Internal.Strict (@@ -195,7 +195,7 @@ go h k x s (Full ary) = let st = A.index ary i st' = go h k x (s+bitsPerSubkey) st- ary' = update16 ary i $! st'+ ary' = update32 ary i $! st' in Full ary' where i = index h s go h k x s t@(Collision hy v)@@ -266,7 +266,7 @@ let i = index h s st = A.index ary i st' = go h k (s+bitsPerSubkey) st- ary' = update16 ary i $! st'+ ary' = update32 ary i $! st' in Full ary' go h k _ t@(Collision hy v) | h == hy = Collision h (updateWith f k v)@@ -494,12 +494,12 @@ go s (Full ary1) t2 = let h2 = leafHashCode t2 i = index h2 s- ary' = update16With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2+ ary' = update32With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2 in Full ary' go s t1 (Full ary2) = let h1 = leafHashCode t1 i = index h1 s- ary' = update16With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2+ ary' = update32With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2 in Full ary' leafHashCode (Leaf h _) = h@@ -507,7 +507,7 @@ leafHashCode _ = error "leafHashCode" goDifferentHash s h1 h2 t1 t2- | m1 == m2 = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2)+ | m1 == m2 = BitmapIndexed m1 (A.singleton $! goDifferentHash (s+bitsPerSubkey) h1 h2 t1 t2) | m1 < m2 = BitmapIndexed (m1 .|. m2) (A.pair t1 t2) | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1) where
Data/HashMap/Lazy.hs view
@@ -20,7 +20,7 @@ -- strings. -- -- Many operations have a average-case complexity of /O(log n)/. The--- implementation uses a large base (i.e. 16) so in practice these+-- implementation uses a large base (i.e. 32) so in practice these -- operations are constant time. module Data.HashMap.Lazy (
Data/HashSet/Internal.hs view
@@ -35,7 +35,7 @@ -- strings. -- -- Many operations have a average-case complexity of /O(log n)/. The--- implementation uses a large base (i.e. 16) so in practice these+-- implementation uses a large base (i.e. 32) so in practice these -- operations are constant time. module Data.HashSet.Internal
unordered-containers.cabal view
@@ -1,5 +1,5 @@ name: unordered-containers-version: 0.2.15.0+version: 0.2.16.0 synopsis: Efficient hashing-based container types description: Efficient hashing-based container types. The containers have been