From 8088f6267e4c10ac8d7498604a5f564f54fee249 Mon Sep 17 00:00:00 2001 From: Bas van Dijk Date: Sat, 29 Oct 2011 03:33:08 +0200 Subject: [PATCH] Remove Num superclass of Bits Add and export bitDefault, testBitDefault and popCountDefault from Data.Bits. --- Data/Bits.hs | 57 ++++++++++++++++++++++++++++++++++++++++------------ GHC/Int.hs | 21 ++++++++++++++++++- GHC/Word.hs | 24 ++++++++++++++++++++++ NHC/SizedTypes.hs | 3 ++ 4 files changed, 91 insertions(+), 14 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index b145854..2fbd3f3 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -35,7 +35,11 @@ module Data.Bits ( shiftL, shiftR, -- :: a -> Int -> a rotateL, rotateR, -- :: a -> Int -> a popCount -- :: a -> Int - ) + ), + + bitDefault, + testBitDefault, + popCountDefault -- instance Bits Int -- instance Bits Integer @@ -73,7 +77,7 @@ Minimal complete definition: '.&.', '.|.', 'xor', 'complement', ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')), 'bitSize' and 'isSigned'. -} -class (Eq a, Num a) => Bits a where +class Eq a => Bits a where -- | Bitwise \"and\" (.&.) :: a -> a -> a @@ -154,16 +158,12 @@ class (Eq a, Num a) => Bits a where value of the argument is ignored -} isSigned :: a -> Bool - {-# INLINE bit #-} {-# INLINE setBit #-} {-# INLINE clearBit #-} {-# INLINE complementBit #-} - {-# INLINE testBit #-} - bit i = 1 `shiftL` i x `setBit` i = x .|. bit i x `clearBit` i = x .&. complement (bit i) x `complementBit` i = x `xor` bit i - x `testBit` i = (x .&. bit i) /= 0 {-| Shift the argument left by the specified number of bits (which must be non-negative). @@ -211,18 +211,41 @@ class (Eq a, Num a) => Bits a where {-| Return the number of set bits in the argument. This number is known as the population count or the Hamming weight. -} popCount :: a -> Int - popCount = go 0 - where - go !c 0 = c - go c w = go (c+1) (w .&. w - 1) -- clear the least significant bit set - {- This implementation is intentionally naive. Instances are - expected to override it with something optimized for their - size. -} + +-- | Default implementation for 'bit'. +-- +-- Note that: @bitDefault i = 1 `shiftL` i@ +bitDefault :: (Bits a, Num a) => Int -> a +bitDefault i = 1 `shiftL` i +{-# INLINE bitDefault #-} + +-- | Default implementation for 'testBit'. +-- +-- Note that: @testBitDefault x i = (x .&. bit i) /= 0@ +testBitDefault :: (Bits a, Num a) => a -> Int -> Bool +testBitDefault x i = (x .&. bit i) /= 0 +{-# INLINE testBitDefault #-} + +-- | Default implementation for 'popCount'. +-- +-- This implementation is intentionally naive. Instances are expected to provide +-- an optimized implementation for their size. +popCountDefault :: (Bits a, Num a) => a -> Int +popCountDefault = go 0 + where + go !c 0 = c + go c w = go (c+1) (w .&. w - 1) -- clear the least significant instance Bits Int where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} #ifdef __GLASGOW_HASKELL__ + bit = bitDefault + + testBit = testBitDefault + (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#)) @@ -251,6 +274,8 @@ instance Bits Int where #else /* !__GLASGOW_HASKELL__ */ + popCount = popCountDefault + #ifdef __HUGS__ (.&.) = primAndInt (.|.) = primOrInt @@ -267,6 +292,8 @@ instance Bits Int where complement = nhc_primIntCompl shiftL = nhc_primIntLsh shiftR = nhc_primIntRsh + bit = bitDefault + testBit = testBitDefault bitSize _ = 32 #endif /* __NHC__ */ @@ -319,6 +346,10 @@ instance Bits Integer where | otherwise = x `div` 2^(-i) #endif + bit = bitDefault + testBit = testBitDefault + popCount = popCountDefault + rotate x i = shift x i -- since an Integer never wraps around bitSize _ = error "Data.Bits.bitSize(Integer)" diff --git a/GHC/Int.hs b/GHC/Int.hs index f1fa304..84ecfd6 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -129,6 +129,8 @@ instance Read Int8 where instance Bits Int8 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (I8# x#) .&. (I8# y#) = I8# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I8# x#) .|. (I8# y#) = I8# (word2Int# (int2Word# x# `or#` int2Word# y#)) @@ -151,6 +153,8 @@ instance Bits Int8 where bitSize _ = 8 isSigned _ = True popCount (I8# x#) = I# (word2Int# (popCnt8# (int2Word# x#))) + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8 @@ -274,6 +278,8 @@ instance Read Int16 where instance Bits Int16 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (I16# x#) .&. (I16# y#) = I16# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I16# x#) .|. (I16# y#) = I16# (word2Int# (int2Word# x# `or#` int2Word# y#)) @@ -296,7 +302,8 @@ instance Bits Int16 where bitSize _ = 16 isSigned _ = True popCount (I16# x#) = I# (word2Int# (popCnt16# (int2Word# x#))) - + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (word2Int# x#) @@ -425,6 +432,8 @@ instance Read Int32 where instance Bits Int32 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (I32# x#) .&. (I32# y#) = I32# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I32# x#) .|. (I32# y#) = I32# (word2Int# (int2Word# x# `or#` int2Word# y#)) @@ -447,6 +456,8 @@ instance Bits Int32 where bitSize _ = 32 isSigned _ = True popCount (I32# x#) = I# (word2Int# (popCnt32# (int2Word# x#))) + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (word2Int# x#) @@ -609,6 +620,8 @@ instance Read Int64 where instance Bits Int64 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (I64# x#) .&. (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#)) (I64# x#) .|. (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `or64#` int64ToWord64# y#)) @@ -632,6 +645,8 @@ instance Bits Int64 where isSigned _ = True popCount (I64# x#) = I# (word2Int# (popCnt64# (int64ToWord64# x#))) + bit = bitDefault + testBit = testBitDefault -- give the 64-bit shift operations the same treatment as the 32-bit -- ones (see GHC.Base), namely we wrap them in tests to catch the @@ -736,6 +751,8 @@ instance Read Int64 where instance Bits Int64 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (I64# x#) .&. (I64# y#) = I64# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I64# x#) .|. (I64# y#) = I64# (word2Int# (int2Word# x# `or#` int2Word# y#)) @@ -758,6 +775,8 @@ instance Bits Int64 where bitSize _ = 64 isSigned _ = True popCount (I64# x#) = I# (word2Int# (popCnt64# (int2Word# x#))) + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x# diff --git a/GHC/Word.hs b/GHC/Word.hs index 42daf07..bfad309 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -137,6 +137,8 @@ instance Read Word where instance Bits Word where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (W# x#) .&. (W# y#) = W# (x# `and#` y#) (W# x#) .|. (W# y#) = W# (x# `or#` y#) @@ -157,6 +159,8 @@ instance Bits Word where bitSize _ = WORD_SIZE_IN_BITS isSigned _ = False popCount (W# x#) = I# (word2Int# (popCnt# x#)) + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/Int->Word" fromIntegral = \(I# x#) -> W# (int2Word# x#) @@ -244,6 +248,8 @@ instance Read Word8 where instance Bits Word8 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (W8# x#) .&. (W8# y#) = W8# (x# `and#` y#) (W8# x#) .|. (W8# y#) = W8# (x# `or#` y#) @@ -264,6 +270,8 @@ instance Bits Word8 where bitSize _ = 8 isSigned _ = False popCount (W8# x#) = I# (word2Int# (popCnt8# x#)) + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/Word8->Word8" fromIntegral = id :: Word8 -> Word8 @@ -378,6 +386,8 @@ instance Read Word16 where instance Bits Word16 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (W16# x#) .&. (W16# y#) = W16# (x# `and#` y#) (W16# x#) .|. (W16# y#) = W16# (x# `or#` y#) @@ -398,6 +408,8 @@ instance Bits Word16 where bitSize _ = 16 isSigned _ = False popCount (W16# x#) = I# (word2Int# (popCnt16# x#)) + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/Word8->Word16" fromIntegral = \(W8# x#) -> W16# x# @@ -553,6 +565,8 @@ instance Integral Word32 where instance Bits Word32 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (W32# x#) .&. (W32# y#) = W32# (x# `and#` y#) (W32# x#) .|. (W32# y#) = W32# (x# `or#` y#) @@ -573,6 +587,8 @@ instance Bits Word32 where bitSize _ = 32 isSigned _ = False popCount (W32# x#) = I# (word2Int# (popCnt32# x#)) + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/Word8->Word32" fromIntegral = \(W8# x#) -> W32# x# @@ -681,6 +697,8 @@ instance Integral Word64 where instance Bits Word64 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (W64# x#) .&. (W64# y#) = W64# (x# `and64#` y#) (W64# x#) .|. (W64# y#) = W64# (x# `or64#` y#) @@ -700,6 +718,8 @@ instance Bits Word64 where bitSize _ = 64 isSigned _ = False popCount (W64# x#) = I# (word2Int# (popCnt64# x#)) + bit = bitDefault + testBit = testBitDefault -- give the 64-bit shift operations the same treatment as the 32-bit -- ones (see GHC.Base), namely we wrap them in tests to catch the @@ -787,6 +807,8 @@ instance Integral Word64 where instance Bits Word64 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (W64# x#) .&. (W64# y#) = W64# (x# `and#` y#) (W64# x#) .|. (W64# y#) = W64# (x# `or#` y#) @@ -807,6 +829,8 @@ instance Bits Word64 where bitSize _ = 64 isSigned _ = False popCount (W64# x#) = I# (word2Int# (popCnt64# x#)) + bit = bitDefault + testBit = testBitDefault {-# RULES "fromIntegral/a->Word64" fromIntegral = \x -> case fromIntegral x of W# x# -> W64# x# diff --git a/NHC/SizedTypes.hs b/NHC/SizedTypes.hs index 497b3cc..85b2705 100644 --- a/NHC/SizedTypes.hs +++ b/NHC/SizedTypes.hs @@ -34,6 +34,9 @@ module NHC.SizedTypes ; shiftR = nhc_prim/**/T/**/Rsh \ ; bitSize _ = BS \ ; isSigned _ = S \ + ; bit = bitDefault \ + ; testBit = testBitDefault \ + ; popCount = popCountDefault \ } SIZED_TYPE(Int8,8,True) -- 1.7.5.4