word24 (empty) → 0.1.0
raw patch · 8 files changed
+939/−0 lines, 8 filesdep +QuickCheckdep +basedep +haskell98setup-changed
Dependencies added: QuickCheck, base, haskell98, test-framework, test-framework-quickcheck2
Files
- LICENSE +72/−0
- README +28/−0
- Setup.lhs +4/−0
- src/Data/Int/Int24.hs +173/−0
- src/Data/Word/Word24.hs +168/−0
- tests/QCUtils.hs +54/−0
- tests/testword24.hs +364/−0
- word24.cabal +76/−0
+ LICENSE view
@@ -0,0 +1,72 @@+The code in the word24 package is modified from the following GHC sources:+libraries/base/GHC/Word.hs.++The full text of the applicable licenses is reproduced below. The+licenses are BSD-style or compatible.++-----------------------------------------------------------------------------++This library (libraries/base) is derived from code from several+sources: ++ * Code from the GHC project which is largely (c) The University of+ Glasgow, and distributable under a BSD-style license (see below),++ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+ and freely redistributable (but see the full license for+ restrictions).++The full text of these licenses is reproduced below. All of the+licenses are BSD-style or compatible.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++ Copyright (c) 2002 Simon Peyton Jones++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------+
+ README view
@@ -0,0 +1,28 @@+This library implements 24-bit word and int types suitable for use in vector+processing.++Storable implementations are provided, however as they use a size and alignment+of 3 bytes care should be taken to ensure they are compatible if used in+conjunction with the FFI.++These types use unboxed data and GHC primitives, and are unlikely to be+compatible with other Haskell compilers.++INSTALLATION INSTRUCTIONS++This library uses the Hackage/Cabal build system. You will need a working+Haskell compiler and appropriate build system. This is most easily met+by installing the Haskell Platform. The following command will install+the library:++cabal install iteratee++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.+
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ src/Data/Int/Int24.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE MagicHash, NoImplicitPrelude #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Int.Int24+-- Copyright : (c) The University of Glasgow 1997-2002+-- License : see src/Data/LICENSE+-- +-- Stability : experimental+-- Portability : non-portable (GHC Extensions)+--+-- The 3 bit integral datatypes, 'Int24'.+--+-----------------------------------------------------------------------------++-- #hide+module Data.Int.Int24 (+ Int24(..),+ narrow24Int#,+ ) where++import Data.Word.Word24++import Data.Bits+import Foreign.Storable++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++------------------------------------------------------------------------+-- 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.++data Int24 = I24# Int# deriving (Eq, Ord)+-- ^ 24-bit signed integer type++-- 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 (x'# `and#` mask#) `eqWord#` mask#+ then word2Int# ( x'# `or#` int2Word# 0xFF800000# )+ else word2Int# ( x'# `and#` (int2Word# 0xFFFFFF#))+ where+ x'# = int2Word# x#+ mask# = int2Word# 0x00800000#++instance Show Int24 where+ showsPrec p x = showsPrec p (fromIntegral x :: Int)++instance Num Int24 where+ (I24# x#) + (I24# y#) = I24# (narrow24Int# (x# +# y#))+ (I24# x#) - (I24# y#) = I24# (narrow24Int# (x# -# y#))+ (I24# x#) * (I24# y#) = I24# (narrow24Int# (x# *# y#))+ negate (I24# x#) = I24# (narrow24Int# (negateInt# x#))+ abs x | x >= 0 = x+ | otherwise = negate x+ signum x | x > 0 = 1+ signum 0 = 0+ signum _ = -1+ fromInteger i = I24# (narrow24Int# (toInt# i))++instance Real Int24 where+ toRational x = toInteger x % 1++instance Enum Int24 where+ succ x+ | x /= maxBound = x + 1+ | otherwise = succError "Int24"+ pred x+ | x /= minBound = x - 1+ | otherwise = predError "Int24"+ toEnum i@(I# i#)+ | i >= fromIntegral (minBound::Int24) && i <= fromIntegral (maxBound::Int24)+ = I24# i#+ | otherwise = toEnumError "Int24" i (minBound::Int24, maxBound::Int24)+ fromEnum (I24# x#) = I# x#+ enumFrom = boundedEnumFrom+ enumFromThen = boundedEnumFromThen++instance Integral Int24 where+ quot x@(I24# x#) y@(I24# y#)+ | y == 0 = divZeroError+ | x == minBound && y == (-1) = overflowError+ | otherwise = I24# (narrow24Int# (x# `quotInt#` y#))+ rem x@(I24# x#) y@(I24# y#)+ | y == 0 = divZeroError+ | x == minBound && y == (-1) = overflowError+ | otherwise = I24# (narrow24Int# (x# `remInt#` y#))+ div x@(I24# x#) y@(I24# y#)+ | y == 0 = divZeroError+ | x == minBound && y == (-1) = overflowError+ | otherwise = I24# (narrow24Int# (x# `divInt#` y#))+ mod x@(I24# x#) y@(I24# y#)+ | y == 0 = divZeroError+ | x == minBound && y == (-1) = overflowError+ | otherwise = I24# (narrow24Int# (x# `modInt#` y#))+ quotRem x@(I24# x#) y@(I24# y#)+ | y == 0 = divZeroError+ | x == minBound && y == (-1) = overflowError+ | otherwise = (I24# (narrow24Int# (x# `quotInt#` y#)),+ I24# (narrow24Int# (x# `remInt#` y#)))+ divMod x@(I24# x#) y@(I24# y#)+ | y == 0 = divZeroError+ | x == minBound && y == (-1) = overflowError+ | otherwise = (I24# (narrow24Int# (x# `divInt#` y#)),+ I24# (narrow24Int# (x# `modInt#` y#)))+ toInteger (I24# x#) = smallInteger x#++instance Bounded Int24 where+ minBound = -0x800000+ maxBound = 0x7FFFFF++instance Ix Int24 where+ range (m,n) = [m..n]+ unsafeIndex (m,_) i = fromIntegral i - fromIntegral m+ inRange (m,n) i = m <= i && i <= n++instance Read Int24 where+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]++instance Bits Int24 where+ {-# INLINE shift #-}++ (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#)))+ (I24# x#) `shift` (I# i#)+ | i# >=# 0# = I24# (narrow24Int# (x# `iShiftL#` i#))+ | otherwise = I24# (x# `iShiftRA#` negateInt# i#)+ (I24# x#) `rotate` i+ | 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+ isSigned _ = True++ {-# INLINE shiftR #-}+ -- same as the default definition, but we want it inlined (#2376)+ x `shiftR` i = x `shift` (-i)++{-# RULES+"fromIntegral/Word8->Int24" fromIntegral = \(W8# x#) -> I24# (word2Int# x#)+"fromIntegral/Word16->Int24" fromIntegral = \(W16# x#) -> I24# (word2Int# x#)+"fromIntegral/Int8->Int24" fromIntegral = \(I8# x#) -> I24# x#+"fromIntegral/Int16->Int24" fromIntegral = \(I16# x#) -> I24# x#+"fromIntegral/Int24->Int24" fromIntegral = id :: Int24 -> Int24+"fromIntegral/a->Int24" fromIntegral = \x -> case fromIntegral x of I# x# -> I24# (narrow24Int# x#)+"fromIntegral/Int24->a" fromIntegral = \(I24# x#) -> fromIntegral (I# x#)+ #-}++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)
+ src/Data/Word/Word24.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE MagicHash #-}+{-# OPTIONS_HADDOCK hide #-}++-- |+-- Module : Data.Word.Word24+-- License : see src/Data/LICENSE+-- Stability : experimental+-- Portability : non-portable (GHC Extensions)++-- Provide a three-byte unsigned integral type: 'Word24', analagous to Word8,+-- Word16, etc.+-- ++-- #hide+module Data.Word.Word24 (+ Word24(..)+ ,narrow24Word#+ )++where++import Data.Bits+import Foreign.Storable++import GHC.Base+import GHC.Enum+import GHC.Num+import GHC.Real+import GHC.Read+import GHC.Arr+import GHC.Show+import GHC.Word+import GHC.Ptr++-- Word24 is represented in the same way as Word. Operations may assume and+-- must ensure that it holds only values in its logical range.++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...++narrow24Word# :: Word# -> Word#+narrow24Word# x# = x# `and#` (int2Word# 0xFFFFFF#)++instance Show Word24 where+ showsPrec p x = showsPrec p (fromIntegral x :: Int)++instance Num Word24 where+ (W24# x#) + (W24# y#) = W24# (narrow24Word# (x# `plusWord#` y#))+ (W24# x#) - (W24# y#) = W24# (narrow24Word# (x# `minusWord#` y#))+ (W24# x#) * (W24# y#) = W24# (narrow24Word# (x# `timesWord#` y#))+ negate (W24# x#) = W24# (narrow24Word# (int2Word# (negateInt# (word2Int# x#))))+ abs x = x+ signum 0 = 0+ signum _ = 1+ fromInteger i = W24# (narrow24Word# (integerToWord i))++instance Real Word24 where+ toRational x = toInteger x % 1++instance Enum Word24 where+ succ x+ | x /= maxBound = x + 1+ | otherwise = succError "Word24"+ pred x+ | x /= minBound = x - 1+ | otherwise = predError "Word24"+ toEnum i@(I# i#)+ | i >= 0 && i <= fromIntegral (maxBound :: Word24)+ = W24# (int2Word# i#)+ | otherwise = toEnumError "Word24" i (minBound::Word24, maxBound::Word24)+ fromEnum (W24# x#) = I# (word2Int# x#)+ enumFrom = boundedEnumFrom+ enumFromThen = boundedEnumFromThen++instance Integral Word24 where+ quot (W24# x#) y@(W24# y#)+ | y /= 0 = W24# (x# `quotWord#` y#)+ | otherwise = divZeroError+ rem (W24# x#) y@(W24# y#)+ | y /= 0 = W24# (x# `remWord#` y#)+ | otherwise = divZeroError+ div (W24# x#) y@(W24# y#)+ | y /= 0 = W24# (x# `quotWord#` y#)+ | otherwise = divZeroError+ mod (W24# x#) y@(W24# y#)+ | y /= 0 = W24# (x# `remWord#` y#)+ | otherwise = divZeroError+ quotRem (W24# x#) y@(W24# y#)+ | y /= 0 = (W24# (x# `quotWord#` y#), W24# (x# `remWord#` y#))+ | otherwise = divZeroError+ divMod (W24# x#) y@(W24# y#)+ | y /= 0 = (W24# (x# `quotWord#` y#), W24# (x# `remWord#` y#))+ | otherwise = divZeroError+ toInteger (W24# x#) = smallInteger (word2Int# x#)++instance Bounded Word24 where+ minBound = 0+ maxBound = 0xFFFFFF++instance Ix Word24 where+ range (m,n) = [m..n]+ unsafeIndex (m,_) i = fromIntegral (i - m)+ inRange (m,n) i = m <= i && i <= n++instance Read Word24 where+ 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#)+ | i# >=# 0# = W24# (narrow24Word# (x# `shiftL#` i#))+ | otherwise = W24# (x# `shiftRL#` negateInt# i#)+ (W24# x#) `rotate` i+ | 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++ {-# INLINE shiftR #-}+ x `shiftR` i = x `shift` (-i)++{-# RULES+"fromIntegral/Word8->Word24" fromIntegral = \(W8# x#) -> W24# x#+"fromIntegral/Word16->Word24" fromIntegral = \(W16# x#) -> W24# x#+"fromIntegral/Word24->Word24" fromIntegral = id :: Word24 -> Word24+"fromIntegral/Word24->Integer" fromIntegral = toInteger :: Word24 -> Integer+"fromIntegral/a->Word24" fromIntegral = \x -> case fromIntegral x of W# x# -> W24# (narrow24Word# x#)+"fromIntegral/Word24->a" fromIntegral = \(W24# x#) -> fromIntegral (W# x#)+ #-}++readWord24OffPtr :: Ptr Word24 -> IO Word24+readWord24OffPtr p = do+ let p' = (castPtr p) :: Ptr Word8+ w1 <- peekElemOff p' 0+ w2 <- peekElemOff p' 1+ w3 <- peekElemOff p' 2+ let w1' = (fromIntegral :: (Word8 -> Word24)) w1+ w2' = (fromIntegral :: (Word8 -> Word24)) w2+ w3' = (fromIntegral :: (Word8 -> Word24)) w3+ w = w1' .|. (w2' `shiftL` 8) .|. (w3' `shiftL` 16)+ return $ fromIntegral w++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+ pokeByteOff p 0 w1+ pokeByteOff p 1 w2+ pokeByteOff p 2 w3++instance Storable Word24 where+ sizeOf _ = 3+ alignment _ = 3+ peek p = readWord24OffPtr p+ poke p v = writeWord24ToPtr p v+
+ tests/QCUtils.hs view
@@ -0,0 +1,54 @@+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++instance Arbitrary Int16 where+ arbitrary = arbitraryBoundedIntegral+ shrink = shrinkIntegral++instance CoArbitrary Int16 where+ coarbitrary = coarbitraryIntegral++instance Arbitrary Word8 where+ arbitrary = arbitraryBoundedIntegral+ shrink = shrinkIntegral++instance CoArbitrary Word8 where+ coarbitrary = coarbitraryIntegral++instance Arbitrary Word16 where+ arbitrary = arbitraryBoundedIntegral+ shrink = shrinkIntegral++instance CoArbitrary Word16 where+ coarbitrary = coarbitraryIntegral++instance Arbitrary Word32 where+ arbitrary = arbitraryBoundedIntegral+ shrink = shrinkIntegral++instance CoArbitrary Word32 where+ coarbitrary = coarbitraryIntegral
+ tests/testword24.hs view
@@ -0,0 +1,364 @@+import Prelude as P++import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Test.QuickCheck hiding ((.&.))++import QCUtils+import Data.Int+import Data.Int.Int24+import Data.Word+import Data.Word.Word24+import Data.Bits+import Foreign.Storable+import GHC.Real++-- ----------------------------------------+-- Word24 Properties++prop_addIdent a = a - a == 0+ where types = a :: Word24++prop_multIdent a = a * 1 == a+ where types = a :: Word24++prop_unsigned a = a >= 0+ where types = a :: Word24++prop_smaller a = (fromIntegral ((fromIntegral a) :: Word24) :: Word16) == a++prop_show a = show a == show (fromIntegral a :: Word24)+ where types = a :: Word16++prop_read a = a == (read . show) a+ where types = a :: Word24++prop_adder a b = (a < ub) && (b < ub) ==>+ fromIntegral (a + b) ==+ ((fromIntegral a + fromIntegral b) :: Word24)+ where types = (a :: Word16, b :: Word16)+ ub :: Word16+ ub = maxBound `div` 2++prop_negate a = a == negate (negate a)+ where types = a :: Word24++prop_abs a = a == abs a+ where types = a :: Word24++prop_signum a = if a == 0 then signum a == a else signum a == 1+ where types = a :: Word24++prop_real a = let r = toRational a in numerator r == fromIntegral a+ where types = a :: Word24++-- Word24 Enum properties+prop_enum1 a = a < maxBound ==> succ a == a + 1+ where types = a :: Word24++prop_enum2 a = a > minBound ==> pred a == a - 1+ where types = a :: Word24++prop_enum3 a = let a' = abs a in+ toEnum a' == fromIntegral a'+ where types = a :: Int++prop_enum4 a = a < maxBound ==> take 2 (enumFrom a) == [a, a+1]+ where types = a :: Word24++prop_enum5 a b = let b' = fromIntegral b in+ enumFromTo a (a + b') ==+ map fromIntegral (enumFromTo (fromIntegral a :: Integer)+ (fromIntegral (a + b') :: Integer))+ where types = (a :: Word24, b :: Word8)++prop_enum6 a b = take 2 (enumFromThen a b) == [a,b]+ where types = (a :: Word24, b :: Word24)++-- Word24 Integral properties+prop_quot a b =+ quot a b == fromIntegral (quot (fromIntegral a :: Word32) (fromIntegral b :: Word32))+ where types = a :: Word24++prop_rem a b = + rem a b == fromIntegral (rem (fromIntegral a :: Word32) (fromIntegral b :: Word32))+ where types = a :: Word24++prop_div a b = + div a b == fromIntegral (div (fromIntegral a :: Word32) (fromIntegral b :: Word32))+ where types = a :: Word24++prop_mod a b = + mod a b == fromIntegral (mod (fromIntegral a :: Word32) (fromIntegral b :: Word32))+ where types = a :: Word24++prop_quotrem a b = let (j, k) = quotRem a b in+ a == (b * j) + k+ where types = (a :: Word24, b :: Word24)++prop_divmod a b =+ divMod a b == (div a b, mod a b)+ where types = (a :: Word24, b :: Word24)++-- binary Word properties+prop_and a b = (a .&. b) == fromIntegral ( (fromIntegral a :: Word24) .&. (fromIntegral b :: Word24))+ where types = (a :: Word16, b :: Word16)++prop_or a b = (a .|. b) == fromIntegral ( (fromIntegral a :: Word24) .|. (fromIntegral b :: Word24))+ where types = (a :: Word16, b :: Word16)++prop_xor a b = (a `xor` b) == fromIntegral ( (fromIntegral a :: Word24) `xor` (fromIntegral b :: Word24))+ where types = (a :: Word16, b :: Word16)++prop_xor_ident a b = (a `xor` b) `xor` b == a+ where types = (a :: Word24, b :: Word24)++prop_shiftL a = a `shiftL` 1 == a * 2+ where types = a :: Word24++prop_shiftR a = a < maxBound `div` 2 ==>+ (a * 2) `shift` (-1) == a+ where types = a :: Word24++prop_shiftR2 a n = a `shiftR` n == a `shift` (negate n)+ where types = a :: Word24++prop_shiftL_ident a = a `shiftL` 0 == a+ where types = a :: Word24++prop_rotate a b = (a `rotate` b) `rotate` (negate b) == a+ where types = (a :: Word24, b :: Int)++prop_comp a = complement (complement a) == a+ where types = a :: Word24++-- Word Storable properties+prop_sizeOf a = sizeOf a == 3+ where types = a :: Word24++prop_align a = alignment a == 3+ where types = a :: Word24++++-- ----------------------------------------+-- Int24 Properties++prop_addIdentI a = a - a == 0+ where types = a :: Int24++prop_multIdentI a = a * 1 == a+ where types = a :: Int24++prop_smallerI a = (fromIntegral ((fromIntegral a) :: Int24) :: Int16) == a++prop_showI a = show a == show (fromIntegral a :: Int24)+ where types = a :: Int16++prop_readI a = a == (read . show) a+ where types = a :: Int24++prop_adderI a b = ((fromIntegral a + fromIntegral b) :: Int) ==+ fromIntegral ((fromIntegral a + fromIntegral b) :: Int24)+ where types = (a :: Int16, b :: Int16)++prop_negateI a = a == negate (negate a)+ where types = a :: Int24++prop_absI a = if a >= 0 then a == abs a else a == negate (abs a)+ where types = a :: Int24++prop_signumI a = signum a == fromIntegral (signum (fromIntegral a :: Int))+ where types = a :: Int24++prop_realI a = let r = toRational a in numerator r == fromIntegral a+ where types = a :: Int24++-- Int24 Enum Properties+prop_enum1I a = a < maxBound ==> succ a == a + 1+ where types = a :: Int24++prop_enum2I a = a > minBound ==> pred a == a - 1+ where types = a :: Int24++prop_enum3I a = let a' = abs a in+ toEnum a' == fromIntegral a'+ where types = a :: Int++prop_enum4I a = a < maxBound ==> take 2 (enumFrom a) == [a, a+1]+ where types = a :: Int24++prop_enum5I a b = let b' = fromIntegral b in+ enumFromTo a (a + b') ==+ map fromIntegral (enumFromTo (fromIntegral a :: Integer)+ (fromIntegral (a + b') :: Integer))+ where types = (a :: Int24, b :: Word8)++prop_enum6I a b = take 2 (enumFromThen a b) == [a,b]+ where types = (a :: Int24, b :: Int24)++-- Int24 Integral properties+prop_quotI a b =+ quot a b == fromIntegral (quot (fromIntegral a :: Int32) (fromIntegral b :: Int32))+ where types = a :: Int24++prop_remI a b = + rem a b == fromIntegral (rem (fromIntegral a :: Int32) (fromIntegral b :: Int32))+ where types = a :: Int24++prop_divI a b = + div a b == fromIntegral (div (fromIntegral a :: Int32) (fromIntegral b :: Int32))+ where types = a :: Int24++prop_modI a b = + mod a b == fromIntegral (mod (fromIntegral a :: Int32) (fromIntegral b :: Int32))+ where types = a :: Int24++prop_quotremI a b = let (j, k) = quotRem a b in+ a == (b * j) + k+ where types = (a :: Int24, b :: Int24)++prop_divmodI a b =+ divMod a b == (div a b, mod a b)+ where types = (a :: Int24, b :: Int24)+++-- binary Int properties+prop_andI a b = (a .&. b) == fromIntegral ( (fromIntegral a :: Int24) .&. (fromIntegral b :: Int24))+ where types = (a :: Int16, b :: Int16)++prop_orI a b = (a .|. b) == fromIntegral ( (fromIntegral a :: Int24) .|. (fromIntegral b :: Int24))+ where types = (a :: Int16, b :: Int16)++prop_xorI a b = (a `xor` b) == fromIntegral ( (fromIntegral a :: Int24) `xor` (fromIntegral b :: Int24))+ where types = (a :: Int16, b :: Int16)++prop_xor_identI a b = (a `xor` b) `xor` b == a+ where types = (a :: Int24, b :: Int24)++prop_shiftLI a = a `shiftL` 1 == a * 2+ where types = a :: Int24++prop_shiftL_identI a = a `shiftL` 0 == a+ where types = a :: Int24++prop_shiftRI a = (a < maxBound `div` 2) && (a > minBound `div` 2) ==>+ (a * 2) `shift` (-1) == a+ where types = a :: Int24++prop_shiftR2I a n = a `shiftR` n == a `shift` (negate n)+ where types = a :: Int24++prop_rotateI a b = (a `rotate` b) `rotate` (negate b) == a+ where types = (a :: Int24, b :: Int)++prop_compI a = complement (complement a) == a+ where types = a :: Int24++-- Int Storable properties+prop_sizeOfI a = sizeOf a == 3+ where types = a :: Int24++prop_alignI a = alignment a == 3+ where types = a :: Int24+++-- ----------------------------------------+-- tests+tests = [+ testGroup "Word24" [+ testProperty "add. identity" prop_addIdent+ ,testProperty "mult. identity" prop_multIdent+ ,testProperty "unsigned" prop_unsigned+ ,testProperty "Word16/Word24 conversion" prop_smaller+ ,testProperty "Show" prop_show+ ,testProperty "Read" prop_read+ ,testProperty "addition" prop_adder+ ,testProperty "negate identity" prop_negate+ ,testProperty "absolute value" prop_abs+ ,testProperty "signum" prop_signum+ ,testProperty "Real identity" prop_real+ ]+ ,testGroup "Word24 Integral instance" [+ testProperty "quot" prop_quot+ ,testProperty "rem" prop_rem+ ,testProperty "div" prop_div+ ,testProperty "mod" prop_mod+ ,testProperty "quotRem" prop_quotrem+ ,testProperty "divmod" prop_divmod+ ]+ ,testGroup "Word24 Enum instance" [+ testProperty "enum succ" prop_enum1+ ,testProperty "enum pred" prop_enum2+ ,testProperty "toEnum" prop_enum3+ ,testProperty "enumFrom " prop_enum4+ ,testProperty "enumFromTo" prop_enum5+ ,testProperty "enumFromThen" prop_enum6+ ]+ ,testGroup "Word24 binary instance" [+ testProperty "binary and" prop_and+ ,testProperty "binary or" prop_or+ ,testProperty "binary xor" prop_xor+ ,testProperty "binary xor identity" prop_xor_ident+ ,testProperty "binary shiftL" prop_shiftL+ ,testProperty "binary shiftL identity" prop_shiftL_ident+ ,testProperty "binary shift right" prop_shiftR+ ,testProperty "binary shiftR" prop_shiftR2+ ,testProperty "binary rotate" prop_rotate+ ,testProperty "binary complement" prop_comp+ ]+ ,testGroup "Word24 Storable instance" [+ testProperty "sizeOf Word24" prop_sizeOf+ ,testProperty "aligntment" prop_align+ ]+ ,testGroup "Int24" [+ testProperty "add. identity" prop_addIdentI+ ,testProperty "mult. identity" prop_multIdentI+ ,testProperty "Int16/Int24 conversion" prop_smallerI+ ,testProperty "Show" prop_showI+ ,testProperty "Read" prop_readI+ ,testProperty "addition" prop_adderI+ ,testProperty "negate identity" prop_negateI+ ,testProperty "absolute value" prop_absI+ ,testProperty "signum" prop_signumI+ ,testProperty "Real identity" prop_realI+ ]+ ,testGroup "Int24 Integral instance" [+ testProperty "quot" prop_quotI+ ,testProperty "rem" prop_remI+ ,testProperty "div" prop_divI+ ,testProperty "mod" prop_modI+ ,testProperty "quotRem" prop_quotremI+ ,testProperty "divmod" prop_divmodI+ ]+ ,testGroup "Int24 Enum instance" [+ testProperty "enum succ" prop_enum1I+ ,testProperty "enum pred" prop_enum2I+ ,testProperty "toEnum" prop_enum3I+ ,testProperty "enumFrom " prop_enum4I+ ,testProperty "enumFromTo" prop_enum5I+ ,testProperty "enumFromThen" prop_enum6I+ ]+ ,testGroup "Int24 binary instance" [+ testProperty "binary and" prop_andI+ ,testProperty "binary or" prop_orI+ ,testProperty "binary xor" prop_xorI+ ,testProperty "binary xor identity" prop_xor_identI+ ,testProperty "binary shiftL" prop_shiftLI+ ,testProperty "binary shiftL identity" prop_shiftL_identI+ ,testProperty "binary shift right" prop_shiftRI+ ,testProperty "binary shiftR" prop_shiftR2I+ ,testProperty "binary rotate" prop_rotateI+ ,testProperty "binary complement" prop_compI+ ]+ ,testGroup "Int24 Storable instance" [+ testProperty "sizeOf Int24" prop_sizeOfI+ ,testProperty "aligntment" prop_alignI+ ]+ ]++-- ----------------------------------------+-- entry point++main = defaultMain tests
+ word24.cabal view
@@ -0,0 +1,76 @@+name: word24+version: 0.1.0+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+license-file: LICENSE+homepage: http://inmachina.net/~jwlato/haskell/word24+tested-with: GHC == 6.10.4, GHC == 6.10.3+stability: experimental++cabal-version: >= 1.6+build-type: Simple++extra-source-files:+ README+ LICENSE++flag splitBase+ description: Use the new split-up base package.++flag buildTests+ description: Build test executables.+ default: False++library+ hs-source-dirs:+ src++ if flag(splitBase)+ build-depends:+ base >= 3 && < 5+ else+ build-depends:+ base < 3++ build-depends:+ haskell98++ exposed-modules:+ Data.Int.Int24+ Data.Word.Word24++ ghc-options: -O2 -Wall+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs++executable testWord24+ hs-source-dirs:+ src+ tests++ main-is: testword24.hs++ other-modules:+ QCUtils++ if flag(buildTests)+ build-depends:+ QuickCheck >= 2 && < 3,+ test-framework >= 0.2 && < 0.3,+ test-framework-quickcheck2 >= 0.2 && < 0.3+ else+ executable: False+ buildable: False++ if flag(splitBase)+ build-depends: base >= 3 && < 5+ else+ build-depends: base < 3++source-repository head+ type: darcs+ location: http://inmachina.net/~jwlato/haskell/word24