112 lines
3.1 KiB
Haskell
112 lines
3.1 KiB
Haskell
|
|
-- unfortunately we need a deprecated thing in here: typeclass Bits has
|
|
-- bitSize both in the minimal set as well as marked as deprecated.
|
|
-- Hence, it fails to compile without bitSize but throws a warning
|
|
-- with it. When every warning is an error it does no compile in any
|
|
-- case, therefore we have deprecated only as warning so that it
|
|
-- compiles at least.
|
|
{-# OPTIONS_GHC -Wwarn=deprecations #-}
|
|
{-# LANGUAGE DerivingStrategies #-}
|
|
|
|
module Data.Word.Word24
|
|
( Word24
|
|
) where
|
|
|
|
import ClassyPrelude hiding (index)
|
|
|
|
import Data.Data (Data)
|
|
import Data.Bits
|
|
import Data.Ix
|
|
|
|
import GHC.Read
|
|
|
|
import Control.DeepSeq()
|
|
|
|
newtype Word24 = Word24 Word32
|
|
deriving (Data, Generic)
|
|
deriving anyclass NFData
|
|
|
|
maxWord24 :: Num a => a
|
|
maxWord24 = 16777215
|
|
|
|
instance Bounded Word24 where
|
|
minBound = 0
|
|
maxBound = maxWord24
|
|
|
|
word24 :: Word32 -> Word24
|
|
word24 = assert (maxWord24 == 2^24-1) (Word24 . (.&. maxWord24))
|
|
|
|
instance Num Word24 where
|
|
(+) (Word24 a) (Word24 b) = word24 (a + b)
|
|
(*) (Word24 a) (Word24 b) = word24 (a * b)
|
|
abs (Word24 a) = word24 (abs a)
|
|
signum (Word24 a) = word24 (signum a)
|
|
fromInteger i = word24 (fromInteger i)
|
|
negate (Word24 a) = word24 (negate a)
|
|
|
|
instance Ix Word24 where
|
|
{- MINIMAL range, (index | unsafeIndex), inRange -}
|
|
-- range :: (a, a) -> [a]
|
|
range (Word24 a, Word24 b) = map word24 $ range (a,b)
|
|
-- index :: (a, a) -> a -> Int
|
|
index (Word24 a, Word24 b) (Word24 c) = index (a,b) c
|
|
-- inRange :: (a, a) -> a -> Bool
|
|
inRange (Word24 a, Word24 b) (Word24 c) = inRange (a,b) c
|
|
|
|
instance Eq Word24 where
|
|
(==) (Word24 a) (Word24 b) = a == b
|
|
|
|
instance Ord Word24 where
|
|
compare (Word24 a) (Word24 b) = compare a b
|
|
|
|
instance Real Word24 where
|
|
toRational (Word24 a) = toRational a
|
|
|
|
instance Enum Word24 where
|
|
toEnum k = word24 (toEnum k)
|
|
fromEnum (Word24 k) = fromEnum k
|
|
|
|
instance Integral Word24 where
|
|
quotRem (Word24 a) (Word24 b) =
|
|
let (u,v) = quotRem a b in
|
|
(word24 u, word24 v)
|
|
toInteger (Word24 w) = toInteger w
|
|
|
|
instance Bits Word24 where
|
|
(.&.) (Word24 a) (Word24 b) = word24 (a .&. b)
|
|
(.|.) (Word24 a) (Word24 b) = word24 (a .|. b)
|
|
xor (Word24 a) (Word24 b) = word24 (xor a b)
|
|
complement (Word24 a) = word24 (complement a)
|
|
shift (Word24 a) i = word24 (shift a i)
|
|
rotate (Word24 a) i = word24 (rotate a i)
|
|
bitSize (Word24 a) = bitSize a -- it is listed as part of the minimal implementation, but it is denoted as deprecated elsewhere
|
|
bitSizeMaybe (Word24 a) = bitSizeMaybe a
|
|
isSigned (Word24 a) = isSigned a
|
|
testBit (Word24 a) i = testBit a i
|
|
bit = word24 . bit
|
|
popCount (Word24 a) = popCount a
|
|
|
|
instance Read Word24 where
|
|
-- readsPrec :: Int -> ReadS Word24
|
|
-- readsPrec :: Int -> String -> [(Word24, String)]
|
|
readsPrec i = map (\(j,t) -> (word24 j, t)) . readsPrec i
|
|
|
|
instance Show Word24 where
|
|
show (Word24 i) = show i
|
|
|
|
--instance Typeable Word24
|
|
--where
|
|
-- typeRep#
|
|
|
|
{-
|
|
{- MINIMAL gunfold, toConstr, dataTypeOf -}
|
|
instance Data Word24 where
|
|
-- Data.Data.gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Data.Data.Constr -> c a
|
|
gunfold
|
|
-- Data.Data.toConstr :: a -> Data.Data.Constr
|
|
toConstr
|
|
-- Data.Data.dataTypeOf :: a -> Data.Data.DataType
|
|
dataTypeOf
|
|
-}
|
|
|