Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell98 |
Wrap LLVM code for arithmetic computations.
Similar to LLVM.DSL.Expression but not based on MultiValue
but on LLVM.Extra.Arithmetic methods.
Detects sharing using a Vault
.
Synopsis
- data T a
- decons :: T a -> forall r. CodeGenFunction r a
- tau :: (Transcendental a, RationalConstant a) => T a
- square :: PseudoRing a => T a -> T a
- sqrt :: Algebraic a => T a -> T a
- max :: Real a => T a -> T a -> T a
- min :: Real a => T a -> T a -> T a
- limit :: Real a => (T a, T a) -> T a -> T a
- fraction :: Fraction a => T a -> T a
- (%==) :: CmpRet a => T (Value a) -> T (Value a) -> T (Value (CmpResult a))
- (%/=) :: CmpRet a => T (Value a) -> T (Value a) -> T (Value (CmpResult a))
- (%<) :: CmpRet a => T (Value a) -> T (Value a) -> T (Value (CmpResult a))
- (%<=) :: CmpRet a => T (Value a) -> T (Value a) -> T (Value (CmpResult a))
- (%>) :: CmpRet a => T (Value a) -> T (Value a) -> T (Value (CmpResult a))
- (%>=) :: CmpRet a => T (Value a) -> T (Value a) -> T (Value (CmpResult a))
- not :: T (Value Bool) -> T (Value Bool)
- (%&&) :: T (Value Bool) -> T (Value Bool) -> T (Value Bool)
- (%||) :: T (Value Bool) -> T (Value Bool) -> T (Value Bool)
- (?) :: (Flatten value, Registers value ~ a, Phi a) => T (Value Bool) -> (value, value) -> value
- (??) :: (IsFirstClass a, CmpRet a) => T (Value (CmpResult a)) -> (T (Value a), T (Value a)) -> T (Value a)
- lift0 :: (forall r. CodeGenFunction r a) -> T a
- lift1 :: (forall r. a -> CodeGenFunction r b) -> T a -> T b
- lift2 :: (forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
- lift3 :: (forall r. a -> b -> c -> CodeGenFunction r d) -> T a -> T b -> T c -> T d
- unlift0 :: Flatten value => value -> forall r. CodeGenFunction r (Registers value)
- unlift1 :: Flatten value => (T a -> value) -> forall r. a -> CodeGenFunction r (Registers value)
- unlift2 :: Flatten value => (T a -> T b -> value) -> forall r. a -> b -> CodeGenFunction r (Registers value)
- unlift3 :: Flatten value => (T a -> T b -> T c -> value) -> forall r. a -> b -> c -> CodeGenFunction r (Registers value)
- unlift4 :: Flatten value => (T a -> T b -> T c -> T d -> value) -> forall r. a -> b -> c -> d -> CodeGenFunction r (Registers value)
- unlift5 :: Flatten value => (T a -> T b -> T c -> T d -> T e -> value) -> forall r. a -> b -> c -> d -> e -> CodeGenFunction r (Registers value)
- constantValue :: a -> T a
- constant :: IsConst a => a -> T (Value a)
- fromInteger' :: IntegerConstant a => Integer -> T a
- fromRational' :: RationalConstant a => Rational -> T a
- class Flatten value where
- flattenCode :: value -> Compute r (Registers value)
- unfoldCode :: T (Registers value) -> value
- type family Registers value
- flatten :: Flatten value => value -> CodeGenFunction r (Registers value)
- unfold :: Flatten value => Registers value -> value
- flattenCodeTraversable :: (Flatten value, Traversable f) => f value -> Compute r (f (Registers value))
- unfoldCodeTraversable :: (Flatten value, Traversable f, Applicative f) => T (f (Registers value)) -> f value
- flattenFunction :: (Flatten a, Flatten b) => (a -> b) -> Registers a -> CodeGenFunction r (Registers b)
Documentation
Instances
decons :: T a -> forall r. CodeGenFunction r a Source #
tau :: (Transcendental a, RationalConstant a) => T a Source #
sqrt :: Algebraic a => T a -> T a Source #
The same as sqrt
,
but needs only Algebraic constraint, not Transcendental.
(?) :: (Flatten value, Registers value ~ a, Phi a) => T (Value Bool) -> (value, value) -> value infix 0 Source #
true ? (t,f)
evaluates t
,
false ? (t,f)
evaluates f
.
t
and f
can reuse interim results,
but they cannot contribute shared results,
since only one of them will be run.
Cf. (??)
(??) :: (IsFirstClass a, CmpRet a) => T (Value (CmpResult a)) -> (T (Value a), T (Value a)) -> T (Value a) infix 0 Source #
The expression c ?? (t,f)
evaluates both t
and f
and selects components from t
and f
according to c
.
It is useful for vector values and
for sharing t
or f
with other branches of an expression.
lift0 :: (forall r. CodeGenFunction r a) -> T a Source #
unlift1 :: Flatten value => (T a -> value) -> forall r. a -> CodeGenFunction r (Registers value) Source #
unlift2 :: Flatten value => (T a -> T b -> value) -> forall r. a -> b -> CodeGenFunction r (Registers value) Source #
unlift3 :: Flatten value => (T a -> T b -> T c -> value) -> forall r. a -> b -> c -> CodeGenFunction r (Registers value) Source #
unlift4 :: Flatten value => (T a -> T b -> T c -> T d -> value) -> forall r. a -> b -> c -> d -> CodeGenFunction r (Registers value) Source #
unlift5 :: Flatten value => (T a -> T b -> T c -> T d -> T e -> value) -> forall r. a -> b -> c -> d -> e -> CodeGenFunction r (Registers value) Source #
constantValue :: a -> T a Source #
fromInteger' :: IntegerConstant a => Integer -> T a Source #
fromRational' :: RationalConstant a => Rational -> T a Source #
class Flatten value where Source #
flattenCode :: value -> Compute r (Registers value) Source #
unfoldCode :: T (Registers value) -> value Source #
Instances
Flatten () Source # | |
Defined in LLVM.DSL.Value flattenCode :: () -> Compute r (Registers ()) Source # unfoldCode :: T (Registers ()) -> () Source # | |
Flatten (T a) Source # | |
Flatten a => Flatten (T a) Source # | |
(Flatten a, Flatten b) => Flatten (a, b) Source # | |
Defined in LLVM.DSL.Value flattenCode :: (a, b) -> Compute r (Registers (a, b)) Source # unfoldCode :: T (Registers (a, b)) -> (a, b) Source # | |
(Flatten a, Flatten b, Flatten c) => Flatten (a, b, c) Source # | |
Defined in LLVM.DSL.Value flattenCode :: (a, b, c) -> Compute r (Registers (a, b, c)) Source # unfoldCode :: T (Registers (a, b, c)) -> (a, b, c) Source # |
type family Registers value Source #
Instances
type Registers () Source # | |
Defined in LLVM.DSL.Value type Registers () = () | |
type Registers (T a) Source # | |
Defined in LLVM.DSL.Value | |
type Registers (T a) Source # | |
Defined in LLVM.DSL.Value | |
type Registers (a, b) Source # | |
Defined in LLVM.DSL.Value | |
type Registers (a, b, c) Source # | |
Defined in LLVM.DSL.Value |
flattenCodeTraversable :: (Flatten value, Traversable f) => f value -> Compute r (f (Registers value)) Source #
unfoldCodeTraversable :: (Flatten value, Traversable f, Applicative f) => T (f (Registers value)) -> f value Source #
flattenFunction :: (Flatten a, Flatten b) => (a -> b) -> Registers a -> CodeGenFunction r (Registers b) Source #