Initial commit

bundled/Basement/Numerical/Additive.hs

@@ -0,0 +1,271 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RebindableSyntax #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash         #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# OPTIONS_GHC -fno-prof-auto #-}
+module Basement.Numerical.Additive
+    ( Additive(..)
+    ) where
+
+#include "MachDeps.h"
+
+import           Basement.Compat.Base
+import           Basement.Compat.C.Types
+import           Basement.Compat.Natural
+import           Basement.Compat.Primitive
+import           Basement.Numerical.Number
+import qualified Prelude
+import           GHC.Types (Float(..), Double(..))
+import           GHC.Prim (plusWord#, plusFloat#, (+#), (+##))
+import qualified GHC.Prim
+import           GHC.Int
+import           GHC.Word
+import           Basement.Bounded
+import           Basement.Nat
+import           Basement.Types.Word128 (Word128)
+import           Basement.Types.Word256 (Word256)
+import qualified Basement.Types.Word128 as Word128
+import qualified Basement.Types.Word256 as Word256
+
+#if WORD_SIZE_IN_BITS < 64
+import           GHC.IntWord64
+#endif
+
+-- | Represent class of things that can be added together,
+-- contains a neutral element and is commutative.
+--
+-- > x + azero = x
+-- > azero + x = x
+-- > x + y = y + x
+--
+class Additive a where
+    {-# MINIMAL azero, (+) #-}
+    azero :: a           -- the identity element over addition
+    (+)   :: a -> a -> a -- the addition
+
+    scale :: IsNatural n => n -> a -> a -- scale: repeated addition
+    default scale :: (Enum n, IsNatural n) => n -> a -> a
+    scale = scaleEnum
+
+scaleEnum :: (Enum n, IsNatural n, Additive a) => n -> a -> a
+scaleEnum 0 _ = azero
+scaleEnum 1 a = a
+scaleEnum 2 a = a + a
+scaleEnum n a = a + scaleEnum (pred n) a -- TODO optimise. define by group of 2.
+
+infixl 6 +
+
+instance Additive Integer where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive Int where
+    azero = 0
+    (I# a) + (I# b) = I# (a +# b)
+    scale = scaleNum
+instance Additive Int8 where
+    azero = 0
+    (I8# a) + (I8# b) = I8# (a `plusInt8#` b)
+    scale = scaleNum
+instance Additive Int16 where
+    azero = 0
+    (I16# a) + (I16# b) = I16# (a `plusInt16#` b)
+    scale = scaleNum
+instance Additive Int32 where
+    azero = 0
+    (I32# a) + (I32# b) = I32# (a `plusInt32#` b)
+    scale = scaleNum
+instance Additive Int64 where
+    azero = 0
+#if WORD_SIZE_IN_BITS == 64
+#if __GLASGOW_HASKELL__ >= 904
+    (I64# a) + (I64# b) = I64# (GHC.Prim.intToInt64# (GHC.Prim.int64ToInt# a +# GHC.Prim.int64ToInt# b))
+
+#else
+    (I64# a) + (I64# b) = I64# (a +# b)
+
+#endif
+#else
+    (I64# a) + (I64# b) = I64# (a `plusInt64#` b)
+#endif
+    scale = scaleNum
+instance Additive Word where
+    azero = 0
+    (W# a) + (W# b) = W# (a `plusWord#` b)
+    scale = scaleNum
+instance Additive Natural where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive Word8 where
+    azero = 0
+    (W8# a) + (W8# b) = W8# (a `plusWord8#` b)
+    scale = scaleNum
+instance Additive Word16 where
+    azero = 0
+    (W16# a) + (W16# b) = W16# (a `plusWord16#` b)
+    scale = scaleNum
+instance Additive Word32 where
+    azero = 0
+    (W32# a) + (W32# b) = W32# (a `plusWord32#` b)
+    scale = scaleNum
+instance Additive Word64 where
+    azero = 0
+#if WORD_SIZE_IN_BITS == 64
+#if __GLASGOW_HASKELL__ >= 904
+    (W64# a) + (W64# b) = W64# (GHC.Prim.wordToWord64# (GHC.Prim.word64ToWord# a `plusWord#` GHC.Prim.word64ToWord# b))
+
+#else
+    (W64# a) + (W64# b) = W64# (a `plusWord#` b)
+
+#endif
+#else
+    (W64# a) + (W64# b) = W64# (int64ToWord64# (word64ToInt64# a `plusInt64#` word64ToInt64# b))
+#endif
+    scale = scaleNum
+instance Additive Word128 where
+    azero = 0
+    (+) = (Word128.+)
+    scale = scaleNum
+instance Additive Word256 where
+    azero = 0
+    (+) = (Word256.+)
+    scale = scaleNum
+
+instance Additive Prelude.Float where
+    azero = 0.0
+    (F# a) + (F# b) = F# (a `plusFloat#` b)
+    scale = scaleNum
+instance Additive Prelude.Double where
+    azero = 0.0
+    (D# a) + (D# b) = D# (a +## b)
+    scale = scaleNum
+instance Additive Prelude.Rational where
+    azero = 0.0
+    (+) = (Prelude.+)
+    scale = scaleNum
+
+instance (KnownNat n, NatWithinBound Word64 n) => Additive (Zn64 n) where
+    azero = zn64 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance KnownNat n => Additive (Zn n) where
+    azero = zn 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+
+instance Additive CChar where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CSChar where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CUChar where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CShort where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CUShort where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CInt where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CUInt where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CLong where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CULong where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CPtrdiff where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CSize where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CWchar where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CSigAtomic where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CLLong where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CULLong where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CIntPtr where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CUIntPtr where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CIntMax where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CUIntMax where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CClock where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CTime where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CUSeconds where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CSUSeconds where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive COff where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+
+instance Additive CFloat where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+instance Additive CDouble where
+    azero = 0
+    (+) = (Prelude.+)
+    scale = scaleNum
+
+scaleNum :: (Prelude.Num a, IsNatural n) => n -> a -> a
+scaleNum n a = (Prelude.fromIntegral $ toNatural n) Prelude.* a