packages feed

basement-0.0.15: Basement/Numerical/Additive.hs

{-# 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