diff options
Diffstat (limited to 'libraries/base/Data/Bits.hs')
| -rw-r--r-- | libraries/base/Data/Bits.hs | 82 |
1 files changed, 75 insertions, 7 deletions
diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs index d12d6dc4bd..18110b55a8 100644 --- a/libraries/base/Data/Bits.hs +++ b/libraries/base/Data/Bits.hs @@ -57,17 +57,13 @@ module Data.Bits ( #include "MachDeps.h" -#if defined(MIN_VERSION_integer_gmp) -# define HAVE_INTEGER_GMP1 MIN_VERSION_integer_gmp(1,0,0) -#endif - import Data.Maybe import GHC.Enum import GHC.Num import GHC.Base import GHC.Real -#if HAVE_INTEGER_GMP1 +#if defined(MIN_VERSION_integer_gmp) import GHC.Integer.GMP.Internals (bitInteger, popCountInteger) #endif @@ -194,8 +190,12 @@ class Eq a => Bits a where {-| Return the number of bits in the type of the argument. The actual value of the argument is ignored. The function 'bitSize' is undefined for types that do not have a fixed bitsize, like 'Integer'. + + Default implementation based upon 'bitSizeMaybe' provided since + 4.12.0.0. -} bitSize :: a -> Int + bitSize b = fromMaybe (error "bitSize is undefined") (bitSizeMaybe b) {-| Return 'True' if the argument is a signed type. The actual value of the argument is ignored -} @@ -245,7 +245,7 @@ class Eq a => Bits a where x `shiftR` i = x `shift` (-i) {-| Shift the first argument right by the specified number of bits, which - must be non-negative an smaller than the number of bits in the type. + must be non-negative and smaller than the number of bits in the type. Right shifts perform sign extension on signed number types; i.e. they fill the top bits with 1 if the @x@ is negative @@ -526,7 +526,7 @@ instance Bits Integer where testBit x (I# i) = testBitInteger x i zeroBits = 0 -#if HAVE_INTEGER_GMP1 +#if defined(MIN_VERSION_integer_gmp) bit (I# i#) = bitInteger i# popCount x = I# (popCountInteger x) #else @@ -540,6 +540,74 @@ instance Bits Integer where bitSize _ = errorWithoutStackTrace "Data.Bits.bitSize(Integer)" isSigned _ = True +#if defined(MIN_VERSION_integer_gmp) +-- | @since 4.8.0 +instance Bits Natural where + (.&.) = andNatural + (.|.) = orNatural + xor = xorNatural + complement _ = errorWithoutStackTrace + "Bits.complement: Natural complement undefined" + shift x i + | i >= 0 = shiftLNatural x i + | otherwise = shiftRNatural x (negate i) + testBit x i = testBitNatural x i + zeroBits = wordToNaturalBase 0## + clearBit x i = x `xor` (bit i .&. x) + + bit (I# i#) = bitNatural i# + popCount x = popCountNatural x + + rotate x i = shift x i -- since an Natural never wraps around + + bitSizeMaybe _ = Nothing + bitSize _ = errorWithoutStackTrace "Data.Bits.bitSize(Natural)" + isSigned _ = False +#else +-- | @since 4.8.0.0 +instance Bits Natural where + Natural n .&. Natural m = Natural (n .&. m) + {-# INLINE (.&.) #-} + Natural n .|. Natural m = Natural (n .|. m) + {-# INLINE (.|.) #-} + xor (Natural n) (Natural m) = Natural (xor n m) + {-# INLINE xor #-} + complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined" + {-# INLINE complement #-} + shift (Natural n) = Natural . shift n + {-# INLINE shift #-} + rotate (Natural n) = Natural . rotate n + {-# INLINE rotate #-} + bit = Natural . bit + {-# INLINE bit #-} + setBit (Natural n) = Natural . setBit n + {-# INLINE setBit #-} + clearBit (Natural n) = Natural . clearBit n + {-# INLINE clearBit #-} + complementBit (Natural n) = Natural . complementBit n + {-# INLINE complementBit #-} + testBit (Natural n) = testBit n + {-# INLINE testBit #-} + bitSizeMaybe _ = Nothing + {-# INLINE bitSizeMaybe #-} + bitSize = errorWithoutStackTrace "Natural: bitSize" + {-# INLINE bitSize #-} + isSigned _ = False + {-# INLINE isSigned #-} + shiftL (Natural n) = Natural . shiftL n + {-# INLINE shiftL #-} + shiftR (Natural n) = Natural . shiftR n + {-# INLINE shiftR #-} + rotateL (Natural n) = Natural . rotateL n + {-# INLINE rotateL #-} + rotateR (Natural n) = Natural . rotateR n + {-# INLINE rotateR #-} + popCount (Natural n) = popCount n + {-# INLINE popCount #-} + zeroBits = Natural 0 + +#endif + ----------------------------------------------------------------------------- -- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using |