Commit 925782ed authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Add bitSizeMaybe to Bits, and add FiniteBits class

parent 39b9f94a
......@@ -30,6 +30,7 @@ module Data.Bits (
clearBit, -- :: a -> Int -> a
complementBit, -- :: a -> Int -> a
testBit, -- :: a -> Int -> Bool
bitSizeMaybe,
bitSize, -- :: a -> Int
isSigned, -- :: a -> Bool
shiftL, shiftR, -- :: a -> Int -> a
......@@ -37,6 +38,7 @@ module Data.Bits (
rotateL, rotateR, -- :: a -> Int -> a
popCount -- :: a -> Int
),
FiniteBits(finiteBitSize),
bitDefault,
testBitDefault,
......@@ -54,6 +56,7 @@ module Data.Bits (
#endif
#ifdef __GLASGOW_HASKELL__
import Data.Maybe
import GHC.Enum
import GHC.Num
import GHC.Base
......@@ -151,6 +154,12 @@ class Eq a => Bits a where
-- | Return 'True' if the @n@th bit of the argument is 1
testBit :: a -> Int -> Bool
{-| Return the number of bits in the type of the argument. The actual
value of the argument is ignored. Returns Nothing
for types that do not have a fixed bitsize, like 'Integer'.
-}
bitSizeMaybe :: a -> Maybe Int
{-| 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'.
......@@ -238,6 +247,9 @@ class Eq a => Bits a where
known as the population count or the Hamming weight. -}
popCount :: a -> Int
class Bits b => FiniteBits b where
finiteBitSize :: b -> Int
-- | Default implementation for 'bit'.
--
-- Note that: @bitDefault i = 1 `shiftL` i@
......@@ -297,7 +309,8 @@ instance Bits Int where
!x'# = int2Word# x#
!i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
!wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
bitSize _ = WORD_SIZE_IN_BITS
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))
......@@ -338,6 +351,9 @@ instance Bits Int where
isSigned _ = True
instance FiniteBits Int where
finiteBitSize _ = WORD_SIZE_IN_BITS
#ifdef __NHC__
foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
foreign import ccall nhc_primIntOr :: Int -> Int -> Int
......@@ -371,11 +387,15 @@ instance Bits Word where
where
!i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
!wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
bitSize _ = WORD_SIZE_IN_BITS
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
popCount (W# x#) = I# (word2Int# (popCnt# x#))
bit = bitDefault
testBit = testBitDefault
instance FiniteBits Word where
finiteBitSize _ = WORD_SIZE_IN_BITS
#endif
instance Bits Integer where
......@@ -413,6 +433,7 @@ instance Bits Integer where
rotate x i = shift x i -- since an Integer never wraps around
bitSizeMaybe _ = Nothing
bitSize _ = error "Data.Bits.bitSize(Integer)"
isSigned _ = True
......
......@@ -26,6 +26,7 @@ module GHC.Int (
) where
import Data.Bits
import Data.Maybe
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
......@@ -156,12 +157,16 @@ instance Bits Int8 where
where
!x'# = narrow8Word# (int2Word# x#)
!i'# = word2Int# (int2Word# i# `and#` 7##)
bitSize _ = 8
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = True
popCount (I8# x#) = I# (word2Int# (popCnt8# (int2Word# x#)))
bit = bitDefault
testBit = testBitDefault
instance FiniteBits Int8 where
finiteBitSize _ = 8
{-# RULES
"fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8
"fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)
......@@ -311,12 +316,16 @@ instance Bits Int16 where
where
!x'# = narrow16Word# (int2Word# x#)
!i'# = word2Int# (int2Word# i# `and#` 15##)
bitSize _ = 16
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = True
popCount (I16# x#) = I# (word2Int# (popCnt16# (int2Word# x#)))
bit = bitDefault
testBit = testBitDefault
instance FiniteBits Int16 where
finiteBitSize _ = 16
{-# RULES
"fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
"fromIntegral/Int8->Int16" fromIntegral = \(I8# x#) -> I16# x#
......@@ -472,12 +481,16 @@ instance Bits Int32 where
where
!x'# = narrow32Word# (int2Word# x#)
!i'# = word2Int# (int2Word# i# `and#` 31##)
bitSize _ = 32
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = True
popCount (I32# x#) = I# (word2Int# (popCnt32# (int2Word# x#)))
bit = bitDefault
testBit = testBitDefault
instance FiniteBits Int32 where
finiteBitSize _ = 32
{-# RULES
"fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (word2Int# x#)
"fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (word2Int# x#)
......@@ -662,7 +675,8 @@ instance Bits Int64 where
where
!x'# = int64ToWord64# x#
!i'# = word2Int# (int2Word# i# `and#` 63##)
bitSize _ = 64
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = True
popCount (I64# x#) =
I# (word2Int# (popCnt64# (int64ToWord64# x#)))
......@@ -799,7 +813,8 @@ instance Bits Int64 where
where
!x'# = int2Word# x#
!i'# = word2Int# (int2Word# i# `and#` 63##)
bitSize _ = 64
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = True
popCount (I64# x#) = I# (word2Int# (popCnt64# (int2Word# x#)))
bit = bitDefault
......@@ -847,6 +862,9 @@ uncheckedIShiftRA64# :: Int# -> Int# -> Int#
uncheckedIShiftRA64# = uncheckedIShiftRA#
#endif
instance FiniteBits Int64 where
finiteBitSize _ = 64
instance Real Int64 where
toRational x = toInteger x % 1
......
......@@ -27,6 +27,7 @@ module GHC.Word (
) where
import Data.Bits
import Data.Maybe
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
......@@ -142,12 +143,16 @@ instance Bits Word8 where
(x# `uncheckedShiftRL#` (8# -# i'#))))
where
!i'# = word2Int# (int2Word# i# `and#` 7##)
bitSize _ = 8
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
popCount (W8# x#) = I# (word2Int# (popCnt8# x#))
bit = bitDefault
testBit = testBitDefault
instance FiniteBits Word8 where
finiteBitSize _ = 8
{-# RULES
"fromIntegral/Word8->Word8" fromIntegral = id :: Word8 -> Word8
"fromIntegral/Word8->Integer" fromIntegral = toInteger :: Word8 -> Integer
......@@ -285,12 +290,16 @@ instance Bits Word16 where
(x# `uncheckedShiftRL#` (16# -# i'#))))
where
!i'# = word2Int# (int2Word# i# `and#` 15##)
bitSize _ = 16
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
popCount (W16# x#) = I# (word2Int# (popCnt16# x#))
bit = bitDefault
testBit = testBitDefault
instance FiniteBits Word16 where
finiteBitSize _ = 16
{-# RULES
"fromIntegral/Word8->Word16" fromIntegral = \(W8# x#) -> W16# x#
"fromIntegral/Word16->Word16" fromIntegral = id :: Word16 -> Word16
......@@ -469,12 +478,16 @@ instance Bits Word32 where
(x# `uncheckedShiftRL#` (32# -# i'#))))
where
!i'# = word2Int# (int2Word# i# `and#` 31##)
bitSize _ = 32
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
popCount (W32# x#) = I# (word2Int# (popCnt32# x#))
bit = bitDefault
testBit = testBitDefault
instance FiniteBits Word32 where
finiteBitSize _ = 32
{-# RULES
"fromIntegral/Word8->Word32" fromIntegral = \(W8# x#) -> W32# x#
"fromIntegral/Word16->Word32" fromIntegral = \(W16# x#) -> W32# x#
......@@ -602,7 +615,8 @@ instance Bits Word64 where
(x# `uncheckedShiftRL64#` (64# -# i'#)))
where
!i'# = word2Int# (int2Word# i# `and#` 63##)
bitSize _ = 64
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
popCount (W64# x#) = I# (word2Int# (popCnt64# x#))
bit = bitDefault
......@@ -717,7 +731,8 @@ instance Bits Word64 where
(x# `uncheckedShiftRL#` (64# -# i'#)))
where
!i'# = word2Int# (int2Word# i# `and#` 63##)
bitSize _ = 64
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
popCount (W64# x#) = I# (word2Int# (popCnt64# x#))
bit = bitDefault
......@@ -736,6 +751,9 @@ uncheckedShiftRL64# = uncheckedShiftRL#
#endif
instance FiniteBits Word64 where
finiteBitSize _ = 64
instance Show Word64 where
showsPrec p x = showsPrec p (toInteger x)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment