1{-# LANGUAGE CPP               #-}
2{-# LANGUAGE MagicHash         #-}
3{-# LANGUAGE UndecidableInstances #-}
4{-# LANGUAGE DefaultSignatures #-}
5{-# OPTIONS_GHC -fno-prof-auto #-}
6module Basement.Numerical.Additive
7    ( Additive(..)
8    ) where
9
10#include "MachDeps.h"
11
12import           Basement.Compat.Base
13import           Basement.Compat.C.Types
14import           Basement.Compat.Natural
15import           Basement.Numerical.Number
16import qualified Prelude
17import           GHC.Types
18import           GHC.Prim
19import           GHC.Int
20import           GHC.Word
21import           Basement.Bounded
22import           Basement.Nat
23import           Basement.Types.Word128 (Word128)
24import           Basement.Types.Word256 (Word256)
25import qualified Basement.Types.Word128 as Word128
26import qualified Basement.Types.Word256 as Word256
27
28#if WORD_SIZE_IN_BITS < 64
29import           GHC.IntWord64
30#endif
31
32-- | Represent class of things that can be added together,
33-- contains a neutral element and is commutative.
34--
35-- > x + azero = x
36-- > azero + x = x
37-- > x + y = y + x
38--
39class Additive a where
40    {-# MINIMAL azero, (+) #-}
41    azero :: a           -- the identity element over addition
42    (+)   :: a -> a -> a -- the addition
43
44    scale :: IsNatural n => n -> a -> a -- scale: repeated addition
45    default scale :: (Enum n, IsNatural n) => n -> a -> a
46    scale = scaleEnum
47
48scaleEnum :: (Enum n, IsNatural n, Additive a) => n -> a -> a
49scaleEnum 0 _ = azero
50scaleEnum 1 a = a
51scaleEnum 2 a = a + a
52scaleEnum n a = a + scaleEnum (pred n) a -- TODO optimise. define by group of 2.
53
54infixl 6 +
55
56instance Additive Integer where
57    azero = 0
58    (+) = (Prelude.+)
59    scale = scaleNum
60instance Additive Int where
61    azero = 0
62    (I# a) + (I# b) = I# (a +# b)
63    scale = scaleNum
64instance Additive Int8 where
65    azero = 0
66    (I8# a) + (I8# b) = I8# (narrow8Int# (a +# b))
67    scale = scaleNum
68instance Additive Int16 where
69    azero = 0
70    (I16# a) + (I16# b) = I16# (narrow16Int# (a +# b))
71    scale = scaleNum
72instance Additive Int32 where
73    azero = 0
74    (I32# a) + (I32# b) = I32# (narrow32Int# (a +# b))
75    scale = scaleNum
76instance Additive Int64 where
77    azero = 0
78#if WORD_SIZE_IN_BITS == 64
79    (I64# a) + (I64# b) = I64# (a +# b)
80#else
81    (I64# a) + (I64# b) = I64# (a `plusInt64#` b)
82#endif
83    scale = scaleNum
84instance Additive Word where
85    azero = 0
86    (W# a) + (W# b) = W# (a `plusWord#` b)
87    scale = scaleNum
88instance Additive Natural where
89    azero = 0
90    (+) = (Prelude.+)
91    scale = scaleNum
92instance Additive Word8 where
93    azero = 0
94    (W8# a) + (W8# b) = W8# (narrow8Word# (a `plusWord#` b))
95    scale = scaleNum
96instance Additive Word16 where
97    azero = 0
98    (W16# a) + (W16# b) = W16# (narrow16Word# (a `plusWord#` b))
99    scale = scaleNum
100instance Additive Word32 where
101    azero = 0
102    (W32# a) + (W32# b) = W32# (narrow32Word# (a `plusWord#` b))
103    scale = scaleNum
104instance Additive Word64 where
105    azero = 0
106#if WORD_SIZE_IN_BITS == 64
107    (W64# a) + (W64# b) = W64# (a `plusWord#` b)
108#else
109    (W64# a) + (W64# b) = W64# (int64ToWord64# (word64ToInt64# a `plusInt64#` word64ToInt64# b))
110#endif
111    scale = scaleNum
112instance Additive Word128 where
113    azero = 0
114    (+) = (Word128.+)
115    scale = scaleNum
116instance Additive Word256 where
117    azero = 0
118    (+) = (Word256.+)
119    scale = scaleNum
120instance Additive Prelude.Float where
121    azero = 0.0
122    (F# a) + (F# b) = F# (a `plusFloat#` b)
123    scale = scaleNum
124instance Additive Prelude.Double where
125    azero = 0.0
126    (D# a) + (D# b) = D# (a +## b)
127    scale = scaleNum
128
129instance (KnownNat n, NatWithinBound Word64 n) => Additive (Zn64 n) where
130    azero = zn64 0
131    (+) = (Prelude.+)
132    scale = scaleNum
133instance KnownNat n => Additive (Zn n) where
134    azero = zn 0
135    (+) = (Prelude.+)
136    scale = scaleNum
137
138instance Additive CChar where
139    azero = 0
140    (+) = (Prelude.+)
141    scale = scaleNum
142instance Additive CSChar where
143    azero = 0
144    (+) = (Prelude.+)
145    scale = scaleNum
146instance Additive CUChar where
147    azero = 0
148    (+) = (Prelude.+)
149    scale = scaleNum
150instance Additive CShort where
151    azero = 0
152    (+) = (Prelude.+)
153    scale = scaleNum
154instance Additive CUShort where
155    azero = 0
156    (+) = (Prelude.+)
157    scale = scaleNum
158instance Additive CInt where
159    azero = 0
160    (+) = (Prelude.+)
161    scale = scaleNum
162instance Additive CUInt where
163    azero = 0
164    (+) = (Prelude.+)
165    scale = scaleNum
166instance Additive CLong where
167    azero = 0
168    (+) = (Prelude.+)
169    scale = scaleNum
170instance Additive CULong where
171    azero = 0
172    (+) = (Prelude.+)
173    scale = scaleNum
174instance Additive CPtrdiff where
175    azero = 0
176    (+) = (Prelude.+)
177    scale = scaleNum
178instance Additive CSize where
179    azero = 0
180    (+) = (Prelude.+)
181    scale = scaleNum
182instance Additive CWchar where
183    azero = 0
184    (+) = (Prelude.+)
185    scale = scaleNum
186instance Additive CSigAtomic where
187    azero = 0
188    (+) = (Prelude.+)
189    scale = scaleNum
190instance Additive CLLong where
191    azero = 0
192    (+) = (Prelude.+)
193    scale = scaleNum
194instance Additive CULLong where
195    azero = 0
196    (+) = (Prelude.+)
197    scale = scaleNum
198instance Additive CIntPtr where
199    azero = 0
200    (+) = (Prelude.+)
201    scale = scaleNum
202instance Additive CUIntPtr where
203    azero = 0
204    (+) = (Prelude.+)
205    scale = scaleNum
206instance Additive CIntMax where
207    azero = 0
208    (+) = (Prelude.+)
209    scale = scaleNum
210instance Additive CUIntMax where
211    azero = 0
212    (+) = (Prelude.+)
213    scale = scaleNum
214instance Additive CClock where
215    azero = 0
216    (+) = (Prelude.+)
217    scale = scaleNum
218instance Additive CTime where
219    azero = 0
220    (+) = (Prelude.+)
221    scale = scaleNum
222instance Additive CUSeconds where
223    azero = 0
224    (+) = (Prelude.+)
225    scale = scaleNum
226instance Additive CSUSeconds where
227    azero = 0
228    (+) = (Prelude.+)
229    scale = scaleNum
230instance Additive COff where
231    azero = 0
232    (+) = (Prelude.+)
233    scale = scaleNum
234
235instance Additive CFloat where
236    azero = 0
237    (+) = (Prelude.+)
238    scale = scaleNum
239instance Additive CDouble where
240    azero = 0
241    (+) = (Prelude.+)
242    scale = scaleNum
243
244scaleNum :: (Prelude.Num a, IsNatural n) => n -> a -> a
245scaleNum n a = (Prelude.fromIntegral $ toNatural n) Prelude.* a
246