{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}
module RON.Util.Word
(
Word2
, b00, b01, b10, b11
, pattern B00, pattern B01, pattern B10, pattern B11
, leastSignificant2
, Word4
, b0000, b0001, b0010, b0011, b0100, b0101, b0110, b0111
, b1000, b1001, b1010, b1011, b1100, b1101, b1110, b1111
, pattern B0000
, leastSignificant4
, Word6 (..)
, leastSignificant6
, ls6
, Word8
, Word12
, leastSignificant12
, ls12
, Word16
, Word24
, leastSignificant24
, ls24
, Word32
, Word60
, leastSignificant60
, ls60
, toWord60
, word60add
, Word64
, SafeCast (..)
) where
import Data.Bits ((.&.))
import Data.Fixed (Fixed, HasResolution)
import Data.Hashable (hashUsing, hashWithSalt)
newtype Word2 = W2 Word8
deriving (Eq, Ord, Show)
b00, b01, b10, b11 :: Word2
b00 = W2 0b00
b01 = W2 0b01
b10 = W2 0b10
b11 = W2 0b11
pattern B00 :: Word2
pattern B00 = W2 0b00
pattern B01 :: Word2
pattern B01 = W2 0b01
pattern B10 :: Word2
pattern B10 = W2 0b10
pattern B11 :: Word2
pattern B11 = W2 0b11
{-# COMPLETE B00, B01, B10, B11 #-}
leastSignificant2 :: Integral integral => integral -> Word2
leastSignificant2 = W2 . (0b11 .&.) . fromIntegral
newtype Word4 = W4 Word8
deriving (Eq, Ord, Show)
b0000, b0001, b0010, b0011, b0100, b0101, b0110, b0111 :: Word4
b1000, b1001, b1010, b1011, b1100, b1101, b1110, b1111 :: Word4
b0000 = W4 0b0000
b0001 = W4 0b0001
b0010 = W4 0b0010
b0011 = W4 0b0011
b0100 = W4 0b0100
b0101 = W4 0b0101
b0110 = W4 0b0110
b0111 = W4 0b0111
b1000 = W4 0b1000
b1001 = W4 0b1001
b1010 = W4 0b1010
b1011 = W4 0b1011
b1100 = W4 0b1100
b1101 = W4 0b1101
b1110 = W4 0b1110
b1111 = W4 0b1111
pattern B0000 :: Word4
pattern B0000 = W4 0b0000
leastSignificant4 :: Integral integral => integral -> Word4
leastSignificant4 = W4 . (0xF .&.) . fromIntegral
newtype Word6 = W6 Word8
deriving (Eq, Ord, Show)
leastSignificant6 :: Integral integral => integral -> Word6
leastSignificant6 = W6 . (0x3F .&.) . fromIntegral
ls6 :: Word8 -> Word6
ls6 = W6 . (0x3F .&.)
newtype Word12 = W12 Word16
deriving (Eq, Ord, Show)
leastSignificant12 :: Integral integral => integral -> Word12
leastSignificant12 = W12 . (0xFFF .&.) . fromIntegral
ls12 :: Word16 -> Word12
ls12 = W12 . (0xFFF .&.)
newtype Word24 = W24 Word32
deriving (Eq, Ord, Show)
leastSignificant24 :: Integral integral => integral -> Word24
leastSignificant24 = W24 . (0xFFFFFF .&.) . fromIntegral
ls24 :: Word32 -> Word24
ls24 = W24 . (0xFFF .&.)
newtype Word60 = W60 Word64
deriving (Enum, Eq, Ord, Show)
instance Bounded Word60 where
minBound = W60 0
maxBound = W60 0xFFFFFFFFFFFFFFF
instance Hashable Word60 where
hashWithSalt = hashUsing @Word64 coerce
leastSignificant60 :: Integral integral => integral -> Word60
leastSignificant60 = W60 . (0xFFFFFFFFFFFFFFF .&.) . fromIntegral
ls60 :: Word64 -> Word60
ls60 = W60 . (0xFFFFFFFFFFFFFFF .&.)
toWord60 :: Word64 -> Maybe Word60
toWord60 w
| w < 0x1000000000000000 = Just $ W60 w
| otherwise = Nothing
word60add :: Word60 -> Word60 -> Word60
word60add (W60 a) (W60 b) = leastSignificant60 $ a + b
class SafeCast v w where
safeCast :: v -> w
instance SafeCast Word2 Int where safeCast = fromIntegral @Word8 . coerce
instance SafeCast Word2 Word4 where safeCast = coerce
instance SafeCast Word2 Word8 where safeCast = coerce
instance SafeCast Word2 Word64 where safeCast = fromIntegral @Word8 . coerce
instance SafeCast Word4 Int where safeCast = fromIntegral @Word8 . coerce
instance SafeCast Word4 Word64 where safeCast = fromIntegral @Word8 . coerce
instance SafeCast Word4 Word8 where safeCast = coerce
instance SafeCast Word6 Int where safeCast = fromIntegral @Word8 . coerce
instance SafeCast Word6 Word8 where safeCast = coerce
instance SafeCast Word6 Word60 where safeCast = coerce @Word64
. fromIntegral @Word8 . coerce
instance SafeCast Word6 Word64 where safeCast = fromIntegral @Word8 . coerce
instance SafeCast Word8 Word32 where safeCast = fromIntegral
instance SafeCast Word8 Word64 where safeCast = fromIntegral
instance SafeCast Word12 Word64 where safeCast = fromIntegral @Word16 . coerce
instance SafeCast Word24 Word64 where safeCast = fromIntegral @Word32 . coerce
instance SafeCast Word24 Word32 where safeCast = coerce
instance SafeCast Word60 Word64 where safeCast = coerce
instance SafeCast Word64 Integer where safeCast = fromIntegral
instance HasResolution e => SafeCast Word64 (Fixed e) where
safeCast = fromIntegral