module Data.Word12.Internal where
import GHC.Enum
import GHC.Arr
import Data.Bits
import Data.Word
import Data.Monoid
import Data.ByteString.Lazy.Builder
newtype Word12 = W12# Word16
deriving (Eq, Ord, Real, Integral)
narrow12Word :: Word16 -> Word16
narrow12Word a = 0xfff .&. a
instance Num Word12 where
W12# x + W12# y = W12# $ narrow12Word $ x + y
W12# x * W12# y = W12# $ narrow12Word $ x * y
W12# x W12# y = W12# $ narrow12Word $ x y
negate (W12# x) = W12# $ narrow12Word $ negate x
abs (W12# x) = W12# $ narrow12Word $ abs x
signum (W12# x) = W12# $ narrow12Word $ signum x
fromInteger i = W12# $ narrow12Word $ fromInteger i
instance Bounded Word12 where
maxBound = 0xfff
minBound = 0x000
instance Bits Word12 where
W12# x .&. W12# y = W12# $ x .&. y
W12# x .|. W12# y = W12# $ x .|. y
W12# x `xor` W12# y = W12# $ x `xor` y
complement x = x `xor` maxBound
shift (W12# x) i
| i >= 0 = W12# $ narrow12Word $ shiftL x i
| otherwise = W12# $ shiftR x (i)
bitSize _ = 12
popCount (W12# x) = popCount x
bit = bitDefault
isSigned _ = False
testBit = testBitDefault
rotate w i
| r == 0 = w
| otherwise = w `shiftL` r .|. w `shiftR` (12 r)
where
r = i `mod` 12
#if MIN_VERSION_base(4,7,0)
bitSizeMaybe _ = Just 12
#endif
instance Enum Word12 where
succ x
| x /= maxBound = x + 1
| otherwise = succError "Word12"
pred x
| x /= minBound = x 1
| otherwise = predError "Word12"
toEnum i
| i >= 0 && i <= 0xfff
= W12# $ toEnum i
| otherwise = toEnumError "Word12" i (0, 0xfff :: Word16)
fromEnum (W12# x) = fromEnum x
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
#if MIN_VERSION_base(4,7,0)
instance FiniteBits Word12 where
finiteBitSize _ = 12
#endif
instance Show Word12 where
show (W12# x) = show x
instance Read Word12 where
readsPrec i s = [(fromIntegral (x :: Int), r) | (x, r) <- readsPrec i s]
instance Ix Word12 where
range (x, y) = [x..y]
unsafeIndex (x, _) z = fromIntegral $ z x
inRange (x, y) z = x <= z && z <= y
fromWord12sle :: [Word12] -> Builder
fromWord12sle = go
where
go (w12 : v12 : ws) = word8 w8
<> word8 (w4 .|. v4)
<> word8 v8
<> go ws
where
(w4, w8) = split4'8 w12
(v8, v4) = split8'4 v12
go [w12] = word8 w8 <> word8 w4
where
(w4, w8) = split4'8 w12
go [] = mempty
fromWord12sbe :: [Word12] -> Builder
fromWord12sbe = go
where
go (w12 : v12 : ws) = word8 w8
<> word8 (w4 .|. v4)
<> word8 v8
<> go ws
where
(w8, w4) = split8'4 w12
(v4, v8) = split4'8 v12
go [w12] = word8 w8 <> word8 w4
where
(w8, w4) = split8'4 w12
go [] = mempty
split4'8 :: Word12 -> (Word8, Word8)
split4'8 w12 = (w4, w8)
where
w4 = fromIntegral $ shiftR (w12 .&. 0xf00) 8
w8 = fromIntegral $ w12 .&. 0x0ff
split8'4 :: Word12 -> (Word8, Word8)
split8'4 w12 = (w8, w4)
where
w4 = fromIntegral $ shiftL (w12 .&. 0x00f) 4
w8 = fromIntegral $ shiftR (w12 .&. 0xff0) 4