module Data.Param.Unsigned
( Unsigned
, resize
, fromIndex
) where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (Lift(..))
import Data.Bits
import Types
import Types.Data.Num.Decimal.Literals.TH
import Data.Param.Integer
instance NaturalT nT => Lift (Unsigned nT) where
lift (Unsigned i) = sigE [| (Unsigned i) |] (decUnsignedT (fromIntegerT (undefined :: nT)))
decUnsignedT :: Integer -> Q Type
decUnsignedT n = appT (conT (''Unsigned)) (decLiteralT n)
fromIndex ::
( NaturalT nT
, NaturalT nT'
, ((Pow2 nT') :>: nT) ~ True
, Integral (Index nT)
) => Index nT -> Unsigned nT'
fromIndex index = Unsigned (toInteger index)
resize :: (NaturalT nT, NaturalT nT') => Unsigned nT -> Unsigned nT'
resize a = fromInteger (toInteger a)
sizeT :: Unsigned nT
-> nT
sizeT _ = undefined
mask :: forall nT . NaturalT nT
=> nT
-> Integer
mask _ = bit (fromIntegerT (undefined :: nT)) 1
instance NaturalT nT => Eq (Unsigned nT) where
(Unsigned x) == (Unsigned y) = x == y
(Unsigned x) /= (Unsigned y) = x /= y
instance NaturalT nT => Show (Unsigned nT) where
showsPrec prec n =
showsPrec prec $ toInteger n
instance NaturalT nT => Read (Unsigned nT) where
readsPrec prec str =
[ (fromInteger n, str)
| (n, str) <- readsPrec prec str ]
instance NaturalT nT => Ord (Unsigned nT) where
a `compare` b = toInteger a `compare` toInteger b
instance NaturalT nT => Bounded (Unsigned nT) where
minBound = 0
maxBound = Unsigned $ (1 `shiftL` (fromIntegerT (undefined :: nT))) 1
instance NaturalT nT => Enum (Unsigned nT) where
succ x
| x == maxBound = error $ "Enum.succ{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `succ' of maxBound"
| otherwise = x + 1
pred x
| x == minBound = error $ "Enum.succ{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `pred' of minBound"
| otherwise = x 1
fromEnum (Unsigned x)
| x > toInteger (maxBound :: Int) =
error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned greater than maxBound :: Int"
| x < toInteger (minBound :: Int) =
error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned smaller than minBound :: Int"
| otherwise =
fromInteger x
toEnum x
| x > fromIntegral (maxBound :: Unsigned nT) =
error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned greater than maxBound :: Unsigned " ++ show (fromIntegerT (undefined :: nT))
| x < fromIntegral (minBound :: Unsigned nT) =
error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned smaller than minBound :: Unsigned " ++ show (fromIntegerT (undefined :: nT))
| otherwise =
fromInteger $ toInteger x
instance NaturalT nT => Num (Unsigned nT) where
(Unsigned a) + (Unsigned b) =
fromInteger $ a + b
(Unsigned a) * (Unsigned b) =
fromInteger $ a * b
negate s@(Unsigned n) =
fromInteger $ (n `xor` mask (sizeT s)) + 1
a b =
a + (negate b)
fromInteger n
| n > 0 =
Unsigned $ n .&. mask (undefined :: nT)
fromInteger n
| n < 0 =
negate $ fromInteger $ negate n
fromInteger _ =
Unsigned 0
abs s = s
signum s
| s == 0 =
0
| otherwise =
1
instance NaturalT nT => Real (Unsigned nT) where
toRational n = toRational $ toInteger n
instance NaturalT nT => Integral (Unsigned nT) where
a `quot` b =
fromInteger $ toInteger a `quot` toInteger b
a `rem` b =
fromInteger $ toInteger a `rem` toInteger b
a `div` b =
fromInteger $ toInteger a `div` toInteger b
a `mod` b =
fromInteger $ toInteger a `mod` toInteger b
a `quotRem` b =
let (quot, rem) = toInteger a `quotRem` toInteger b
in (fromInteger quot, fromInteger rem)
a `divMod` b =
let (div, mod) = toInteger a `divMod` toInteger b
in (fromInteger div, fromInteger mod)
toInteger s@(Unsigned x) = x
instance NaturalT nT => Bits (Unsigned nT) where
(Unsigned a) .&. (Unsigned b) = Unsigned $ a .&. b
(Unsigned a) .|. (Unsigned b) = Unsigned $ a .|. b
(Unsigned a) `xor` Unsigned b = Unsigned $ a `xor` b
complement (Unsigned x) = Unsigned $ x `xor` mask (undefined :: nT)
s@(Unsigned x) `shiftL` b
| b < 0 = error $ "Bits.shiftL{Unsigned " ++ show (bitSize s) ++ "}: tried to shift by negative amount"
| otherwise =
Unsigned $ mask (undefined :: nT) .&. (x `shiftL` b)
s@(Unsigned x) `shiftR` b
| b < 0 = error $ "Bits.shiftR{Unsigned " ++ show (bitSize s) ++ "}: tried to shift by negative amount"
| otherwise =
Unsigned $ (x `shiftR` b)
s@(Unsigned x) `rotateL` b
| b < 0 =
error $ "Bits.rotateL{Unsigned " ++ show (bitSize s) ++ "}: tried to rotate by negative amount"
| otherwise =
Unsigned $ mask (undefined :: nT) .&.
((x `shiftL` b) .|. (x `shiftR` (bitSize s b)))
s@(Unsigned x) `rotateR` b
| b < 0 =
error $ "Bits.rotateR{Unsigned " ++ show (bitSize s) ++ "}: tried to rotate by negative amount"
| otherwise =
Unsigned $ mask (undefined :: nT) .&.
((x `shiftR` b) .|. (x `shiftL` (bitSize s b)))
bitSize _ = fromIntegerT (undefined :: nT)
isSigned _ = False