module LLVM.Extra.Arithmetic (
Additive (zero, add, sub, neg), one, inc, dec,
PseudoRing (mul), square,
PseudoModule (scale),
Field (fdiv),
IntegerConstant(fromInteger'),
RationalConstant(fromRational'),
idiv, irem,
fcmp, cmp,
and, or,
Real (min, max, abs),
Fraction (truncate, fraction),
signedFraction, addToPhase, incPhase,
advanceArrayElementPtr,
Algebraic (sqrt),
Transcendental (sin, cos, exp, log, pow),
) where
import LLVM.Extra.ArithmeticPrivate
(cmp, fcmp, and, or,
inc, dec, advanceArrayElementPtr, )
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Core as LLVM
import LLVM.Core
(CodeGenFunction, value, Value, ConstValue,
IsType, IsInteger, IsFloating, IsArithmetic, IsFirstClass, )
import Control.Monad (liftM2, liftM3, )
import Prelude hiding
(Real, and, or, sqrt, sin, cos, exp, log, abs, min, max, truncate, )
class Additive a where
zero :: a
add :: a -> a -> CodeGenFunction r a
sub :: a -> a -> CodeGenFunction r a
neg :: a -> CodeGenFunction r a
instance (IsArithmetic a) => Additive (Value a) where
zero = LLVM.value LLVM.zero
add = LLVM.add
sub = LLVM.sub
neg = LLVM.neg
instance (IsArithmetic a) => Additive (ConstValue a) where
zero = LLVM.zero
add = LLVM.add
sub = LLVM.sub
neg = sub LLVM.zero
instance (Additive a, Additive b) => Additive (a,b) where
zero = (zero, zero)
add (x0,x1) (y0,y1) =
liftM2 (,) (add x0 y0) (add x1 y1)
sub (x0,x1) (y0,y1) =
liftM2 (,) (sub x0 y0) (sub x1 y1)
neg (x0,x1) =
liftM2 (,) (neg x0) (neg x1)
instance (Additive a, Additive b, Additive c) => Additive (a,b,c) where
zero = (zero, zero, zero)
add (x0,x1,x2) (y0,y1,y2) =
liftM3 (,,) (add x0 y0) (add x1 y1) (add x2 y2)
sub (x0,x1,x2) (y0,y1,y2) =
liftM3 (,,) (sub x0 y0) (sub x1 y1) (sub x2 y2)
neg (x0,x1,x2) =
liftM3 (,,) (neg x0) (neg x1) (neg x2)
class (Additive a) => PseudoRing a where
mul :: a -> a -> CodeGenFunction r a
instance (IsArithmetic v) => PseudoRing (Value v) where
mul = LLVM.mul
instance (IsArithmetic v) => PseudoRing (ConstValue v) where
mul = LLVM.mul
class (PseudoRing a, Additive v) => PseudoModule a v where
scale :: a -> v -> CodeGenFunction r v
instance
(SoV.PseudoModule a v) =>
PseudoModule (Value a) (Value v) where
scale = SoV.scale
instance
(SoV.PseudoModule a v) =>
PseudoModule (ConstValue a) (ConstValue v) where
scale = SoV.scaleConst
class IntegerConstant a where
fromInteger' :: Integer -> a
instance SoV.IntegerConstant a => IntegerConstant (ConstValue a) where
fromInteger' = SoV.constFromInteger
instance SoV.IntegerConstant a => IntegerConstant (Value a) where
fromInteger' = value . SoV.constFromInteger
one :: (IntegerConstant a) => a
one = fromInteger' 1
_inc ::
(PseudoRing a, IntegerConstant a) =>
a -> CodeGenFunction r a
_inc x = add x one
_dec ::
(PseudoRing a, IntegerConstant a) =>
a -> CodeGenFunction r a
_dec x = sub x one
square ::
(PseudoRing a) =>
a -> CodeGenFunction r a
square x = mul x x
class (PseudoRing a) => Field a where
fdiv :: a -> a -> CodeGenFunction r a
instance (LLVM.IsFloating v) => Field (Value v) where
fdiv = LLVM.fdiv
instance (LLVM.IsFloating v) => Field (ConstValue v) where
fdiv = LLVM.fdiv
class (IntegerConstant a) => RationalConstant a where
fromRational' :: Rational -> a
instance SoV.RationalConstant a => RationalConstant (ConstValue a) where
fromRational' = SoV.constFromRational
instance SoV.RationalConstant a => RationalConstant (Value a) where
fromRational' = value . SoV.constFromRational
idiv ::
(IsInteger a) =>
Value a -> Value a -> CodeGenFunction r (Value a)
idiv = LLVM.idiv
irem ::
(IsInteger a) =>
Value a -> Value a -> CodeGenFunction r (Value a)
irem = LLVM.irem
class (Additive a) => Real a where
min :: a -> a -> CodeGenFunction r a
max :: a -> a -> CodeGenFunction r a
abs :: a -> CodeGenFunction r a
instance (SoV.Real a) => Real (Value a) where
min = SoV.min
max = SoV.max
abs = SoV.abs
class (Real a) => Fraction a where
truncate :: a -> CodeGenFunction r a
fraction :: a -> CodeGenFunction r a
instance (SoV.Fraction a) => Fraction (Value a) where
truncate = SoV.truncate
fraction = SoV.fraction
signedFraction ::
(Fraction a) =>
a -> CodeGenFunction r a
signedFraction x =
sub x =<< truncate x
addToPhase ::
(Fraction a) =>
a -> a -> CodeGenFunction r a
addToPhase d p =
fraction =<< add d p
incPhase ::
(Fraction a) =>
a -> a -> CodeGenFunction r a
incPhase d p =
signedFraction =<< add d p
valueTypeName ::
(IsType a) =>
Value a -> String
valueTypeName =
LLVM.typeName . (undefined :: Value a -> a)
callIntrinsic1 ::
(IsFirstClass a) =>
String -> Value a -> CodeGenFunction r (Value a)
callIntrinsic1 fn x = do
op <- LLVM.externFunction ("llvm." ++ fn ++ "." ++ valueTypeName x)
LLVM.call op x >>= addReadNone
callIntrinsic2 ::
(IsFirstClass a) =>
String -> Value a -> Value a -> CodeGenFunction r (Value a)
callIntrinsic2 fn x y = do
op <- LLVM.externFunction ("llvm." ++ fn ++ "." ++ valueTypeName x)
LLVM.call op x y >>= addReadNone
addReadNone :: Value a -> CodeGenFunction r (Value a)
addReadNone x = do
return x
class Field a => Algebraic a where
sqrt :: a -> CodeGenFunction r a
instance (IsFloating a) => Algebraic (Value a) where
sqrt = callIntrinsic1 "sqrt"
class Algebraic a => Transcendental a where
sin, cos, exp, log :: a -> CodeGenFunction r a
pow :: a -> a -> CodeGenFunction r a
instance (IsFloating a) => Transcendental (Value a) where
sin = callIntrinsic1 "sin"
cos = callIntrinsic1 "cos"
exp = callIntrinsic1 "exp"
log = callIntrinsic1 "log"
pow = callIntrinsic2 "pow"