lambdacube-edsl-0.2.0: LambdaCube 3D EDSL definition

Safe HaskellNone
LanguageHaskell2010

LambdaCube.Language

Documentation

class OperatorArithmetic a b where Source

Methods

(@+) :: a -> b -> a infixl 6 Source

(@-) :: a -> b -> a infixl 6 Source

(@*) :: a -> b -> a infixl 7 Source

Instances

(GPU a, GPU t, IsNum t, IsMatVecScalar * * a t) => OperatorArithmetic (Exp stage a) (Exp stage t) 
(GPU c, GPU (V4 t), IsNumComponent * t, IsMatVecScalar * * (V4 t) c, IsNum c) => OperatorArithmetic (Exp stage (V4 t)) (Exp stage c) 
(GPU c, GPU (V3 t), IsNumComponent * t, IsMatVecScalar * * (V3 t) c, IsNum c) => OperatorArithmetic (Exp stage (V3 t)) (Exp stage c) 
(GPU c, GPU (V2 t), IsNumComponent * t, IsMatVecScalar * * (V2 t) c, IsNum c) => OperatorArithmetic (Exp stage (V2 t)) (Exp stage c) 
(GPU (V4 t), IsNumComponent * t, IsMatVec * * (V4 t) c, IsNum c) => OperatorArithmetic (Exp stage (V4 t)) (Exp stage (V4 t)) 
(GPU (V3 t), IsNumComponent * t, IsMatVec * * (V3 t) c, IsNum c) => OperatorArithmetic (Exp stage (V3 t)) (Exp stage (V3 t)) 
(GPU (V2 t), IsNumComponent * t, IsMatVec * * (V2 t) c, IsNum c) => OperatorArithmetic (Exp stage (V2 t)) (Exp stage (V2 t)) 

class OperatorDivide a b where Source

Methods

(@/) :: a -> b -> a infixl 7 Source

(@%) :: a -> b -> a infixl 7 Source

Instances

(GPU a, GPU t, IsNum t, IsVecScalar * * d a t) => OperatorDivide (Exp stage a) (Exp stage t) 
(GPU a, IsNum t, IsVecScalar * * d a t) => OperatorDivide (Exp stage a) (Exp stage a) 

class OperatorBit a b where Source

Methods

(@&) :: a -> b -> a infixl 7 Source

(@|) :: a -> b -> a infixl 5 Source

(@^) :: a -> b -> a infixl 6 Source

Instances

(GPU a, GPU t, IsIntegral * t, IsVecScalar * * d a t) => OperatorBit (Exp stage a) (Exp stage t) 
(GPU a, IsIntegral k t, IsVecScalar * k d a t) => OperatorBit (Exp stage a) (Exp stage a) 

class OperatorShift a b where Source

Methods

(@>>) :: a -> b -> a infixl 8 Source

(@<<) :: a -> b -> a infixl 8 Source

Instances

(GPU a, IsIntegral k t, IsVecScalar * k d a t) => OperatorShift (Exp stage a) (Exp stage Word32) 
(GPU a, GPU b, IsIntegral k t, IsVecScalar * k d a t, IsVecScalar * * d b Word32) => OperatorShift (Exp stage a) (Exp stage b) 

class OperatorEq a b where Source

Methods

(@==) :: a -> a -> b infix 4 Source

(@/=) :: a -> a -> b infix 4 Source

Instances

(GPU a, IsMatVecScalar * k a t) => OperatorEq (Exp stage a) (Exp stage Bool) 
(GPU a, GPU b, IsNum t, IsVecScalar * * d a t, IsVecScalar * * d b Bool) => OperatorEq (Exp stage a) (Exp stage b) 

class OperatorRelational a b where Source

Methods

(@<=) :: a -> a -> b infix 4 Source

(@>=) :: a -> a -> b infix 4 Source

(@<) :: a -> a -> b infix 4 Source

(@>) :: a -> a -> b infix 4 Source

Instances

(GPU a, GPU b, IsNum t, IsVecScalar * * d a t, IsVecScalar * * d b Bool) => OperatorRelational (Exp stage a) (Exp stage b) 

(@&&) :: Exp stage Bool -> Exp stage Bool -> Exp stage Bool infixr 3 Source

(@||) :: Exp stage Bool -> Exp stage Bool -> Exp stage Bool infixr 2 Source

xor' :: Exp stage Bool -> Exp stage Bool -> Exp stage Bool Source

not' :: (IsVecScalar * * d r Bool, GPU r) => Exp stage r -> Exp stage r Source

any' :: (IsVecScalar * * d a Bool, GPU a) => Exp stage a -> Exp stage Bool Source

all' :: (IsVecScalar * * d a Bool, GPU a) => Exp stage a -> Exp stage Bool Source

acos' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

acosh' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

asin' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

asinh' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

atan' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

atan2' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r -> Exp stage r Source

atanh' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

cos' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

cosh' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

degrees' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

radians' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

sin' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

sinh' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

tan' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

tanh' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

pow' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r -> Exp stage r Source

exp' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

log' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

exp2' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

log2' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

sqrt' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

invsqrt' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

isnan' :: (IsVecScalar * * d a Float, IsVecScalar * * d r Bool, GPU a, GPU r) => Exp stage a -> Exp stage r Source

isinf' :: (IsVecScalar * * d a Float, IsVecScalar * * d r Bool, GPU a, GPU r) => Exp stage a -> Exp stage r Source

abs' :: (IsVecScalar * k d r t, IsSigned k t, GPU r) => Exp stage r -> Exp stage r Source

sign' :: (IsVecScalar * k d r t, IsSigned k t, GPU r) => Exp stage r -> Exp stage r Source

floor' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

trunc' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

round' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

roundEven' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

ceil' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

fract' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

floatBitsToInt' :: (IsVecScalar * * d a Float, IsVecScalar * * d r Int32, GPU a, GPU r) => Exp stage a -> Exp stage r Source

floatBitsToUint' :: (IsVecScalar * * d a Float, IsVecScalar * * d r Word32, GPU a, GPU r) => Exp stage a -> Exp stage r Source

intBitsToFloat' :: (IsVecScalar * * d a Int32, IsVecScalar * * d r Float, GPU a, GPU r) => Exp stage a -> Exp stage r Source

uintBitsToFloat' :: (IsVecScalar * * d a Word32, IsVecScalar * * d r Float, GPU a, GPU r) => Exp stage a -> Exp stage r Source

length' :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage Float Source

distance' :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage a -> Exp stage Float Source

dot' :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage a -> Exp stage Float Source

cross' :: Exp stage (V3 Float) -> Exp stage (V3 Float) -> Exp stage (V3 Float) Source

normalize' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r Source

faceforward' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r -> Exp stage r -> Exp stage r Source

reflect' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r -> Exp stage r Source

refract' :: (IsVecScalar * * d r Float, GPU r) => Exp stage r -> Exp stage r -> Exp stage r -> Exp stage r Source

transpose' :: (IsMat * k1 k a h w, IsMat * k k1 r w h, GPU a, GPU r) => Exp stage a -> Exp stage r Source

determinant' :: (IsMat * k k a s s, GPU a) => Exp stage a -> Exp stage Float Source

inverse' :: (IsMat * k k1 r h w, GPU r) => Exp stage r -> Exp stage r Source

outerProduct' :: (IsMat * * * r h w, GPU w, GPU h, GPU r) => Exp stage w -> Exp stage h -> Exp stage r Source

dFdx' :: (IsVecScalar * * d r Float, GPU r) => Exp F r -> Exp F r Source

dFdy' :: (IsVecScalar * * d r Float, GPU r) => Exp F r -> Exp F r Source

fwidth' :: (IsVecScalar * * d r Float, GPU r) => Exp F r -> Exp F r Source

noise1' :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage Float Source

noise2' :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage (V2 Float) Source

noise3' :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage (V3 Float) Source

noise4' :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage (V4 Float) Source

textureSize' :: (IsTextureSize * * * sampler lod r, GPU lod, GPU sampler, GPU r) => Exp stage sampler -> Exp stage lod -> Exp stage r Source

texture' :: (IsTexture * * k sampler coord bias, GPU (TexelRepr sampler), GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage (TexelRepr sampler) Source

textureB' :: (IsTexture * * * sampler coord bias, GPU (TexelRepr sampler), GPU bias, GPU coord, GPU sampler) => Exp F sampler -> Exp F coord -> Exp F bias -> Exp F (TexelRepr sampler) Source

textureProj' :: (IsTextureProj * * k sampler coord bias, GPU (TexelRepr sampler), GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage (TexelRepr sampler) Source

textureProjB' :: (IsTextureProj * * * sampler coord bias, GPU (TexelRepr sampler), GPU bias, GPU coord, GPU sampler) => Exp F sampler -> Exp F coord -> Exp F bias -> Exp F (TexelRepr sampler) Source

textureLod' :: (IsTextureLod * * * sampler coord lod, GPU (TexelRepr sampler), GPU lod, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage lod -> Exp stage (TexelRepr sampler) Source

textureOffset' :: (IsTextureOffset * * * k sampler coord offset bias, GPU (TexelRepr sampler), GPU offset, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage offset -> Exp stage (TexelRepr sampler) Source

textureOffsetB' :: (IsTextureOffset * * * * sampler coord offset bias, GPU (TexelRepr sampler), GPU bias, GPU offset, GPU coord, GPU sampler) => Exp F sampler -> Exp F coord -> Exp F offset -> Exp F bias -> Exp F (TexelRepr sampler) Source

texelFetch' :: (IsTexelFetch * * * sampler coord lod, GPU (TexelRepr sampler), GPU lod, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage lod -> Exp stage (TexelRepr sampler) Source

texelFetchOffset' :: (IsTexelFetchOffset * * * * sampler coord lod offset, GPU (TexelRepr sampler), GPU offset, GPU lod, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage lod -> Exp stage offset -> Exp stage (TexelRepr sampler) Source

textureProjOffset' :: (IsTextureProjOffset * * * k sampler coord offset bias, GPU (TexelRepr sampler), GPU offset, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage offset -> Exp stage (TexelRepr sampler) Source

textureProjOffsetB' :: (IsTextureProjOffset * * * * sampler coord offset bias, GPU (TexelRepr sampler), GPU bias, GPU offset, GPU coord, GPU sampler) => Exp F sampler -> Exp F coord -> Exp F offset -> Exp F bias -> Exp F (TexelRepr sampler) Source

textureLodOffset' :: (IsTextureLodOffset * * * * sampler coord lod offset, GPU (TexelRepr sampler), GPU offset, GPU lod, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage lod -> Exp stage offset -> Exp stage (TexelRepr sampler) Source

textureProjLod' :: (IsTextureProjLod * * * sampler coord lod, GPU (TexelRepr sampler), GPU lod, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage lod -> Exp stage (TexelRepr sampler) Source

textureProjLodOffset' :: (IsTextureProjLodOffset * * * * sampler coord lod offset, GPU (TexelRepr sampler), GPU offset, GPU lod, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage lod -> Exp stage offset -> Exp stage (TexelRepr sampler) Source

textureGrad' :: (IsTextureGrad * * * * sampler coord dx dy, GPU (TexelRepr sampler), GPU dy, GPU dx, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage dx -> Exp stage dy -> Exp stage (TexelRepr sampler) Source

textureGradOffset' :: (IsTextureGradOffset * * * * * sampler coord dx dy offset, GPU (TexelRepr sampler), GPU offset, GPU dy, GPU dx, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage dx -> Exp stage dy -> Exp stage offset -> Exp stage (TexelRepr sampler) Source

textureProjGrad' :: (IsTextureProjGrad * * * * sampler coord dx dy, GPU (TexelRepr sampler), GPU dy, GPU dx, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage dx -> Exp stage dy -> Exp stage (TexelRepr sampler) Source

textureProjGradOffset' :: (IsTextureProjGradOffset * * * * * sampler coord dx dy offset, GPU (TexelRepr sampler), GPU offset, GPU dy, GPU dx, GPU coord, GPU sampler) => Exp stage sampler -> Exp stage coord -> Exp stage dx -> Exp stage dy -> Exp stage offset -> Exp stage (TexelRepr sampler) Source

class BuiltinCommon a b where Source

Methods

min' :: a -> b -> a Source

max' :: a -> b -> a Source

clamp' :: a -> b -> b -> a Source

Instances

(GPU a, GPU t, IsNum t, IsVecScalar * * d a t) => BuiltinCommon (Exp stage a) (Exp stage t) 
(GPU a, IsNum t, IsVecScalar * * d a t) => BuiltinCommon (Exp stage a) (Exp stage a) 

class BuiltinMix a b where Source

Methods

mix' :: a -> a -> b -> a Source

Instances

(GPU a, GPU b, IsVecScalar * * d a Float, IsVecScalar * * d b Bool) => BuiltinMix (Exp stage a) (Exp stage b) 
(GPU a, IsVecScalar * * d a Float) => BuiltinMix (Exp stage a) (Exp stage Float) 
(GPU a, IsVecScalar * * d a Float) => BuiltinMix (Exp stage a) (Exp stage a) 

class BuiltinStep a b where Source

Methods

step' :: b -> a -> a Source

smoothstep' :: b -> b -> a -> a Source

Instances

(GPU a, IsVecScalar * * d a Float) => BuiltinStep (Exp stage a) (Exp stage Float) 
BuiltinStep (Exp stage V4F) (Exp stage V4F) 
BuiltinStep (Exp stage V3F) (Exp stage V3F) 
BuiltinStep (Exp stage V2F) (Exp stage V2F) 

(@.) :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage a -> Exp stage Float infix 7 Source

(@#) :: Exp stage (V3 Float) -> Exp stage (V3 Float) -> Exp stage (V3 Float) infix 7 Source

(@*.) :: (IsMat * * * m r w, GPU w, GPU m, GPU r) => Exp stage m -> Exp stage w -> Exp stage r infixr 7 Source

(@.*) :: (IsMat * * * m h r, GPU h, GPU m, GPU r) => Exp stage h -> Exp stage m -> Exp stage r infixl 7 Source

(@.*.) :: (IsMat * k1 k2 r i k3, IsMat * k1 k a i j, IsMat * k k2 b j k3, GPU b, GPU a, GPU r) => Exp stage a -> Exp stage b -> Exp stage r infixl 7 Source

complement' :: (IsVecScalar * k d r t, IsIntegral k t, GPU r) => Exp stage r -> Exp stage r Source

neg' :: (IsMatVecScalar * k r t, IsSigned k t, GPU r) => Exp stage r -> Exp stage r Source

modf' :: (IsVecScalar * * d a Float, GPU a) => Exp stage a -> Exp stage (a, a) Source

class PkgVec v where Source

Methods

unpack' :: (GPU a, GPU (v a), IsComponent a) => Exp stage (v a) -> v (Exp stage a) Source

pack' :: (GPU a, GPU (v a), IsComponent a) => v (Exp stage a) -> Exp stage (v a) Source

Instances

tup0 :: Exp freq () Source

tup2 :: (GPU a, GPU b) => (Exp stage a, Exp stage b) -> Exp stage (a, b) Source

tup3 :: (GPU a, GPU b, GPU c) => (Exp stage a, Exp stage b, Exp stage c) -> Exp stage (a, b, c) Source

tup4 :: (GPU a, GPU b, GPU c, GPU d) => (Exp stage a, Exp stage b, Exp stage c, Exp stage d) -> Exp stage (a, b, c, d) Source

tup5 :: (GPU a, GPU b, GPU c, GPU d, GPU e) => (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e) -> Exp stage (a, b, c, d, e) Source

tup6 :: (GPU a, GPU b, GPU c, GPU d, GPU e, GPU f) => (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e, Exp stage f) -> Exp stage (a, b, c, d, e, f) Source

tup7 :: (GPU a, GPU b, GPU c, GPU d, GPU e, GPU f, GPU g) => (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e, Exp stage f, Exp stage g) -> Exp stage (a, b, c, d, e, f, g) Source

tup8 :: (GPU a, GPU b, GPU c, GPU d, GPU e, GPU f, GPU g, GPU h) => (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e, Exp stage f, Exp stage g, Exp stage h) -> Exp stage (a, b, c, d, e, f, g, h) Source

tup9 :: (GPU a, GPU b, GPU c, GPU d, GPU e, GPU f, GPU g, GPU h, GPU i) => (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e, Exp stage f, Exp stage g, Exp stage h, Exp stage i) -> Exp stage (a, b, c, d, e, f, g, h, i) Source

untup2 :: (GPU a, GPU b) => Exp stage (a, b) -> (Exp stage a, Exp stage b) Source

untup3 :: (GPU a, GPU b, GPU c) => Exp stage (a, b, c) -> (Exp stage a, Exp stage b, Exp stage c) Source

untup4 :: (GPU a, GPU b, GPU c, GPU d) => Exp stage (a, b, c, d) -> (Exp stage a, Exp stage b, Exp stage c, Exp stage d) Source

untup5 :: (GPU a, GPU b, GPU c, GPU d, GPU e) => Exp stage (a, b, c, d, e) -> (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e) Source

untup6 :: (GPU a, GPU b, GPU c, GPU d, GPU e, GPU f) => Exp stage (a, b, c, d, e, f) -> (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e, Exp stage f) Source

untup7 :: (GPU a, GPU b, GPU c, GPU d, GPU e, GPU f, GPU g) => Exp stage (a, b, c, d, e, f, g) -> (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e, Exp stage f, Exp stage g) Source

untup8 :: (GPU a, GPU b, GPU c, GPU d, GPU e, GPU f, GPU g, GPU h) => Exp stage (a, b, c, d, e, f, g, h) -> (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e, Exp stage f, Exp stage g, Exp stage h) Source

untup9 :: (GPU a, GPU b, GPU c, GPU d, GPU e, GPU f, GPU g, GPU h, GPU i) => Exp stage (a, b, c, d, e, f, g, h, i) -> (Exp stage a, Exp stage b, Exp stage c, Exp stage d, Exp stage e, Exp stage f, Exp stage g, Exp stage h, Exp stage i) Source