1 {-# LANGUAGE TypeFamilies, TypeOperators, ScopedTypeVariables, FlexibleInstances, TemplateHaskell, Rank2Types, FlexibleContexts #-}
2 module Data.Param.Unsigned
8 import Language.Haskell.TH
9 import Language.Haskell.TH.Syntax (Lift(..))
10 import qualified Data.Bits as B
12 import Types.Data.Num.Decimal.Literals.TH
14 import Data.Param.Integer
16 instance NaturalT nT => Lift (Unsigned nT) where
17 lift (Unsigned i) = sigE [| (Unsigned i) |] (decUnsignedT (fromIntegerT (undefined :: nT)))
19 decUnsignedT :: Integer -> Q Type
20 decUnsignedT n = appT (conT (''Unsigned)) (decLiteralT n)
25 , ((Pow2 nT') :>: nT) ~ True
27 ) => Index nT -> Unsigned nT'
28 fromIndex index = Unsigned (toInteger index)
30 resizeUnsigned :: (NaturalT nT, NaturalT nT') => Unsigned nT -> Unsigned nT'
31 resizeUnsigned a = fromInteger (toInteger a)
37 mask :: forall nT . NaturalT nT
40 mask _ = B.bit (fromIntegerT (undefined :: nT)) - 1
42 instance NaturalT nT => Eq (Unsigned nT) where
43 (Unsigned x) == (Unsigned y) = x == y
44 (Unsigned x) /= (Unsigned y) = x /= y
46 instance NaturalT nT => Show (Unsigned nT) where
48 showsPrec prec $ toInteger n
50 instance NaturalT nT => Read (Unsigned nT) where
52 [ (fromInteger n, str)
53 | (n, str) <- readsPrec prec str ]
55 instance NaturalT nT => Ord (Unsigned nT) where
56 a `compare` b = toInteger a `compare` toInteger b
58 instance NaturalT nT => Bounded (Unsigned nT) where
60 maxBound = Unsigned $ (1 `B.shiftL` (fromIntegerT (undefined :: nT))) - 1
62 instance NaturalT nT => Enum (Unsigned nT) where
64 | x == maxBound = error $ "Enum.succ{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `succ' of maxBound"
67 | x == minBound = error $ "Enum.succ{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `pred' of minBound"
71 | x > toInteger (maxBound :: Int) =
72 error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned greater than maxBound :: Int"
73 | x < toInteger (minBound :: Int) =
74 error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned smaller than minBound :: Int"
78 | x > fromIntegral (maxBound :: Unsigned nT) =
79 error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned greater than maxBound :: Unsigned " ++ show (fromIntegerT (undefined :: nT))
80 | x < fromIntegral (minBound :: Unsigned nT) =
81 error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned smaller than minBound :: Unsigned " ++ show (fromIntegerT (undefined :: nT))
83 fromInteger $ toInteger x
85 instance NaturalT nT => Num (Unsigned nT) where
86 (Unsigned a) + (Unsigned b) =
88 (Unsigned a) * (Unsigned b) =
90 negate s@(Unsigned n) =
91 fromInteger $ (n `B.xor` mask (sizeT s)) + 1
97 Unsigned $ n B..&. mask (undefined :: nT)
100 negate $ fromInteger $ negate n
111 instance NaturalT nT => Real (Unsigned nT) where
112 toRational n = toRational $ toInteger n
114 instance NaturalT nT => Integral (Unsigned nT) where
116 fromInteger $ toInteger a `quot` toInteger b
118 fromInteger $ toInteger a `rem` toInteger b
120 fromInteger $ toInteger a `div` toInteger b
122 fromInteger $ toInteger a `mod` toInteger b
124 let (quot, rem) = toInteger a `quotRem` toInteger b
125 in (fromInteger quot, fromInteger rem)
127 let (div, mod) = toInteger a `divMod` toInteger b
128 in (fromInteger div, fromInteger mod)
129 toInteger s@(Unsigned x) = x
131 instance NaturalT nT => B.Bits (Unsigned nT) where
132 (Unsigned a) .&. (Unsigned b) = Unsigned $ a B..&. b
133 (Unsigned a) .|. (Unsigned b) = Unsigned $ a B..|. b
134 (Unsigned a) `xor` Unsigned b = Unsigned $ a `B.xor` b
135 complement (Unsigned x) = Unsigned $ x `B.xor` mask (undefined :: nT)
136 s@(Unsigned x) `shiftL` b
137 | b < 0 = error $ "Bits.shiftL{Unsigned " ++ show (B.bitSize s) ++ "}: tried to shift by negative amount"
139 Unsigned $ mask (undefined :: nT) B..&. (x `B.shiftL` b)
140 s@(Unsigned x) `shiftR` b
141 | b < 0 = error $ "Bits.shiftR{Unsigned " ++ show (B.bitSize s) ++ "}: tried to shift by negative amount"
143 Unsigned $ (x `B.shiftR` b)
144 s@(Unsigned x) `rotateL` b
146 error $ "Bits.rotateL{Unsigned " ++ show (B.bitSize s) ++ "}: tried to rotate by negative amount"
148 Unsigned $ mask (undefined :: nT) B..&.
149 ((x `B.shiftL` b) B..|. (x `B.shiftR` (B.bitSize s - b)))
150 s@(Unsigned x) `rotateR` b
152 error $ "Bits.rotateR{Unsigned " ++ show (B.bitSize s) ++ "}: tried to rotate by negative amount"
154 Unsigned $ mask (undefined :: nT) B..&.
155 ((x `B.shiftR` b) B..|. (x `B.shiftL` (B.bitSize s - b)))
156 bitSize _ = fromIntegerT (undefined :: nT)
159 instance NaturalT nT => HWBits (Unsigned nT) where
160 a `shiftL` b = a `B.shiftL` (fromInteger (toInteger b))
161 a `shiftR` b = a `B.shiftR` (fromInteger (toInteger b))