stellar-veritas/bundled/Basement/Numerical/Additive.hs
2026-01-25 02:27:22 +01:00

271 lines
6.8 KiB
Haskell

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