@@ -1641,55 +1641,12 @@ takeWhileAntitoneBits :: Int -> (Int -> Bool) -> Nat -> Nat
16411641{-# INLINE foldr'Bits #-}
16421642{-# INLINE takeWhileAntitoneBits #-}
16431643
1644- #if defined(__GLASGOW_HASKELL__) && (WORD_SIZE_IN_BITS==32 || WORD_SIZE_IN_BITS==64)
1645- indexOfTheOnlyBit :: Nat -> Int
1646- {-# INLINE indexOfTheOnlyBit #-}
1647- #if WORD_SIZE_IN_BITS==64
1648- indexOfTheOnlyBit bitmask = countTrailingZeros bitmask
1644+ #if defined(__GLASGOW_HASKELL__)
16491645
16501646lowestBitSet x = countTrailingZeros x
16511647
16521648highestBitSet x = WORD_SIZE_IN_BITS - 1 - countLeadingZeros x
16531649
1654- #else
1655- {- ---------------------------------------------------------------------
1656- For lowestBitSet we use wordsize-dependant implementation based on
1657- multiplication and DeBrujn indeces, which was proposed by Edward Kmett
1658- <http://haskell.org/pipermail/libraries/2011-September/016749.html>
1659-
1660- The core of this implementation is fast indexOfTheOnlyBit,
1661- which is given a Nat with exactly one bit set, and returns
1662- its index.
1663-
1664- Lot of effort was put in these implementations, please benchmark carefully
1665- before changing this code.
1666- ----------------------------------------------------------------------}
1667-
1668- indexOfTheOnlyBit bitmask =
1669- fromIntegral (GHC.Int. I8# (lsbArray `GHC.Exts. indexInt8OffAddr# ` unboxInt (intFromNat ((bitmask * magic) `shiftRL` offset))))
1670- where unboxInt (GHC.Exts. I# i) = i
1671- #if WORD_SIZE_IN_BITS==32
1672- magic = 0x077CB531
1673- offset = 27
1674- ! lsbArray = " \0\1\28\2\29\14\24\3\30\22\20\15\25\17\4\8\31\27\13\23\21\19\16\7\26\12\18\6\11\5\10\9" #
1675- #else
1676- magic = 0x07EDD5E59A4E28C2
1677- offset = 58
1678- ! lsbArray = " \63\0\58\1\59\47\53\2\60\39\48\27\54\33\42\3\61\51\37\40\49\18\28\20\55\30\34\11\43\14\22\4\62\57\46\52\38\26\32\41\50\36\17\19\29\10\13\21\56\45\25\31\35\16\9\12\44\24\15\8\23\7\6\5" #
1679- #endif
1680- -- The lsbArray gets inlined to every call site of indexOfTheOnlyBit.
1681- -- That cannot be easily avoided, as GHC forbids top-level Addr# literal.
1682- -- One could go around that by supplying getLsbArray :: () -> Addr# marked
1683- -- as NOINLINE. But the code size of calling it and processing the result
1684- -- is 48B on 32-bit and 56B on 64-bit architectures -- so the 32B and 64B array
1685- -- is actually improvement on 32-bit and only a 8B size increase on 64-bit.
1686-
1687- lowestBitSet x = indexOfTheOnlyBit (lowestBitMask x)
1688-
1689- highestBitSet x = indexOfTheOnlyBit (highestBitMask x)
1690-
1691- #endif
1692-
16931650lowestBitMask :: Nat -> Nat
16941651lowestBitMask x = x .&. negate x
16951652{-# INLINE lowestBitMask #-}
@@ -1716,26 +1673,26 @@ foldlBits prefix f z bitmap = go bitmap z
17161673 go bm acc = go (bm `xor` bitmask) ((f acc) $! (prefix+ bi))
17171674 where
17181675 ! bitmask = lowestBitMask bm
1719- ! bi = indexOfTheOnlyBit bitmask
1676+ ! bi = countTrailingZeros bitmask
17201677
17211678foldl'Bits prefix f z bitmap = go bitmap z
17221679 where go 0 acc = acc
17231680 go bm ! acc = go (bm `xor` bitmask) ((f acc) $! (prefix+ bi))
17241681 where ! bitmask = lowestBitMask bm
1725- ! bi = indexOfTheOnlyBit bitmask
1682+ ! bi = countTrailingZeros bitmask
17261683
17271684foldrBits prefix f z bitmap = go (revNat bitmap) z
17281685 where go 0 acc = acc
17291686 go bm acc = go (bm `xor` bitmask) ((f $! (prefix+ (WORD_SIZE_IN_BITS - 1 )- bi)) acc)
17301687 where ! bitmask = lowestBitMask bm
1731- ! bi = indexOfTheOnlyBit bitmask
1688+ ! bi = countTrailingZeros bitmask
17321689
17331690
17341691foldr'Bits prefix f z bitmap = go (revNat bitmap) z
17351692 where go 0 acc = acc
17361693 go bm ! acc = go (bm `xor` bitmask) ((f $! (prefix+ (WORD_SIZE_IN_BITS - 1 )- bi)) acc)
17371694 where ! bitmask = lowestBitMask bm
1738- ! bi = indexOfTheOnlyBit bitmask
1695+ ! bi = countTrailingZeros bitmask
17391696
17401697takeWhileAntitoneBits prefix predicate bitmap =
17411698 -- Binary search for the first index where the predicate returns false, but skip a predicate
0 commit comments