diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,5 @@ -[![Build Status](https://secure.travis-ci.org/JohnLato/word24.png?branch=master)](http://travis-ci.org/JohnLato/word24) +[![Build Status](https://secure.travis-ci.org/winterland1989/word24.png?branch=master)](http://travis-ci.org/winterland1989/word24) +[![Hackage](https://img.shields.io/hackage/v/word24.svg?style=flat)](http://hackage.haskell.org/package/word24) This library implements 24-bit word and int types suitable for use in vector processing. @@ -17,14 +18,8 @@ by installing the Haskell Platform. The following command will install the library: -cabal install iteratee +cabal install word24 This library is pure Haskell, and should install on any system with a suitable Haskell compiler with no extra steps required. In particular, POSIX-compatible, Mac OSX, and Windows should all be supported. - -INSTALLATION OPTIONS: - -This library supports the following cabal flags: - splitBase (default enabled): use the split-up base package. - diff --git a/bench/Benchmark.hs b/bench/Benchmark.hs --- a/bench/Benchmark.hs +++ b/bench/Benchmark.hs @@ -4,14 +4,15 @@ import Control.DeepSeq import Data.Int.Int24 import Data.Word.Word24 +import Data.Int import Data.Word import Data.List main = defaultMain [ bgroup "Int24" intses , bgroup "Word24" wordses - , bgroup "Int" baseses - , bgroup "Word64" basessW + , bgroup "Int16" baseses + , bgroup "Word16" basessW ] benches :: (Enum i, Num i, NFData i, Integral i) => i -> [Benchmark] @@ -27,8 +28,5 @@ intses = benches (1 :: Int24) wordses = benches (1 :: Word24) -baseses = benches (1 :: Int) -basessW = benches (1 :: Word64) - -instance NFData Int24 -instance NFData Word24 +baseses = benches (1 :: Int16) +basessW = benches (1 :: Word16) diff --git a/src/Data/Int/Int24.hs b/src/Data/Int/Int24.hs --- a/src/Data/Int/Int24.hs +++ b/src/Data/Int/Int24.hs @@ -1,11 +1,19 @@ -{-# LANGUAGE MagicHash, NoImplicitPrelude, BangPatterns, CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +#if !MIN_VERSION_base(4,8,0) +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE StandaloneDeriving #-} +#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.Int.Int24 -- Copyright : (c) The University of Glasgow 1997-2002 -- License : see src/Data/LICENSE --- +-- -- Stability : experimental -- Portability : non-portable (GHC Extensions) -- @@ -13,52 +21,68 @@ -- ----------------------------------------------------------------------------- --- #hide module Data.Int.Int24 ( - Int24(..), - narrow24Int#, - ) where + -- * Int24 type + Int24(..) + -- * Internal helper + , narrow24Int# + ) where -import Data.Word.Word24 +import Data.Bits +import Data.Data +import Data.Maybe +import Data.Word.Word24 +import Foreign.Storable -import Data.Bits -import Foreign.Storable +import GHC.Arr +import GHC.Base +import GHC.Enum +import GHC.Int +import GHC.Num +import GHC.Ptr +import GHC.Read +import GHC.Real +import GHC.Show +import GHC.Word -import GHC.Base -import GHC.Enum -import GHC.Num -import GHC.Real -import GHC.Read -import GHC.Arr -import GHC.Word -import GHC.Int -import GHC.Show -import GHC.Ptr -import GHC.Err +import Control.DeepSeq -#if __GLASGOW_HASKELL__ >= 702 -#define TOINT integerToInt -#else -#define TOINT toInt# +#if !MIN_VERSION_base(4,8,0) +import Data.Typeable #endif ------------------------------------------------------------------------ --- type Int24 ------------------------------------------------------------------------- -- Int24 is represented in the same way as Int. Operations may assume -- and must ensure that it holds only values from its logical range. +-- | 24-bit signed integer type data Int24 = I24# Int# deriving (Eq, Ord) --- ^ 24-bit signed integer type +#if !MIN_VERSION_base(4,8,0) +deriving instance Typeable Int24 +#endif + +instance NFData Int24 where rnf !_ = () + +int24Type :: DataType +int24Type = mkIntType "Data.Word.Int24.Int24" + +instance Data Int24 where + toConstr x = mkIntegralConstr int24Type x + gunfold _ z c = case constrRep c of + (IntConstr x) -> z (fromIntegral x) + _ -> error $ "Data.Data.gunfold: Constructor " ++ show c + ++ " is not of type Int24." + dataTypeOf _ = int24Type + -- the narrowings are primops in GHC; I don't have that luxury. -- if the 24th bit (from right) is on, the value is negative, so -- fill the uppermost bits with 1s. Otherwise clear them to 0s. narrow24Int# :: Int# -> Int# -narrow24Int# x# = if primBool ((x'# `and#` mask#) `eqWord#` mask#) - then word2Int# ( x'# `or#` int2Word# m1# ) - else word2Int# ( x'# `and#` (int2Word# m2#)) +narrow24Int# x# = if isTrue# ((x'# `and#` mask#) `eqWord#` mask#) + then word2Int# (x'# `or#` int2Word# m1#) + else word2Int# (x'# `and#` int2Word# m2#) where !x'# = int2Word# x# !mask# = int2Word# 0x00800000# @@ -78,7 +102,7 @@ signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger i = I24# (narrow24Int# (TOINT i)) + fromInteger i = I24# (narrow24Int# (integerToInt i)) instance Real Int24 where toRational x = toInteger x % 1 @@ -141,33 +165,40 @@ instance Bits Int24 where {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} (I24# x#) .&. (I24# y#) = I24# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I24# x#) .|. (I24# y#) = I24# (word2Int# (int2Word# x# `or#` int2Word# y#)) (I24# x#) `xor` (I24# y#) = I24# (word2Int# (int2Word# x# `xor#` int2Word# y#)) - complement (I24# x#) = I24# (word2Int# (int2Word# x# `xor#` int2Word# (-1#))) + complement (I24# x#) = I24# (word2Int# (not# (int2Word# x#))) (I24# x#) `shift` (I# i#) - | primBool (i# >=# 0# ) = I24# (narrow24Int# (x# `iShiftL#` i#)) - | otherwise = I24# (x# `iShiftRA#` negateInt# i#) + | isTrue# (i# >=# 0#) = I24# (narrow24Int# (x# `iShiftL#` i#)) + | otherwise = I24# (x# `iShiftRA#` negateInt# i#) + (I24# x#) `shiftL` (I# i#) = I24# (narrow24Int# (x# `iShiftL#` i#)) + (I24# x#) `unsafeShiftL` (I# i#) = I24# (narrow24Int# (x# `uncheckedIShiftL#` i#)) + (I24# x#) `shiftR` (I# i#) = I24# (x# `iShiftRA#` i#) + (I24# x#) `unsafeShiftR` (I# i#) = I24# (x# `uncheckedIShiftRA#` i#) (I24# x#) `rotate` i - | primBool (i'# ==# 0# ) = I24# x# - | otherwise - = I24# (narrow24Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` + | isTrue# (i'# ==# 0#) = I24# x# + | otherwise = I24# (narrow24Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (24# -# i'#))))) - where - !x'# = narrow24Word# (int2Word# x#) - !(I# i0#) = i `mod` 24 - !i'# = word2Int# (narrow24Word# (int2Word# i0#)) - bitSize _ = 24 + where + !x'# = narrow24Word# (int2Word# x#) + !(I# i'#) = i `mod` 24 + bitSizeMaybe i = Just (finiteBitSize i) + bitSize = finiteBitSize isSigned _ = True + popCount (I24# x#) = I# (word2Int# (popCnt24# (int2Word# x#))) + bit = bitDefault + testBit = testBitDefault - {-# INLINE shiftR #-} - -- same as the default definition, but we want it inlined (#2376) - x `shiftR` i = x `shift` (-i) - bit n = case bit n of - I32# x -> I24# (narrow24Int# x) - testBit x i = (x .&. bit i) /= 0 - popCount (I24# x#) = popCount (W# (narrow24Word# (int2Word# x#))) +instance FiniteBits Int24 where + finiteBitSize _ = 24 +#if MIN_VERSION_base(4,8,0) + countLeadingZeros (I24# x#) = I# (word2Int# (clz24# (int2Word# x#))) + countTrailingZeros (I24# x#) = I# (word2Int# (ctz24# (int2Word# x#))) +#endif {-# RULES "fromIntegral/Word8->Int24" fromIntegral = \(W8# x#) -> I24# (word2Int# x#) @@ -179,17 +210,38 @@ "fromIntegral/Int24->a" fromIntegral = \(I24# x#) -> fromIntegral (I# x#) #-} +{-# RULES +"properFraction/Float->(Int24,Float)" + properFraction = \x -> + case properFraction x of { + (n, y) -> ((fromIntegral :: Int -> Int24) n, y :: Float) } +"truncate/Float->Int24" + truncate = (fromIntegral :: Int -> Int24) . (truncate :: Float -> Int) +"floor/Float->Int24" + floor = (fromIntegral :: Int -> Int24) . (floor :: Float -> Int) +"ceiling/Float->Int24" + ceiling = (fromIntegral :: Int -> Int24) . (ceiling :: Float -> Int) +"round/Float->Int24" + round = (fromIntegral :: Int -> Int24) . (round :: Float -> Int) + #-} + +{-# RULES +"properFraction/Double->(Int24,Double)" + properFraction = \x -> + case properFraction x of { + (n, y) -> ((fromIntegral :: Int -> Int24) n, y :: Double) } +"truncate/Double->Int24" + truncate = (fromIntegral :: Int -> Int24) . (truncate :: Double -> Int) +"floor/Double->Int24" + floor = (fromIntegral :: Int -> Int24) . (floor :: Double -> Int) +"ceiling/Double->Int24" + ceiling = (fromIntegral :: Int -> Int24) . (ceiling :: Double -> Int) +"round/Double->Int24" + round = (fromIntegral :: Int -> Int24) . (round :: Double -> Int) + #-} + instance Storable Int24 where sizeOf _ = 3 alignment _ = 3 peek p = fmap fromIntegral $ peek ((castPtr p) :: Ptr Word24) poke p v = poke (castPtr p :: Ptr Word24) (fromIntegral v) - -#if MIN_VERSION_base(4,7,0) -primBool :: Int# -> Bool -primBool x = tagToEnum# x -#else -primBool :: Bool -> Bool -primBool = id -#endif - diff --git a/src/Data/Word/Word24.hs b/src/Data/Word/Word24.hs --- a/src/Data/Word/Word24.hs +++ b/src/Data/Word/Word24.hs @@ -1,6 +1,13 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash, BangPatterns #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +#if !MIN_VERSION_base(4,8,0) +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE StandaloneDeriving #-} +#endif + -- | -- Module : Data.Word.Word24 -- License : see src/Data/LICENSE @@ -9,40 +16,92 @@ -- Provide a 24-bit unsigned integral type: 'Word24', analagous to Word8, -- Word16, etc. --- +-- --- #hide module Data.Word.Word24 ( - Word24(..) - ,narrow24Word# + -- * Word24 type + Word24(..) + , byteSwap24 + , byteSwap24# + -- * Internal helpers + , narrow24Word# +#if MIN_VERSION_base(4,8,0) + , clz24# + , ctz24# +#endif + , popCnt24# ) where -import Data.Bits -import Foreign.Storable +import Data.Bits +import Data.Data +import Data.Maybe +import Foreign.Storable -import GHC.Base -import GHC.Enum -import GHC.Num -import GHC.Real -import GHC.Arr -import GHC.Word -import GHC.Ptr -import GHC.Err +import GHC.Arr +import GHC.Base +import GHC.Enum +import GHC.Num +import GHC.Ptr +import GHC.Read +import GHC.Real +import GHC.Show +import GHC.Word +import Control.DeepSeq + +#if !MIN_VERSION_base(4,8,0) +import Data.Typeable +#endif + +------------------------------------------------------------------------ + -- Word24 is represented in the same way as Word. Operations may assume and -- must ensure that it holds only values in its logical range. +-- | 24-bit unsigned integer type +-- data Word24 = W24# Word# deriving (Eq, Ord) --- ^ 24-bit unsigned integer type --- the narrowings are represented as primops in GHC. I don't have that --- luxury... +#if !MIN_VERSION_base(4,8,0) +deriving instance Typeable Word24 +#endif +instance NFData Word24 where rnf !_ = () + +word24Type :: DataType +word24Type = mkIntType "Data.Word.Word24.Word24" + +instance Data Word24 where + toConstr x = mkIntegralConstr word24Type x + gunfold _ z c = case constrRep c of + (IntConstr x) -> z (fromIntegral x) + _ -> error $ "Data.Data.gunfold: Constructor " ++ show c + ++ " is not of type Word24." + dataTypeOf _ = word24Type + +-- | narrowings represented as primop 'and#' in GHC. narrow24Word# :: Word# -> Word# -narrow24Word# x# = x# `and#` (int2Word# 0xFFFFFF#) +narrow24Word# = and# 0xFFFFFF## +#if MIN_VERSION_base(4,8,0) +-- | count leading zeros +-- +clz24# :: Word# -> Word# +clz24# w# = clz32# (narrow24Word# w#) `minusWord#` 8## + +-- | count trailing zeros +-- +ctz24# :: Word# -> Word# +ctz24# w# = ctz# w# +#endif + +-- | the number of set bits +-- +popCnt24# :: Word# -> Word# +popCnt24# w# = popCnt# (narrow24Word# w#) + instance Show Word24 where showsPrec p x = showsPrec p (fromIntegral x :: Int) @@ -108,39 +167,53 @@ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Word24 where - {-# INLINE shift #-} - - (W24# x#) .&. (W24# y#) = W24# (x# `and#` y#) - (W24# x#) .|. (W24# y#) = W24# (x# `or#` y#) - (W24# x#) `xor` (W24# y#) = W24# (x# `xor#` y#) - complement (W24# x#) = W24# (x# `xor#` mb#) where !(W24# mb#) = maxBound - (W24# x#) `shift` (I# i#) - | primBool (i# >=# 0#) = W24# (narrow24Word# (x# `shiftL#` i#)) - | otherwise = W24# (x# `shiftRL#` negateInt# i#) - (W24# x#) `rotate` i - | primBool (i'# ==# 0#) = W24# x# - | otherwise = W24# (narrow24Word# ((x# `uncheckedShiftL#` i'#) `or#` - (x# `uncheckedShiftRL#` (24# -# i'#)))) - where - !(I# i'#) = i `mod` 24 - bitSize _ = 24 - isSigned _ = False - bit n = case bit n of - W32# x -> W24# (narrow24Word# x) - testBit (W24# x) n = testBit (W32# x) n - popCount (W24# x) = popCount (W32# x) + {-# INLINE shift #-} + {-# INLINE bit #-} + {-# INLINE testBit #-} - {-# INLINE shiftR #-} - x `shiftR` i = x `shift` (-i) + (W24# x#) .&. (W24# y#) = W24# (x# `and#` y#) + (W24# x#) .|. (W24# y#) = W24# (x# `or#` y#) + (W24# x#) `xor` (W24# y#) = W24# (x# `xor#` y#) + complement (W24# x#) = W24# (x# `xor#` mb#) where !(W24# mb#) = maxBound + (W24# x#) `shift` (I# i#) + | isTrue# (i# >=# 0#) = W24# (narrow24Word# (x# `shiftL#` i#)) + | otherwise = W24# (x# `shiftRL#` negateInt# i#) + (W24# x#) `shiftL` (I# i#) = W24# (narrow24Word# (x# `shiftL#` i#)) + (W24# x#) `unsafeShiftL` (I# i#) = + W24# (narrow24Word# (x# `uncheckedShiftL#` i#)) + (W24# x#) `shiftR` (I# i#) = W24# (x# `shiftRL#` i#) + (W24# x#) `unsafeShiftR` (I# i#) = W24# (x# `uncheckedShiftRL#` i#) + (W24# x#) `rotate` i + | isTrue# (i'# ==# 0#) = W24# x# + | otherwise = W24# (narrow24Word# ((x# `uncheckedShiftL#` i'#) `or#` + (x# `uncheckedShiftRL#` (24# -# i'#)))) + where + !(I# i'#) = i `mod` 24 + bitSizeMaybe i = Just (finiteBitSize i) + bitSize = finiteBitSize + isSigned _ = False + popCount (W24# x#) = I# (word2Int# (popCnt24# x#)) + bit = bitDefault + testBit = testBitDefault -#if MIN_VERSION_base(4,7,0) -primBool :: Int# -> Bool -primBool x = tagToEnum# x -#else -primBool :: Bool -> Bool -primBool = id +instance FiniteBits Word24 where + finiteBitSize _ = 24 +#if MIN_VERSION_base(4,8,0) + countLeadingZeros (W24# x#) = I# (word2Int# (clz24# x#)) + countTrailingZeros (W24# x#) = I# (word2Int# (ctz24# x#)) #endif +-- | Swap bytes in 'Word24'. +-- +byteSwap24 :: Word24 -> Word24 +byteSwap24 (W24# w#) = W24# (byteSwap24# w#) + +byteSwap24# :: Word# -> Word# +byteSwap24# w# = let byte0 = uncheckedShiftL# (and# w# 0x0000ff##) 16# + byte1 = and# w# 0x00ff00## + byte2 = uncheckedShiftRL# (and# w# 0xff0000##) 16# + in byte0 `or#` byte1 `or#` byte2 + {-# RULES "fromIntegral/Word8->Word24" fromIntegral = \(W8# x#) -> W24# x# "fromIntegral/Word16->Word24" fromIntegral = \(W16# x#) -> W24# x# @@ -150,9 +223,39 @@ "fromIntegral/Word24->a" fromIntegral = \(W24# x#) -> fromIntegral (W# x#) #-} +{-# RULES +"properFraction/Float->(Word24,Float)" + properFraction = \x -> + case properFraction x of { + (n, y) -> ((fromIntegral :: Int -> Word24) n, y :: Float) } +"truncate/Float->Word24" + truncate = (fromIntegral :: Int -> Word24) . (truncate :: Float -> Int) +"floor/Float->Word24" + floor = (fromIntegral :: Int -> Word24) . (floor :: Float -> Int) +"ceiling/Float->Word24" + ceiling = (fromIntegral :: Int -> Word24) . (ceiling :: Float -> Int) +"round/Float->Word24" + round = (fromIntegral :: Int -> Word24) . (round :: Float -> Int) + #-} + +{-# RULES +"properFraction/Double->(Word24,Double)" + properFraction = \x -> + case properFraction x of { + (n, y) -> ((fromIntegral :: Int -> Word24) n, y :: Double) } +"truncate/Double->Word24" + truncate = (fromIntegral :: Int -> Word24) . (truncate :: Double -> Int) +"floor/Double->Word24" + floor = (fromIntegral :: Int -> Word24) . (floor :: Double -> Int) +"ceiling/Double->Word24" + ceiling = (fromIntegral :: Int -> Word24) . (ceiling :: Double -> Int) +"round/Double->Word24" + round = (fromIntegral :: Int -> Word24) . (round :: Double -> Int) + #-} + readWord24OffPtr :: Ptr Word24 -> IO Word24 readWord24OffPtr p = do - let p' = (castPtr p) :: Ptr Word8 + let p' = castPtr p :: Ptr Word8 w1 <- peekElemOff p' 0 w2 <- peekElemOff p' 1 w3 <- peekElemOff p' 2 @@ -165,8 +268,8 @@ writeWord24ToPtr :: Ptr Word24 -> Word24 -> IO () writeWord24ToPtr p v = do let w1 = fromIntegral (v .&. 0x0000FF) :: Word8 - w2 = (fromIntegral ((v .&. 0x00FF00) `shiftR` 8)) :: Word8 - w3 = (fromIntegral ((v .&. 0xFF0000) `shiftR` 16)) :: Word8 + w2 = fromIntegral ((v .&. 0x00FF00) `shiftR` 8) :: Word8 + w3 = fromIntegral ((v .&. 0xFF0000) `shiftR` 16) :: Word8 pokeByteOff p 0 w1 pokeByteOff p 1 w2 pokeByteOff p 2 w3 @@ -174,6 +277,6 @@ instance Storable Word24 where sizeOf _ = 3 alignment _ = 3 - peek p = readWord24OffPtr p - poke p v = writeWord24ToPtr p v + peek = readWord24OffPtr + poke = writeWord24ToPtr diff --git a/tests/QCUtils.hs b/tests/QCUtils.hs new file mode 100644 --- /dev/null +++ b/tests/QCUtils.hs @@ -0,0 +1,26 @@ +module QCUtils where + +import Test.QuickCheck +import Test.QuickCheck.Arbitrary +import Test.QuickCheck.Gen + +import Data.Int +import Data.Int.Int24 +import Data.Word +import Data.Word.Word24 + +-- Arbitrary/CoArbitrary instances for Int24 and Word24 + +instance Arbitrary Int24 where + arbitrary = arbitraryBoundedIntegral + shrink = shrinkIntegral + +instance CoArbitrary Int24 where + coarbitrary = coarbitraryIntegral + +instance Arbitrary Word24 where + arbitrary = arbitraryBoundedIntegral + shrink = shrinkIntegral + +instance CoArbitrary Word24 where + coarbitrary = coarbitraryIntegral diff --git a/tests/testword24.hs b/tests/testword24.hs --- a/tests/testword24.hs +++ b/tests/testword24.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + import Prelude as P import Test.Framework (defaultMain, testGroup) @@ -81,15 +83,15 @@ quot a b == fromIntegral (quot (fromIntegral a :: Word32) (fromIntegral b :: Word32)) where types = a :: Word24 -prop_rem a b = +prop_rem a b = rem a b == fromIntegral (rem (fromIntegral a :: Word32) (fromIntegral b :: Word32)) where types = a :: Word24 -prop_div a b = +prop_div a b = div a b == fromIntegral (div (fromIntegral a :: Word32) (fromIntegral b :: Word32)) where types = a :: Word24 -prop_mod a b = +prop_mod a b = mod a b == fromIntegral (mod (fromIntegral a :: Word32) (fromIntegral b :: Word32)) where types = a :: Word24 @@ -121,7 +123,7 @@ (a * 2) `shift` (-1) == a where types = a :: Word24 -prop_shiftR2 a n = a `shiftR` n == a `shift` (negate n) +prop_shiftR2 a n = n >= 0 ==> a `shiftR` n == a `shift` (negate n) where types = a :: Word24 prop_shiftL_ident a = a `shiftL` 0 == a @@ -133,6 +135,32 @@ prop_comp a = complement (complement a) == a where types = a :: Word24 +prop_byteSwap a = byteSwap24 (byteSwap24 a) == a + where types = a :: Word24 + +#if MIN_VERSION_base(4,8,0) +prop_clz a = countLeadingZeros a == countLeadingZeros' a + where + countLeadingZeros' :: Word24 -> Int + countLeadingZeros' x = (w-1) - go (w-1) + where + go i | i < 0 = i -- no bit set + | testBit x i = i + | otherwise = go (i-1) + + w = finiteBitSize x + +prop_ctz a = countTrailingZeros a == countTrailingZeros' a + where + countTrailingZeros' :: Word24 -> Int + countTrailingZeros' x = go 0 + where + go i | i >= w = i + | testBit x i = i + | otherwise = go (i+1) + w = finiteBitSize x +#endif + prop_bit_ident q (NonNegative j) = testBit (bit j `asTypeOf` q) j == (j < 24) prop_popCount s t a = if a >= 0 @@ -210,15 +238,15 @@ quot a b == fromIntegral (quot (fromIntegral a :: Int32) (fromIntegral b :: Int32)) where types = a :: Int24 -prop_remI a b = +prop_remI a b = rem a b == fromIntegral (rem (fromIntegral a :: Int32) (fromIntegral b :: Int32)) where types = a :: Int24 -prop_divI a b = +prop_divI a b = div a b == fromIntegral (div (fromIntegral a :: Int32) (fromIntegral b :: Int32)) where types = a :: Int24 -prop_modI a b = +prop_modI a b = mod a b == fromIntegral (mod (fromIntegral a :: Int32) (fromIntegral b :: Int32)) where types = a :: Int24 @@ -254,7 +282,7 @@ (a * 2) `shift` (-1) == a where types = a :: Int24 -prop_shiftR2I a n = a `shiftR` n == a `shift` (negate n) +prop_shiftR2I a n = n >= 0 ==> a `shiftR` n == a `shift` (negate n) where types = a :: Int24 prop_rotateI a b = (a `rotate` b) `rotate` (negate b) == a @@ -263,6 +291,29 @@ prop_compI a = complement (complement a) == a where types = a :: Int24 +#if MIN_VERSION_base(4,8,0) +prop_clzI a = countLeadingZeros a == countLeadingZeros' a + where + countLeadingZeros' :: Int24 -> Int + countLeadingZeros' x = (w-1) - go (w-1) + where + go i | i < 0 = i -- no bit set + | testBit x i = i + | otherwise = go (i-1) + + w = finiteBitSize x + +prop_ctzI a = countTrailingZeros a == countTrailingZeros' a + where + countTrailingZeros' :: Int24 -> Int + countTrailingZeros' x = go 0 + where + go i | i >= w = i + | testBit x i = i + | otherwise = go (i+1) + w = finiteBitSize x +#endif + -- Int Storable properties prop_sizeOfI a = sizeOf a == 3 where types = a :: Int24 @@ -315,6 +366,11 @@ ,testProperty "binary shiftR" prop_shiftR2 ,testProperty "binary rotate" prop_rotate ,testProperty "binary complement" prop_comp + ,testProperty "binary byteSwap24" prop_byteSwap +#if MIN_VERSION_base(4,8,0) + ,testProperty "binary countLeadingZeros" prop_clz + ,testProperty "binary countTrailingZeros" prop_ctz +#endif ,testProperty "bit/testBit" (prop_bit_ident (0::Word24)) ,testProperty "popCount" (prop_popCount (0::Word24) (0::Word)) ] @@ -363,6 +419,10 @@ ,testProperty "binary shiftR" prop_shiftR2I ,testProperty "binary rotate" prop_rotateI ,testProperty "binary complement" prop_compI +#if MIN_VERSION_base(4,8,0) + ,testProperty "binary countLeadingZeros" prop_clzI + ,testProperty "binary countTrailingZeros" prop_ctzI +#endif ,testProperty "bit/testBit" (prop_bit_ident (0::Int24)) ,testProperty "popCount" (prop_popCount (0::Int24) (0::Int)) ] diff --git a/word24.cabal b/word24.cabal --- a/word24.cabal +++ b/word24.cabal @@ -1,15 +1,14 @@ -name: word24 -version: 1.0.7 +name: word24 +version: 2.0.1 synopsis: 24-bit word and int types for GHC description: 24-bit Word and Int data types. category: Data -author: John W. Lato, jwlato@gmail.com -maintainer: John W. Lato, jwlato@gmail.com -license: BSD3 +author: Winterland, John W. Lato +maintainer: Winterland, John W. Lato +license: BSD3 license-file: LICENSE -homepage: http://www.tiresiaspress.us/haskell/word24 -tested-with: GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.2 -stability: stable +homepage: https://github.com/winterland1989/word24 +stability: stable cabal-version: >= 1.10 build-type: Simple @@ -22,26 +21,24 @@ default-language: Haskell2010 hs-source-dirs: src - build-depends: - base >= 3 && < 5 + build-depends: base >= 4.7 && < 5, deepseq >= 1.2 && < 2 exposed-modules: Data.Int.Int24 Data.Word.Word24 ghc-options: -Wall - if impl(ghc >= 6.8) - ghc-options: -fwarn-tabs Test-Suite test default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: testword24.hs + other-modules: QCUtils hs-source-dirs: tests src - ghc-options: -fhpc -hpcdir dist/hpc/mix/word24-1.0.6 build-depends: base, + deepseq, word24, QuickCheck >= 2 && < 3, test-framework >= 0.2 && < 0.9, @@ -56,10 +53,10 @@ build-depends: base, word24, - criterion >= 0.6 && < 0.9, + criterion >= 1.1, deepseq >= 1.2 && < 2 ghc-options: -O2 source-repository head type: git - location: git@github.com:JohnLato/word24.git + location: git@github.com:winterland1989/word24.git