word24-2.0.0: src/Data/Word/Word24.hs
{-# 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
-- Stability : experimental
-- Portability : non-portable (GHC Extensions)
-- Provide a 24-bit unsigned integral type: 'Word24', analagous to Word8,
-- Word16, etc.
--
module Data.Word.Word24 (
-- * Word24 type
Word24(..)
, byteSwap24
, byteSwap24#
-- * Internal helpers
, narrow24Word#
#if MIN_VERSION_base(4,8,0)
, clz24#
, ctz24#
#endif
, popCnt24#
)
where
import Data.Bits
import Data.Data
import Data.Maybe
import Foreign.Storable
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)
#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# = 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)
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 #-}
{-# INLINE bit #-}
{-# INLINE testBit #-}
(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
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#
"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#)
#-}
{-# 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
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 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 = readWord24OffPtr
poke = writeWord24ToPtr