Make bitsPerSubkey platform-dependent

Author: sjakobi

Data/HashMap/Internal.hs

@@ -127,9 +127,9 @@ module Data.HashMap.Internal
     , sparseIndex
     , two
     , unionArrayBy
-    , update32
-    , update32M
-    , update32With'
+    , updateFullArray
+    , updateFullArrayM
+    , updateFullArrayWith'
     , updateOrConcatWithKey
     , filterMapAux
     , equalKeys
@@ -832,7 +832,7 @@ insert' h0 k0 v0 m0 = go h0 k0 v0 0 m0
             !st' = go h k x (nextShift s) st
         in if st' `ptrEq` st
             then t
-            else Full (update32 ary i st')
+            else Full (updateFullArray 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)
@@ -866,7 +866,7 @@ insertNewKey !h0 !k0 x0 !m0 = go h0 k0 x0 0 m0
     go h k x s (Full ary) =
         let !st  = A.index ary i
             !st' = go h k x (nextShift s) st
-        in Full (update32 ary i st')
+        in Full (updateFullArray ary i st')
       where i = index h s
     go h k x s t@(Collision hy v)
         | h == hy   = Collision h (A.snoc v (L k x))
@@ -895,7 +895,7 @@ insertKeyExists !collPos0 !h0 !k0 x0 !m0 = go collPos0 h0 k0 x0 m0
     go collPos shiftedHash k x (Full ary) =
         let !st  = A.index ary i
             !st' = go collPos (shiftHash shiftedHash) k x st
-        in Full (update32 ary i st')
+        in Full (updateFullArray ary i st')
       where i = index' shiftedHash
     go collPos _shiftedHash k x (Collision h v)
         | collPos >= 0 = Collision h (setAtPosition collPos k x v)
@@ -1043,7 +1043,7 @@ insertModifying x f k0 m0 = go h0 k0 0 m0
     go h k s t@(Full ary) =
         let !st   = A.index ary i
             !st'  = go h k (nextShift s) st
-            ary' = update32 ary i $! st'
+            ary' = updateFullArray ary i $! st'
         in if ptrEq st st'
            then t
            else Full ary'
@@ -1272,7 +1272,7 @@ adjust# f k0 m0 = go h0 k0 0 m0
         let i    = index h s
             !st   = A.index ary i
             !st'  = go h k (nextShift s) st
-            ary' = update32 ary i $! st'
+            ary' = updateFullArray ary i $! st'
         in if ptrEq st st'
            then t
            else Full ary'
@@ -1558,12 +1558,6 @@ submapBitmapIndexed comp !b1 !ary1 !b2 !ary2 = subsetBitmaps && go 0 0 (b1Orb2 .
     go !i !j !m
       | m > b1Orb2 = True
 
-#if WORD_SIZE_IN_BITS == 32
-      -- m can overflow to 0 on 32-bit platforms.
-      -- See #491.
-      | m == 0 = True
-#endif
-
       -- In case a key is both in ary1 and ary2, check ary1[i] <= ary2[j] and
       -- increment the indices i and j.
       | b1Andb2 .&. m /= 0 = comp (A.index ary1 i) (A.index ary2 j) &&
@@ -1668,12 +1662,12 @@ unionWithKey f = go 0
     go s (Full ary1) t2 =
         let h2   = leafHashCode t2
             i    = index h2 s
-            ary' = update32With' ary1 i $ \st1 -> go (nextShift s) st1 t2
+            ary' = updateFullArrayWith' 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 (nextShift s) t1 st2
+            ary' = updateFullArrayWith' ary2 i $ \st2 -> go (nextShift s) t1 st2
         in Full ary'
 
     leafHashCode (Leaf h _) = h
@@ -2414,24 +2408,24 @@ subsetArray cmpV ary1 ary2 = A.length ary1 <= A.length ary2 && A.all inAry2 ary1
 -- Manually unrolled loops
 
 -- | \(O(n)\) Update the element at the given position in this array.
-update32 :: A.Array e -> Int -> e -> A.Array e
-update32 ary idx b = runST (update32M ary idx b)
-{-# INLINE update32 #-}
+updateFullArray :: A.Array e -> Int -> e -> A.Array e
+updateFullArray ary idx b = runST (updateFullArrayM ary idx b)
+{-# INLINE updateFullArray #-}
 
 -- | \(O(n)\) Update the element at the given position in this array.
-update32M :: A.Array e -> Int -> e -> ST s (A.Array e)
-update32M ary idx b = do
+updateFullArrayM :: A.Array e -> Int -> e -> ST s (A.Array e)
+updateFullArrayM ary idx b = do
     mary <- clone ary
     A.write mary idx b
     A.unsafeFreeze mary
-{-# INLINE update32M #-}
+{-# INLINE updateFullArrayM #-}
 
 -- | \(O(n)\) Update the element at the given position in this array, by applying a function to it.
-update32With' :: A.Array e -> Int -> (e -> e) -> A.Array e
-update32With' ary idx f
+updateFullArrayWith' :: A.Array e -> Int -> (e -> e) -> A.Array e
+updateFullArrayWith' ary idx f
   | (# x #) <- A.index# ary idx
-  = update32 ary idx $! f x
-{-# INLINE update32With' #-}
+  = updateFullArray ary idx $! f x
+{-# INLINE updateFullArrayWith' #-}
 
 -- | Unsafely clone an array of (2^bitsPerSubkey) elements.  The length of the input
 -- array is not checked.
@@ -2448,8 +2442,16 @@ clone ary =
 -- | Number of bits that are inspected at each level of the hash tree.
 --
 -- This constant is named /t/ in the original /Ideal Hash Trees/ paper.
+--
+-- Note that this constant is platform-dependent. On 32-bit platforms we use
+-- '4', because bitmaps using '2^5' bits turned out to be prone to integer
+-- overflow bugs. See #491 for instance.
 bitsPerSubkey :: Int
+#if WORD_SIZE_IN_BITS < 64
+bitsPerSubkey = 4
+#else
 bitsPerSubkey = 5
+#endif
 
 -- | The size of a 'Full' node, i.e. @2 ^ 'bitsPerSubkey'@.
 maxChildren :: Int

Data/HashMap/Internal/Strict.hs

@@ -39,7 +39,7 @@
 -- strings.
 --
 -- Many operations have a average-case complexity of \(O(\log n)\).  The
--- implementation uses a large base (i.e. 32) so in practice these
+-- implementation uses a large base (i.e. 16 or 32) so in practice these
 -- operations are constant time.
 module Data.HashMap.Internal.Strict
     (
@@ -211,7 +211,7 @@ insertWith f k0 v0 m0 = go h0 k0 v0 0 m0
     go h k x s (Full ary) =
         let st   = A.index ary i
             st'  = go h k x (nextShift s) st
-            ary' = HM.update32 ary i $! st'
+            ary' = HM.updateFullArray ary i $! st'
         in Full ary'
       where i = index h s
     go h k x s t@(Collision hy v)
@@ -282,7 +282,7 @@ adjust f k0 m0 = go h0 k0 0 m0
         let i    = index h s
             st   = A.index ary i
             st'  = go h k (nextShift s) st
-            ary' = HM.update32 ary i $! st'
+            ary' = HM.updateFullArray ary i $! st'
         in Full ary'
     go h k _ t@(Collision hy v)
         | h == hy   = Collision h (updateWith f k v)
@@ -516,12 +516,12 @@ unionWithKey f = go 0
     go s (Full ary1) t2 =
         let h2   = leafHashCode t2
             i    = index h2 s
-            ary' = HM.update32With' ary1 i $ \st1 -> go (nextShift s) st1 t2
+            ary' = HM.updateFullArrayWith' 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 (nextShift s) t1 st2
+            ary' = HM.updateFullArrayWith' ary2 i $ \st2 -> go (nextShift s) t1 st2
         in Full ary'
 
     leafHashCode (Leaf h _) = h

Data/HashMap/Lazy.hs

@@ -20,7 +20,7 @@
 -- strings.
 --
 -- Many operations have a average-case complexity of \(O(\log n)\).  The
--- implementation uses a large base (i.e. 32) so in practice these
+-- implementation uses a large base (i.e. 16 or 32) so in practice these
 -- operations are constant time.
 module Data.HashMap.Lazy
     (

Data/HashMap/Strict.hs

@@ -19,7 +19,7 @@
 -- strings.
 --
 -- Many operations have a average-case complexity of \(O(\log n)\).  The
--- implementation uses a large base (i.e. 32) so in practice these
+-- implementation uses a large base (i.e. 16 or 32) so in practice these
 -- operations are constant time.
 module Data.HashMap.Strict
     (

Data/HashSet.hs

@@ -87,7 +87,7 @@ especially when value comparisons are expensive, as in the case of
 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. 16 or 32) so in practice these
 operations are constant time.
 -}
 

Data/HashSet/Internal.hs

@@ -37,7 +37,7 @@
 -- strings.
 --
 -- Many operations have a average-case complexity of \(O(\log n)\).  The
--- implementation uses a large base (i.e. 32) so in practice these
+-- implementation uses a large base (i.e. 16 or 32) so in practice these
 -- operations are constant time.
 
 module Data.HashSet.Internal

docs/developer-guide.md

@@ -103,7 +103,8 @@ Here's a quick overview in order of simplicity:
    it contains *2^B* elements.
 
 The number of bits of the hash value to use at each level of the tree, *B*, is a
-compile time constant, currently 5. In general a larger *B* improves lookup
+compile time constant, currently 5 on 64-bit platforms, and 4 on platforms with
+a smaller word size. In general a larger *B* improves lookup
 performance (shallower tree) but hurts modification (large nodes to copy when
 updating the spine of the tree).