lambdacube-core-0.1.0: LambdaCube 3D is a domain specific language and library that makes it possible to program GPUs in a purely functional style.

Safe HaskellNone

LC_T_Language

Documentation

class OperatorArithmetic a b whereSource

Methods

(@+) :: a -> b -> aSource

(@-) :: a -> b -> aSource

(@*) :: a -> b -> aSource

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 whereSource

Methods

(@/) :: a -> b -> aSource

(@%) :: a -> b -> aSource

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 whereSource

Methods

(@&) :: a -> b -> aSource

(@|) :: a -> b -> aSource

(@^) :: a -> b -> aSource

Instances

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

class OperatorShift a b whereSource

Methods

(@>>) :: a -> b -> aSource

(@<<) :: a -> b -> aSource

Instances

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

class OperatorEq a b whereSource

Methods

(@==) :: a -> a -> bSource

(@/=) :: a -> a -> bSource

Instances

(GPU a, IsMatVecScalar 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 whereSource

Methods

(@<=) :: a -> a -> bSource

(@>=) :: a -> a -> bSource

(@<) :: a -> a -> bSource

(@>) :: a -> a -> bSource

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 BoolSource

(@||) :: Exp stage Bool -> Exp stage Bool -> Exp stage BoolSource

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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 rSource

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

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

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

transpose' :: (IsMat a h w, IsMat r w h, GPU a, GPU r) => Exp stage a -> Exp stage rSource

determinant' :: (IsMat a s s, GPU a) => Exp stage a -> Exp stage FloatSource

inverse' :: (IsMat r h w, GPU r) => Exp stage r -> Exp stage rSource

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

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

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

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

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

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' :: (GPU sampler, GPU lod, GPU r, IsTextureSize sampler lod r) => Exp stage sampler -> Exp stage lod -> Exp stage rSource

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

class BuiltinCommon a b whereSource

Methods

min' :: a -> b -> aSource

max' :: a -> b -> aSource

clamp' :: a -> b -> b -> aSource

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 whereSource

Methods

mix' :: a -> a -> b -> aSource

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 whereSource

Methods

step' :: b -> a -> aSource

smoothstep' :: b -> b -> a -> aSource

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 FloatSource

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

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

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

(@.*.) :: (IsMat a i j, IsMat b j k, IsMat r i k, GPU a, GPU b, GPU r) => Exp stage a -> Exp stage b -> Exp stage rSource

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

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

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

class PkgVec v whereSource

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