diff options
Diffstat (limited to 'gnu/packages/patches/ghc-bloomfilter-ghc9.2.patch')
-rw-r--r-- | gnu/packages/patches/ghc-bloomfilter-ghc9.2.patch | 303 |
1 files changed, 303 insertions, 0 deletions
diff --git a/gnu/packages/patches/ghc-bloomfilter-ghc9.2.patch b/gnu/packages/patches/ghc-bloomfilter-ghc9.2.patch new file mode 100644 index 0000000000..97caf2cc9b --- /dev/null +++ b/gnu/packages/patches/ghc-bloomfilter-ghc9.2.patch @@ -0,0 +1,303 @@ +Taken from https://github.com/bos/bloomfilter/pull/20 + +From fb79b39c44404fd791a3bed973e9d844fb084f1e Mon Sep 17 00:00:00 2001 +From: Simon Jakobi <simon.jakobi@gmail.com> +Date: Fri, 12 Nov 2021 01:37:36 +0100 +Subject: [PATCH] Fix build with GHC 9.2 + +The `FastShift.shift{L,R}` methods are replaced with `unsafeShift{L,R}` +introduced in base-4.5. + +Fixes #19. +--- + Data/BloomFilter.hs | 16 +++++------ + Data/BloomFilter/Hash.hs | 15 +++++----- + Data/BloomFilter/Mutable.hs | 20 +++++++------- + Data/BloomFilter/Util.hs | 55 ++++++------------------------------- + bloomfilter.cabal | 2 +- + 5 files changed, 34 insertions(+), 74 deletions(-) + +diff --git a/Data/BloomFilter.hs b/Data/BloomFilter.hs +index 2210cef..6b47c21 100644 +--- a/Data/BloomFilter.hs ++++ b/Data/BloomFilter.hs +@@ -78,8 +78,8 @@ import Control.DeepSeq (NFData(..)) + import Data.Array.Base (unsafeAt) + import qualified Data.Array.Base as ST + import Data.Array.Unboxed (UArray) +-import Data.Bits ((.&.)) +-import Data.BloomFilter.Util (FastShift(..), (:*)(..)) ++import Data.Bits ((.&.), unsafeShiftL, unsafeShiftR) ++import Data.BloomFilter.Util ((:*)(..)) + import qualified Data.BloomFilter.Mutable as MB + import qualified Data.BloomFilter.Mutable.Internal as MB + import Data.BloomFilter.Mutable.Internal (Hash, MBloom) +@@ -98,7 +98,7 @@ data Bloom a = B { + } + + instance Show (Bloom a) where +- show ub = "Bloom { " ++ show ((1::Int) `shiftL` shift ub) ++ " bits } " ++ show ub = "Bloom { " ++ show ((1::Int) `unsafeShiftL` shift ub) ++ " bits } " + + instance NFData (Bloom a) where + rnf !_ = () +@@ -172,7 +172,7 @@ singleton hash numBits elt = create hash numBits (\mb -> MB.insert mb elt) + -- | Given a filter's mask and a hash value, compute an offset into + -- a word array and a bit offset within that word. + hashIdx :: Int -> Word32 -> (Int :* Int) +-hashIdx mask x = (y `shiftR` logBitsInHash) :* (y .&. hashMask) ++hashIdx mask x = (y `unsafeShiftR` logBitsInHash) :* (y .&. hashMask) + where hashMask = 31 -- bitsInHash - 1 + y = fromIntegral x .&. mask + +@@ -191,7 +191,7 @@ hashesU ub elt = hashIdx (mask ub) `map` hashes ub elt + -- /still/ some possibility that @True@ will be returned. + elem :: a -> Bloom a -> Bool + elem elt ub = all test (hashesU ub elt) +- where test (off :* bit) = (bitArray ub `unsafeAt` off) .&. (1 `shiftL` bit) /= 0 ++ where test (off :* bit) = (bitArray ub `unsafeAt` off) .&. (1 `unsafeShiftL` bit) /= 0 + + modify :: (forall s. (MBloom s a -> ST s z)) -- ^ mutation function (result is discarded) + -> Bloom a +@@ -255,11 +255,11 @@ insertList elts = modify $ \mb -> mapM_ (MB.insert mb) elts + -- is /still/ some possibility that @True@ will be returned. + notElem :: a -> Bloom a -> Bool + notElem elt ub = any test (hashesU ub elt) +- where test (off :* bit) = (bitArray ub `unsafeAt` off) .&. (1 `shiftL` bit) == 0 ++ where test (off :* bit) = (bitArray ub `unsafeAt` off) .&. (1 `unsafeShiftL` bit) == 0 + + -- | Return the size of an immutable Bloom filter, in bits. + length :: Bloom a -> Int +-length = shiftL 1 . shift ++length = unsafeShiftL 1 . shift + + -- | Build an immutable Bloom filter from a seed value. The seeding + -- function populates the filter as follows. +@@ -318,7 +318,7 @@ fromList hashes numBits = unfold hashes numBits convert + logPower2 :: Int -> Int + logPower2 k = go 0 k + where go j 1 = j +- go j n = go (j+1) (n `shiftR` 1) ++ go j n = go (j+1) (n `unsafeShiftR` 1) + + -- $overview + -- +diff --git a/Data/BloomFilter/Hash.hs b/Data/BloomFilter/Hash.hs +index 132a3a4..d071fd4 100644 +--- a/Data/BloomFilter/Hash.hs ++++ b/Data/BloomFilter/Hash.hs +@@ -38,8 +38,7 @@ module Data.BloomFilter.Hash + ) where + + import Control.Monad (foldM) +-import Data.Bits ((.&.), (.|.), xor) +-import Data.BloomFilter.Util (FastShift(..)) ++import Data.Bits ((.&.), (.|.), unsafeShiftL, unsafeShiftR, xor) + import Data.List (unfoldr) + import Data.Int (Int8, Int16, Int32, Int64) + import Data.Word (Word8, Word16, Word32, Word64) +@@ -91,11 +90,11 @@ class Hashable a where + -> Word64 -- ^ salt + -> IO Word64 + hashIO64 v salt = do +- let s1 = fromIntegral (salt `shiftR` 32) .&. maxBound ++ let s1 = fromIntegral (salt `unsafeShiftR` 32) .&. maxBound + s2 = fromIntegral salt + h1 <- hashIO32 v s1 + h2 <- hashIO32 v s2 +- return $ (fromIntegral h1 `shiftL` 32) .|. fromIntegral h2 ++ return $ (fromIntegral h1 `unsafeShiftL` 32) .|. fromIntegral h2 + + -- | Compute a 32-bit hash. + hash32 :: Hashable a => a -> Word32 +@@ -149,8 +148,8 @@ cheapHashes :: Hashable a => Int -- ^ number of hashes to compute + cheapHashes k v = go 0 + where go i | i == j = [] + | otherwise = hash : go (i + 1) +- where !hash = h1 + (h2 `shiftR` i) +- h1 = fromIntegral (h `shiftR` 32) ++ where !hash = h1 + (h2 `unsafeShiftR` i) ++ h1 = fromIntegral (h `unsafeShiftR` 32) + h2 = fromIntegral h + h = hashSalt64 0x9150a946c4a8966e v + j = fromIntegral k +@@ -163,7 +162,7 @@ instance Hashable Integer where + (salt `xor` 0x3ece731e) + | otherwise = hashIO32 (unfoldr go k) salt + where go 0 = Nothing +- go i = Just (fromIntegral i :: Word32, i `shiftR` 32) ++ go i = Just (fromIntegral i :: Word32, i `unsafeShiftR` 32) + + instance Hashable Bool where + hashIO32 = hashOne32 +@@ -224,7 +223,7 @@ instance Hashable Word64 where + -- | A fast unchecked shift. Nasty, but otherwise GHC 6.8.2 does a + -- test and branch on every shift. + div4 :: CSize -> CSize +-div4 k = fromIntegral ((fromIntegral k :: HTYPE_SIZE_T) `shiftR` 2) ++div4 k = fromIntegral ((fromIntegral k :: HTYPE_SIZE_T) `unsafeShiftR` 2) + + alignedHash :: Ptr a -> CSize -> Word32 -> IO Word32 + alignedHash ptr bytes salt +diff --git a/Data/BloomFilter/Mutable.hs b/Data/BloomFilter/Mutable.hs +index edff1fc..0bb5cc9 100644 +--- a/Data/BloomFilter/Mutable.hs ++++ b/Data/BloomFilter/Mutable.hs +@@ -65,9 +65,9 @@ module Data.BloomFilter.Mutable + import Control.Monad (liftM, forM_) + import Control.Monad.ST (ST) + import Data.Array.Base (unsafeRead, unsafeWrite) +-import Data.Bits ((.&.), (.|.)) ++import Data.Bits ((.&.), (.|.), unsafeShiftL, unsafeShiftR) + import Data.BloomFilter.Array (newArray) +-import Data.BloomFilter.Util (FastShift(..), (:*)(..), nextPowerOfTwo) ++import Data.BloomFilter.Util ((:*)(..), nextPowerOfTwo) + import Data.Word (Word32) + import Data.BloomFilter.Mutable.Internal + +@@ -86,9 +86,9 @@ new hash numBits = MB hash shft msk `liftM` newArray numElems numBytes + | numBits > maxHash = maxHash + | isPowerOfTwo numBits = numBits + | otherwise = nextPowerOfTwo numBits +- numElems = max 2 (twoBits `shiftR` logBitsInHash) +- numBytes = numElems `shiftL` logBytesInHash +- trueBits = numElems `shiftL` logBitsInHash ++ numElems = max 2 (twoBits `unsafeShiftR` logBitsInHash) ++ numBytes = numElems `unsafeShiftL` logBytesInHash ++ trueBits = numElems `unsafeShiftL` logBitsInHash + shft = logPower2 trueBits + msk = trueBits - 1 + isPowerOfTwo n = n .&. (n - 1) == 0 +@@ -109,7 +109,7 @@ logBytesInHash = 2 -- logPower2 (sizeOf (undefined :: Hash)) + -- | Given a filter's mask and a hash value, compute an offset into + -- a word array and a bit offset within that word. + hashIdx :: Int -> Word32 -> (Int :* Int) +-hashIdx msk x = (y `shiftR` logBitsInHash) :* (y .&. hashMask) ++hashIdx msk x = (y `unsafeShiftR` logBitsInHash) :* (y .&. hashMask) + where hashMask = 31 -- bitsInHash - 1 + y = fromIntegral x .&. msk + +@@ -125,7 +125,7 @@ insert mb elt = do + let mu = bitArray mb + forM_ (hashesM mb elt) $ \(word :* bit) -> do + old <- unsafeRead mu word +- unsafeWrite mu word (old .|. (1 `shiftL` bit)) ++ unsafeWrite mu word (old .|. (1 `unsafeShiftL` bit)) + + -- | Query a mutable Bloom filter for membership. If the value is + -- present, return @True@. If the value is not present, there is +@@ -135,7 +135,7 @@ elem elt mb = loop (hashesM mb elt) + where mu = bitArray mb + loop ((word :* bit):wbs) = do + i <- unsafeRead mu word +- if i .&. (1 `shiftL` bit) == 0 ++ if i .&. (1 `unsafeShiftL` bit) == 0 + then return False + else loop wbs + loop _ = return True +@@ -145,7 +145,7 @@ elem elt mb = loop (hashesM mb elt) + + -- | Return the size of a mutable Bloom filter, in bits. + length :: MBloom s a -> Int +-length = shiftL 1 . shift ++length = unsafeShiftL 1 . shift + + + -- | Slow, crummy way of computing the integer log of an integer known +@@ -153,7 +153,7 @@ length = shiftL 1 . shift + logPower2 :: Int -> Int + logPower2 k = go 0 k + where go j 1 = j +- go j n = go (j+1) (n `shiftR` 1) ++ go j n = go (j+1) (n `unsafeShiftR` 1) + + -- $overview + -- +diff --git a/Data/BloomFilter/Util.hs b/Data/BloomFilter/Util.hs +index 7f695dc..6ade6e5 100644 +--- a/Data/BloomFilter/Util.hs ++++ b/Data/BloomFilter/Util.hs +@@ -2,15 +2,11 @@ + + module Data.BloomFilter.Util + ( +- FastShift(..) +- , nextPowerOfTwo ++ nextPowerOfTwo + , (:*)(..) + ) where + +-import Data.Bits ((.|.)) +-import qualified Data.Bits as Bits +-import GHC.Base +-import GHC.Word ++import Data.Bits ((.|.), unsafeShiftR) + + -- | A strict pair type. + data a :* b = !a :* !b +@@ -22,46 +18,11 @@ nextPowerOfTwo :: Int -> Int + {-# INLINE nextPowerOfTwo #-} + nextPowerOfTwo n = + let a = n - 1 +- b = a .|. (a `shiftR` 1) +- c = b .|. (b `shiftR` 2) +- d = c .|. (c `shiftR` 4) +- e = d .|. (d `shiftR` 8) +- f = e .|. (e `shiftR` 16) +- g = f .|. (f `shiftR` 32) -- in case we're on a 64-bit host ++ b = a .|. (a `unsafeShiftR` 1) ++ c = b .|. (b `unsafeShiftR` 2) ++ d = c .|. (c `unsafeShiftR` 4) ++ e = d .|. (d `unsafeShiftR` 8) ++ f = e .|. (e `unsafeShiftR` 16) ++ g = f .|. (f `unsafeShiftR` 32) -- in case we're on a 64-bit host + !h = g + 1 + in h +- +--- | This is a workaround for poor optimisation in GHC 6.8.2. It +--- fails to notice constant-width shifts, and adds a test and branch +--- to every shift. This imposes about a 10% performance hit. +-class FastShift a where +- shiftL :: a -> Int -> a +- shiftR :: a -> Int -> a +- +-instance FastShift Word32 where +- {-# INLINE shiftL #-} +- shiftL (W32# x#) (I# i#) = W32# (x# `uncheckedShiftL#` i#) +- +- {-# INLINE shiftR #-} +- shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#) +- +-instance FastShift Word64 where +- {-# INLINE shiftL #-} +- shiftL (W64# x#) (I# i#) = W64# (x# `uncheckedShiftL64#` i#) +- +- {-# INLINE shiftR #-} +- shiftR (W64# x#) (I# i#) = W64# (x# `uncheckedShiftRL64#` i#) +- +-instance FastShift Int where +- {-# INLINE shiftL #-} +- shiftL (I# x#) (I# i#) = I# (x# `iShiftL#` i#) +- +- {-# INLINE shiftR #-} +- shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) +- +-instance FastShift Integer where +- {-# INLINE shiftL #-} +- shiftL = Bits.shiftL +- +- {-# INLINE shiftR #-} +- shiftR = Bits.shiftR +diff --git a/bloomfilter.cabal b/bloomfilter.cabal +index 821a5d7..c621f7f 100644 +--- a/bloomfilter.cabal ++++ b/bloomfilter.cabal +@@ -18,7 +18,7 @@ extra-source-files: README.markdown cbits/lookup3.c cbits/lookup3.h + library + build-depends: + array, +- base >= 4.4 && < 5, ++ base >= 4.5 && < 5, + bytestring >= 0.9, + deepseq + exposed-modules: Data.BloomFilter |