ips/src/IPS/Word24.hs

87 lines
2.0 KiB
Haskell

module IPS.Word24 (Word24) where
import Data.Word
import Data.Maybe
import Data.Bits
newtype Word24 = W24 Word32
deriving newtype (Eq, Ord, Show)
maxW24I :: Int
maxW24I = 0xFFFFFF
maxW24 :: Word32
maxW24 = 0xFFFFFF
mkW24 :: Word32 -> Word24
mkW24 x = W24 $ x .&. maxW24
instance Read Word24 where
readsPrec d str = mapMaybe isW24 $ readsPrec d str where
isW24 (x, r) | x <= maxW24 = Just (W24 x, r)
| otherwise = Nothing
instance Bounded Word24 where
minBound = W24 0
maxBound = W24 maxW24
instance Enum Word24 where
succ (W24 x) | x >= maxW24 = error "succ @Word24: maxBound"
| otherwise = W24 $ succ x
pred (W24 x) | x <= 0 = error "pred @Word24: 0"
| otherwise = W24 $ pred x
toEnum x | x >= 0 && x <= maxW24I = W24 $ fromIntegral x
| otherwise = error "toEnum @Word24: out of range"
fromEnum (W24 x) = fromEnum x
instance Num Word24 where
(+) = clamp2 (+)
(*) = clamp2 (*)
(-) = clamp2 (-)
abs = id
signum (W24 x) = mkW24 $ signum x
fromInteger x = mkW24 $ fromInteger x
instance Real Word24 where
toRational (W24 x) = toRational x
instance Integral Word24 where
W24 x `quotRem` W24 y = let (q, r) = x `quotRem` y in (mkW24 q, mkW24 r)
toInteger (W24 x) = toInteger x
instance Bits Word24 where
(.&.) = clamp2 (.&.)
(.|.) = clamp2 (.|.)
xor = clamp2 xor
complement = clamp1 complement
shift (W24 x) i = mkW24 $ shift x i
rotate x 0 = x
rotate (W24 x) i = mkW24 $ (x `shiftL` i) .|. (x `shiftR` (24 - i))
bitSize = finiteBitSize
bitSizeMaybe = Just . finiteBitSize
isSigned _ = False
testBit = testBitDefault
bit = bitDefault
popCount (W24 x) = popCount x
instance FiniteBits Word24 where
finiteBitSize _ = 24
clamp1 :: (Word32 -> Word32) -> (Word24 -> Word24)
clamp1 f (W24 x) = mkW24 $ f x
clamp2 :: (Word32 -> Word32 -> Word32) -> (Word24 -> Word24 -> Word24)
clamp2 (·) (W24 x) (W24 y) = mkW24 $ x · y