Add higherordercpu and matrix multiplication examples
[matthijs/master-project/cλash.git] / clash / Data / Param / Signed.hs
1 {-# LANGUAGE  TypeFamilies, TypeOperators, ScopedTypeVariables, FlexibleInstances, TemplateHaskell, Rank2Types, FlexibleContexts #-}
2 module Data.Param.Signed
3   ( Signed
4   , resizeSigned
5   ) where
6
7 import Language.Haskell.TH
8 import Language.Haskell.TH.Syntax (Lift(..))
9 import Data.Bits
10 import Types
11 import Types.Data.Num.Decimal.Literals.TH
12
13 import Data.Param.Integer
14
15 instance NaturalT nT => Lift (Signed nT) where
16   lift (Signed i) = sigE [| (Signed i) |] (decSignedT (fromIntegerT (undefined :: nT)))
17
18 decSignedT :: Integer -> Q Type
19 decSignedT n = appT (conT (''Signed)) (decLiteralT n)
20
21 resizeSigned :: (NaturalT nT, NaturalT nT') => Signed nT -> Signed nT'
22 resizeSigned a = fromInteger (toInteger a)
23
24 sizeT :: Signed nT
25       -> nT
26 sizeT _ = undefined
27
28 mask :: forall nT . NaturalT nT
29      => nT
30      -> Integer
31 mask _ = bit (fromIntegerT (undefined :: nT)) - 1
32
33 signBit :: forall nT . NaturalT nT
34         => nT
35         -> Int
36 signBit _ = fromIntegerT (undefined :: nT) - 1
37
38 isNegative :: forall nT . NaturalT nT
39            => Signed nT
40            -> Bool
41 isNegative (Signed x) =
42     testBit x $ signBit (undefined :: nT)
43
44 instance NaturalT nT => Eq (Signed nT) where
45     (Signed x) == (Signed y) = x == y
46     (Signed x) /= (Signed y) = x /= y
47
48 instance NaturalT nT => Show (Signed nT) where
49     showsPrec prec n =
50         showsPrec prec $ toInteger n
51
52 instance NaturalT nT => Read (Signed nT) where
53     readsPrec prec str =
54         [ (fromInteger n, str)
55         | (n, str) <- readsPrec prec str ]
56
57 instance NaturalT nT => Ord (Signed nT) where
58     a `compare` b = toInteger a `compare` toInteger b
59
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
63
64 instance NaturalT nT => Enum (Signed nT) where
65     succ x
66        | x == maxBound  = error $ "Enum.succ{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `succ' of maxBound"
67        | otherwise      = x + 1
68     pred x
69        | x == minBound  = error $ "Enum.succ{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `pred' of minBound"
70        | otherwise      = x - 1
71     
72     fromEnum (Signed x)
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"
77         | otherwise =
78             fromInteger x
79     toEnum x
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))
84         | otherwise =
85             fromInteger x'
86             where x' = toInteger x
87
88 instance NaturalT nT => Num (Signed nT) where
89     (Signed a) + (Signed b) =
90         fromInteger $ a + b
91     (Signed a) * (Signed b) =
92         fromInteger $ a * b
93     negate (Signed n) =
94         fromInteger $ (n `xor` mask (undefined :: nT)) + 1
95     a - b =
96         a + (negate b)
97     
98     fromInteger n
99       | n > 0 =
100         Signed $ n .&. mask (undefined :: nT)
101     fromInteger n
102       | n < 0 =
103         negate $ fromInteger $ negate n
104     fromInteger _ =
105         Signed 0
106     
107     abs s
108       | isNegative s =
109           negate s
110       | otherwise =
111           s
112     signum s
113       | isNegative s =
114           -1
115       | s == 0 =
116           0
117       | otherwise =
118           1
119
120 instance NaturalT nT => Real (Signed nT) where
121     toRational n = toRational $ toInteger n
122
123 instance NaturalT nT => Integral (Signed nT) where
124     a `quot` b =
125         fromInteger $ toInteger a `quot` toInteger b
126     a `rem` b =
127         fromInteger $ toInteger a `rem` toInteger b
128     a `div` b =
129         fromInteger $ toInteger a `div` toInteger b
130     a `mod` b =
131         fromInteger $ toInteger a `mod` toInteger b
132     a `quotRem` b =
133         let (quot, rem) = toInteger a `quotRem` toInteger b
134         in (fromInteger quot, fromInteger rem)
135     a `divMod` b =
136         let (div, mod) = toInteger a `divMod` toInteger b
137         in (fromInteger div, fromInteger mod)
138     toInteger s@(Signed x) =
139         if isNegative s
140            then let Signed x' = negate s in negate x'
141            else x
142
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"
150       | otherwise =
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"
154       | isNegative s =
155         Signed $ mask (undefined :: nT) .&.
156             ((x `shiftR` b) .|. (mask (undefined :: nT) `shiftL` (fromIntegerT (undefined :: nT) - b)))
157       | otherwise =
158         Signed $ (mask (undefined :: nT)) .&. (x `shiftR` b)
159     (Signed a) `rotateL` b
160       | b < 0 =
161         error $ "Bits.rotateL{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to rotate by negative amount"
162       | otherwise =
163         Signed $ mask (undefined :: nT) .&.
164             ((a `shiftL` b) .|. (a `shiftR` (fromIntegerT (undefined :: nT) - b)))
165     (Signed a) `rotateR` b
166       | b < 0 =
167         error $ "Bits.rotateR{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to rotate by negative amount"
168       | otherwise =
169         Signed $ mask (undefined :: nT) .&.
170             ((a `shiftR` b) .|. (a `shiftL` (fromIntegerT (undefined :: nT) - b)))
171     bitSize _ = fromIntegerT (undefined :: nT)
172     isSigned _ = True