[Git][ghc/ghc][wip/T22010] Fix Word64Set

[Jaro Reinders (@Noughtmare)]

Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC


Commits:
8f6a284d by Jaro Reinders at 2023-06-22T12:07:02+02:00
Fix Word64Set

- - - - -


3 changed files:

- compiler/GHC/Cmm/LRegSet.hs
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Set/Internal.hs


Changes:

=====================================
compiler/GHC/Cmm/LRegSet.hs
=====================================
@@ -27,7 +27,7 @@ import GHC.Data.Word64Set as Word64Set
 -- Compact sets for membership tests of local variables.
 
 type LRegSet = Word64Set.Word64Set
-type LRegKey = Int
+type LRegKey = Word64
 
 emptyLRegSet :: LRegSet
 emptyLRegSet = Word64Set.empty


=====================================
compiler/GHC/Data/Word64Map/Internal.hs
=====================================
@@ -3088,7 +3088,7 @@ keysSet (Bin p m l r)
 fromSet :: (Key -> a) -> Word64Set.Word64Set -> Word64Map a
 fromSet _ Word64Set.Nil = Nil
 fromSet f (Word64Set.Bin p m l r) = Bin p m (fromSet f l) (fromSet f r)
-fromSet f (Word64Set.Tip kx bm) = buildTree f kx bm (fromIntegral (Word64Set.suffixBitMask + 1))
+fromSet f (Word64Set.Tip kx bm) = buildTree f kx bm (Word64Set.suffixBitMask + 1)
   where
     -- This is slightly complicated, as we to convert the dense
     -- representation of Word64Set into tree representation of Word64Map.


=====================================
compiler/GHC/Data/Word64Set/Internal.hs
=====================================
@@ -1568,7 +1568,7 @@ indexOfTheOnlyBit bitmask = fromIntegral $ countTrailingZeros bitmask
 
 lowestBitSet x = fromIntegral $ countTrailingZeros x
 
-highestBitSet x = fromIntegral $ WORD_SIZE_IN_BITS - 1 - countLeadingZeros x
+highestBitSet x = fromIntegral $ 63 - countLeadingZeros x
 
 lowestBitMask :: Nat -> Nat
 lowestBitMask x = x .&. negate x
@@ -1598,21 +1598,21 @@ foldl'Bits prefix f z bitmap = go bitmap z
 
 foldrBits prefix f z bitmap = go (revNat bitmap) z
   where go 0 acc = acc
-        go bm acc = go (bm `xor` bitmask) ((f $! (prefix+(WORD_SIZE_IN_BITS-1)-bi)) acc)
+        go bm acc = go (bm `xor` bitmask) ((f $! (prefix+63-bi)) acc)
           where !bitmask = lowestBitMask bm
                 !bi = indexOfTheOnlyBit bitmask
 
 
 foldr'Bits prefix f z bitmap = go (revNat bitmap) z
   where go 0 acc = acc
-        go bm !acc = go (bm `xor` bitmask) ((f $! (prefix+(WORD_SIZE_IN_BITS-1)-bi)) acc)
+        go bm !acc = go (bm `xor` bitmask) ((f $! (prefix+63-bi)) acc)
           where !bitmask = lowestBitMask bm
                 !bi = indexOfTheOnlyBit bitmask
 
 takeWhileAntitoneBits prefix predicate bitmap =
   -- Binary search for the first index where the predicate returns false, but skip a predicate
   -- call if the high half of the current range is empty. This ensures
-  -- min (log2 WORD_SIZE_IN_BITS + 1) (popcount bitmap) predicate calls.
+  -- min (log2 64 + 1 = 7) (popcount bitmap) predicate calls.
   let next d h (n',b') =
         if n' .&. h /= 0 && (predicate $! prefix + fromIntegral (b'+d)) then (n' `shiftRL` d, b'+d) else (n',b')
       {-# INLINE next #-}



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f6a284d2e50d8f1b43387e55c63cc8238891767

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f6a284d2e50d8f1b43387e55c63cc8238891767
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230622/a9c7b215/attachment-0001.html>