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