1 {-# LANGUAGE TypeFamilies, TypeOperators, ScopedTypeVariables, FlexibleInstances, TemplateHaskell, Rank2Types, FlexibleContexts #-}
2 module Data.Param.Signed
7 import Language.Haskell.TH
8 import Language.Haskell.TH.Syntax (Lift(..))
11 import Types.Data.Num.Decimal.Literals.TH
13 import Data.Param.Integer
15 instance NaturalT nT => Lift (Signed nT) where
16 lift (Signed i) = sigE [| (Signed i) |] (decSignedT (fromIntegerT (undefined :: nT)))
18 decSignedT :: Integer -> Q Type
19 decSignedT n = appT (conT (''Signed)) (decLiteralT n)
21 resizeSigned :: (NaturalT nT, NaturalT nT') => Signed nT -> Signed nT'
22 resizeSigned a = fromInteger (toInteger a)
28 mask :: forall nT . NaturalT nT
31 mask _ = bit (fromIntegerT (undefined :: nT)) - 1
33 signBit :: forall nT . NaturalT nT
36 signBit _ = fromIntegerT (undefined :: nT) - 1
38 isNegative :: forall nT . NaturalT nT
41 isNegative (Signed x) =
42 testBit x $ signBit (undefined :: nT)
44 instance NaturalT nT => Eq (Signed nT) where
45 (Signed x) == (Signed y) = x == y
46 (Signed x) /= (Signed y) = x /= y
48 instance NaturalT nT => Show (Signed nT) where
50 showsPrec prec $ toInteger n
52 instance NaturalT nT => Read (Signed nT) where
54 [ (fromInteger n, str)
55 | (n, str) <- readsPrec prec str ]
57 instance NaturalT nT => Ord (Signed nT) where
58 a `compare` b = toInteger a `compare` toInteger b
60 instance NaturalT nT => Bounded (Signed nT) where
61 minBound = Signed $ negate $ 1 `shiftL` (fromIntegerT (undefined :: nT) - 1)
62 maxBound = Signed $ (1 `shiftL` (fromIntegerT (undefined :: nT) - 1)) - 1
64 instance NaturalT nT => Enum (Signed nT) where
66 | x == maxBound = error $ "Enum.succ{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `succ' of maxBound"
69 | x == minBound = error $ "Enum.succ{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `pred' of minBound"
73 | x > toInteger (maxBound :: Int) =
74 error $ "Enum.fromEnum{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Signed greater than maxBound :: Int"
75 | x < toInteger (minBound :: Int) =
76 error $ "Enum.fromEnum{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Signed smaller than minBound :: Int"
80 | x' > toInteger (maxBound :: Signed nT) =
81 error $ "Enum.fromEnum{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Signed greater than maxBound :: Signed " ++ show (fromIntegerT (undefined :: nT))
82 | x' < toInteger (minBound :: Signed nT) =
83 error $ "Enum.fromEnum{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Signed smaller than minBound :: Signed " ++ show (fromIntegerT (undefined :: nT))
86 where x' = toInteger x
88 instance NaturalT nT => Num (Signed nT) where
89 (Signed a) + (Signed b) =
91 (Signed a) * (Signed b) =
94 fromInteger $ (n `xor` mask (undefined :: nT)) + 1
100 Signed $ n .&. mask (undefined :: nT)
103 negate $ fromInteger $ negate n
120 instance NaturalT nT => Real (Signed nT) where
121 toRational n = toRational $ toInteger n
123 instance NaturalT nT => Integral (Signed nT) where
125 fromInteger $ toInteger a `quot` toInteger b
127 fromInteger $ toInteger a `rem` toInteger b
129 fromInteger $ toInteger a `div` toInteger b
131 fromInteger $ toInteger a `mod` toInteger b
133 let (quot, rem) = toInteger a `quotRem` toInteger b
134 in (fromInteger quot, fromInteger rem)
136 let (div, mod) = toInteger a `divMod` toInteger b
137 in (fromInteger div, fromInteger mod)
138 toInteger s@(Signed x) =
140 then let Signed x' = negate s in negate x'
143 instance NaturalT nT => Bits (Signed nT) where
144 (Signed a) .&. (Signed b) = Signed $ a .&. b
145 (Signed a) .|. (Signed b) = Signed $ a .|. b
146 (Signed a) `xor` Signed b = Signed $ a `xor` b
147 complement (Signed x) = Signed $ x `xor` mask (undefined :: nT)
148 (Signed x) `shiftL` b
149 | b < 0 = error $ "Bits.shiftL{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to shift by negative amount"
151 Signed $ mask (undefined :: nT) .&. (x `shiftL` b)
152 s@(Signed x) `shiftR` b
153 | b < 0 = error $ "Bits.shiftR{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to shift by negative amount"
155 Signed $ mask (undefined :: nT) .&.
156 ((x `shiftR` b) .|. (mask (undefined :: nT) `shiftL` (fromIntegerT (undefined :: nT) - b)))
158 Signed $ (mask (undefined :: nT)) .&. (x `shiftR` b)
159 (Signed a) `rotateL` b
161 error $ "Bits.rotateL{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to rotate by negative amount"
163 Signed $ mask (undefined :: nT) .&.
164 ((a `shiftL` b) .|. (a `shiftR` (fromIntegerT (undefined :: nT) - b)))
165 (Signed a) `rotateR` b
167 error $ "Bits.rotateR{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to rotate by negative amount"
169 Signed $ mask (undefined :: nT) .&.
170 ((a `shiftR` b) .|. (a `shiftL` (fromIntegerT (undefined :: nT) - b)))
171 bitSize _ = fromIntegerT (undefined :: nT)