{-# LANGUAGE UndecidableInstances, OverlappingInstances, OverloadedStrings #-}
module LambdaCube.Language where

import Data.Int
import Data.Word

import LambdaCube.Core.Type
import LambdaCube.Language.Type
import LambdaCube.Language.ReifyType
import LambdaCube.Language.PrimFun
import LambdaCube.Language.HOAS
{-
    all operatiors with @<>?,./\';""|:}{+_)0-=§±!@#$%^&*()_+
    <+> <+.> <.+>   -- good, conflict: <*>
    [+] [+.] [.+]   -- good, conflict with lists
    |+| |+.| |.+|   -- medium
    @+ @+. @.+      -- bad
    :+: :+.: :.+:   -- bad
    [*]
-}
{-
infixl 7  .*., ./., .%.
infixl 6  .+., .-.
infix  4  .==., ./=., .<., .<=., .>=., .>.

infixr 3  .&&.
infixr 2  .||.

infixl 8 .>>., .<<.
infixl 7 .&.
infixl 6 .^.
infixl 5 .|.
-}

infixl 7  @*, @/, @%
infixl 6  @+, @-
infix  4  @==, @/=, @<, @<=, @>=, @>

infixr 3  @&&
infixr 2  @||

infixl 8 @>>, @<<
infixl 7 @&
infixl 6 @^
infixl 5 @|

infix 7 @.      -- dot
infix 7 @#      -- cross
infixr 7 @*.    -- mulmv
infixl 7 @.*    -- mulvm
infixl 7 @.*.   -- mulmm

-- TODO: we should use template haskell or a preprocessor to generate the instances
class OperatorArithmetic a b where
    (@+) :: a -> b -> a
    (@-) :: a -> b -> a
    (@*) :: a -> b -> a

instance (GPU (V2 t), IsNumComponent t, IsMatVec (V2 t) c, IsNum c) => OperatorArithmetic (Exp stage (V2 t)) (Exp stage (V2 t)) where
    a @+ b = PrimApp PrimAdd $! tup2 (a,b)
    a @- b = PrimApp PrimSub $! tup2 (a,b)
    a @* b = PrimApp PrimMul $! tup2 (a,b)

instance (GPU (V3 t), IsNumComponent t, IsMatVec (V3 t) c, IsNum c) => OperatorArithmetic (Exp stage (V3 t)) (Exp stage (V3 t)) where
    a @+ b = PrimApp PrimAdd $! tup2 (a,b)
    a @- b = PrimApp PrimSub $! tup2 (a,b)
    a @* b = PrimApp PrimMul $! tup2 (a,b)

instance (GPU (V4 t), IsNumComponent t, IsMatVec (V4 t) c, IsNum c) => OperatorArithmetic (Exp stage (V4 t)) (Exp stage (V4 t)) where
    a @+ b = PrimApp PrimAdd $! tup2 (a,b)
    a @- b = PrimApp PrimSub $! tup2 (a,b)
    a @* b = PrimApp PrimMul $! tup2 (a,b)

instance (GPU c, GPU (V2 t), IsNumComponent t, IsMatVecScalar (V2 t) c, IsNum c) => OperatorArithmetic (Exp stage (V2 t)) (Exp stage c) where
    a @+ b = PrimApp PrimAddS $! tup2 (a,b)
    a @- b = PrimApp PrimSubS $! tup2 (a,b)
    a @* b = PrimApp PrimMulS $! tup2 (a,b)

instance (GPU c, GPU (V3 t), IsNumComponent t, IsMatVecScalar (V3 t) c, IsNum c) => OperatorArithmetic (Exp stage (V3 t)) (Exp stage c) where
    a @+ b = PrimApp PrimAddS $! tup2 (a,b)
    a @- b = PrimApp PrimSubS $! tup2 (a,b)
    a @* b = PrimApp PrimMulS $! tup2 (a,b)

instance (GPU c, GPU (V4 t), IsNumComponent t, IsMatVecScalar (V4 t) c, IsNum c) => OperatorArithmetic (Exp stage (V4 t)) (Exp stage c) where
    a @+ b = PrimApp PrimAddS $! tup2 (a,b)
    a @- b = PrimApp PrimSubS $! tup2 (a,b)
    a @* b = PrimApp PrimMulS $! tup2 (a,b)

instance (GPU a, GPU t, IsNum t, IsMatVecScalar a t) => OperatorArithmetic (Exp stage a) (Exp stage t) where
    a @+ b = PrimApp PrimAddS $! tup2 (a,b)
    a @- b = PrimApp PrimSubS $! tup2 (a,b)
    a @* b = PrimApp PrimMulS $! tup2 (a,b)

{-
instance (GPU a, IsNum t, IsMatVec a t) => OperatorArithmetic (Exp stage a) (Exp stage a) (Exp stage a) where
    a @+ b = PrimApp PrimAdd $! tup2 (a,b)
    a @- b = PrimApp PrimSub $! tup2 (a,b)
    a @* b = PrimApp PrimMul $! tup2 (a,b)

instance (GPU a, GPU t, IsNum t, IsMatVecScalar a t) => OperatorArithmetic (Exp stage a) (Exp stage t) (Exp stage a) where
    a @+ b = PrimApp PrimAddS $! tup2 (a,b)
    a @- b = PrimApp PrimSubS $! tup2 (a,b)
    a @* b = PrimApp PrimMulS $! tup2 (a,b)
-}
{-
instance OperatorArithmetic (Exp stage V4F) (Exp stage V4F) (Exp stage V4F) where
    a @+ b = PrimApp PrimAdd $! tup2 (a,b)
    a @- b = PrimApp PrimSub $! tup2 (a,b)
    a @* b = PrimApp PrimMul $! tup2 (a,b)

instance OperatorArithmetic (Exp stage V4F) (Exp stage Float) (Exp stage V4F) where
    a @+ b = PrimApp PrimAddS $! tup2 (a,b)
    a @- b = PrimApp PrimSubS $! tup2 (a,b)
    a @* b = PrimApp PrimMulS $! tup2 (a,b)
-}

-- FIXME: modulus % is defined only for integral types
class OperatorDivide a b where
    (@/) :: a -> b -> a
    (@%) :: a -> b -> a

instance (GPU a, IsNum t, IsVecScalar d a t) => OperatorDivide (Exp stage a) (Exp stage a) where
    a @/ b = PrimApp PrimDiv $! tup2 (a,b)
    a @% b = PrimApp PrimMod $! tup2 (a,b)

instance (GPU a, GPU t, IsNum t, IsVecScalar d a t) => OperatorDivide (Exp stage a) (Exp stage t) where
    a @/ b = PrimApp PrimDivS $! tup2 (a,b)
    a @% b = PrimApp PrimModS $! tup2 (a,b)

class OperatorBit a b where
    (@&) :: a -> b -> a
    (@|) :: a -> b -> a
    (@^) :: a -> b -> a

instance (GPU a, IsIntegral t, IsVecScalar d a t) => OperatorBit (Exp stage a) (Exp stage a) where
    a @& b = PrimApp PrimBAnd $! tup2 (a,b)
    a @| b = PrimApp PrimBOr  $! tup2 (a,b)
    a @^ b = PrimApp PrimBXor $! tup2 (a,b)

instance (GPU a, GPU t, IsIntegral t, IsVecScalar d a t) => OperatorBit (Exp stage a) (Exp stage t) where
    a @& b = PrimApp PrimBAndS $! tup2 (a,b)
    a @| b = PrimApp PrimBOrS  $! tup2 (a,b)
    a @^ b = PrimApp PrimBXorS $! tup2 (a,b)

class OperatorShift a b where
    (@>>) :: a -> b -> a
    (@<<) :: a -> b -> a

instance (GPU a, GPU b, IsIntegral t, IsVecScalar d a t, IsVecScalar d b Word32) => OperatorShift (Exp stage a) (Exp stage b) where
    a @>> b = PrimApp PrimBShiftR $! tup2 (a,b)
    a @<< b = PrimApp PrimBShiftL $! tup2 (a,b)

instance (GPU a, IsIntegral t, IsVecScalar d a t) => OperatorShift (Exp stage a) (Exp stage Word32) where
    a @>> b = PrimApp PrimBShiftRS $! tup2 (a,b)
    a @<< b = PrimApp PrimBShiftLS $! tup2 (a,b)

class OperatorEq a b where
    (@==) :: a -> a -> b
    (@/=) :: a -> a -> b

instance (GPU a, GPU b, IsNum t, IsVecScalar d a t, IsVecScalar d b Bool) => OperatorEq (Exp stage a) (Exp stage b) where
    a @== b = PrimApp PrimEqualV $! tup2 (a,b)
    a @/= b = PrimApp PrimNotEqualV $! tup2 (a,b)

instance (GPU a, IsMatVecScalar a t) => OperatorEq (Exp stage a) (Exp stage Bool) where
    a @== b = PrimApp PrimEqual $! tup2 (a,b)
    a @/= b = PrimApp PrimNotEqual $! tup2 (a,b)

class OperatorRelational a b where
    (@<=) :: a -> a -> b
    (@>=) :: a -> a -> b
    (@<)  :: a -> a -> b
    (@>)  :: a -> a -> b

instance (GPU a, GPU b, IsNum t, IsVecScalar d a t, IsVecScalar d b Bool) => OperatorRelational (Exp stage a) (Exp stage b) where
    a @<= b = PrimApp PrimLessThanEqual $! tup2 (a,b)
    a @>= b = PrimApp PrimGreaterThanEqual $! tup2 (a,b)
    a @< b  = PrimApp PrimLessThan $! tup2 (a,b)
    a @> b  = PrimApp PrimGreaterThan $! tup2 (a,b)

a @&& b = PrimApp PrimAnd $! tup2 (a,b)
a @|| b = PrimApp PrimOr $! tup2 (a,b)

xor'               a b = PrimApp PrimXor     $! tup2 (a,b)
not'                 a = PrimApp PrimNot     a
any'                 a = PrimApp PrimAny     a
all'                 a = PrimApp PrimAll     a

acos'                a = PrimApp PrimACos    a
acosh'               a = PrimApp PrimACosH   a
asin'                a = PrimApp PrimASin    a
asinh'               a = PrimApp PrimASinH   a
atan'                a = PrimApp PrimATan    a
atan2'             a b = PrimApp PrimATan2   $! tup2 (a,b)
atanh'               a = PrimApp PrimATanH   a
cos'                 a = PrimApp PrimCos     a
cosh'                a = PrimApp PrimCosH    a
degrees'             a = PrimApp PrimDegrees a
radians'             a = PrimApp PrimRadians a
sin'                 a = PrimApp PrimSin     a
sinh'                a = PrimApp PrimSinH    a
tan'                 a = PrimApp PrimTan     a
tanh'                a = PrimApp PrimTanH    a

pow'               a b = PrimApp PrimPow     $! tup2 (a,b)
exp'                 a = PrimApp PrimExp     a
log'                 a = PrimApp PrimLog     a
exp2'                a = PrimApp PrimExp2    a
log2'                a = PrimApp PrimLog2    a
sqrt'                a = PrimApp PrimSqrt    a
invsqrt'             a = PrimApp PrimInvSqrt a

isnan'               a = PrimApp PrimIsNan   a
isinf'               a = PrimApp PrimIsInf   a
abs'                 a = PrimApp PrimAbs     a
sign'                a = PrimApp PrimSign    a
floor'               a = PrimApp PrimFloor   a
trunc'               a = PrimApp PrimTrunc   a
round'               a = PrimApp PrimRound   a
roundEven'           a = PrimApp PrimRoundEven a
ceil'                a = PrimApp PrimCeil    a
fract'               a = PrimApp PrimFract   a

floatBitsToInt'      a = PrimApp PrimFloatBitsToInt  a
floatBitsToUint'     a = PrimApp PrimFloatBitsToUInt a
intBitsToFloat'      a = PrimApp PrimIntBitsToFloat  a
uintBitsToFloat'     a = PrimApp PrimUIntBitsToFloat a

length'              a = PrimApp PrimLength      a
distance'          a b = PrimApp PrimDistance    $! tup2 (a,b)
dot'               a b = PrimApp PrimDot         $! tup2 (a,b)
cross'             a b = PrimApp PrimCross       $! tup2 (a,b)
normalize'           a = PrimApp PrimNormalize   a
faceforward'     a b c = PrimApp PrimFaceForward $! tup3 (a,b,c)
reflect'           a b = PrimApp PrimReflect     $! tup2 (a,b)
refract'         a b c = PrimApp PrimRefract     $! tup3 (a,b,c)

transpose'           a = PrimApp PrimTranspose   a
determinant'         a = PrimApp PrimDeterminant a
inverse'             a = PrimApp PrimInverse     a
outerProduct'      a b = PrimApp PrimOuterProduct $! tup2 (a,b)

dFdx'                a = PrimApp PrimDFdx    a
dFdy'                a = PrimApp PrimDFdy    a
fwidth'              a = PrimApp PrimFWidth  a

noise1'              a = PrimApp PrimNoise1  a
noise2'              a = PrimApp PrimNoise2  a
noise3'              a = PrimApp PrimNoise3  a
noise4'              a = PrimApp PrimNoise4  a

textureSize'                    a b = PrimApp PrimTextureSize           $! tup2 (a,b)
texture'                        a b = PrimApp PrimTexture               $! tup2 (a,b)
textureB'                     a b c = PrimApp PrimTextureB              $! tup3 (a,b,c)
textureProj'                    a b = PrimApp PrimTextureProj           $! tup2 (a,b)
textureProjB'                 a b c = PrimApp PrimTextureProjB          $! tup3 (a,b,c)
textureLod'                   a b c = PrimApp PrimTextureLod            $! tup3 (a,b,c)
textureOffset'                a b c = PrimApp PrimTextureOffset         $! tup3 (a,b,c)
textureOffsetB'             a b c d = PrimApp PrimTextureOffsetB        $! tup4 (a,b,c,d)
texelFetch'                   a b c = PrimApp PrimTexelFetch            $! tup3 (a,b,c)
texelFetchOffset'           a b c d = PrimApp PrimTexelFetchOffset      $! tup4 (a,b,c,d)
textureProjOffset'            a b c = PrimApp PrimTextureProjOffset     $! tup3 (a,b,c)
textureProjOffsetB'         a b c d = PrimApp PrimTextureProjOffsetB    $! tup4 (a,b,c,d)
textureLodOffset'           a b c d = PrimApp PrimTextureLodOffset      $! tup4 (a,b,c,d)
textureProjLod'               a b c = PrimApp PrimTextureProjLod        $! tup3 (a,b,c)
textureProjLodOffset'       a b c d = PrimApp PrimTextureProjLodOffset  $! tup4 (a,b,c,d)
textureGrad'                a b c d = PrimApp PrimTextureGrad           $! tup4 (a,b,c,d)
textureGradOffset'        a b c d e = PrimApp PrimTextureGradOffset     $! tup5 (a,b,c,d,e)
textureProjGrad'            a b c d = PrimApp PrimTextureProjGrad       $! tup4 (a,b,c,d)
textureProjGradOffset'    a b c d e = PrimApp PrimTextureProjGradOffset $! tup5 (a,b,c,d,e)

class BuiltinCommon a b where
    min'     :: a -> b -> a
    max'     :: a -> b -> a
    clamp'   :: a -> b -> b -> a

instance (GPU a, IsNum t, IsVecScalar d a t) => BuiltinCommon (Exp stage a) (Exp stage a) where
    min'     a b = PrimApp PrimMin   $! tup2 (a,b)
    max'     a b = PrimApp PrimMax   $! tup2 (a,b)
    clamp' a b c = PrimApp PrimClamp $! tup3 (a,b,c)

instance (GPU a, GPU t, IsNum t, IsVecScalar d a t) => BuiltinCommon (Exp stage a) (Exp stage t) where
    min'     a b = PrimApp PrimMinS   $! tup2 (a,b)
    max'     a b = PrimApp PrimMaxS   $! tup2 (a,b)
    clamp' a b c = PrimApp PrimClampS $! tup3 (a,b,c)

class BuiltinMix a b where
    mix' :: a -> a -> b -> a

instance (GPU a, IsVecScalar d a Float) => BuiltinMix (Exp stage a) (Exp stage a) where
    mix' a b c = PrimApp PrimMix $! tup3 (a,b,c)

instance (GPU a, IsVecScalar d a Float) => BuiltinMix (Exp stage a) (Exp stage Float) where
    mix' a b c = PrimApp PrimMixS $! tup3 (a,b,c)

instance (GPU a, GPU b, IsVecScalar d a Float, IsVecScalar d b Bool) => BuiltinMix (Exp stage a) (Exp stage b) where
    mix' a b c = PrimApp PrimMixB $! tup3 (a,b,c)

class BuiltinStep a b where
    step'        :: b -> a -> a
    smoothstep'  :: b -> b -> a -> a

instance BuiltinStep (Exp stage V2F) (Exp stage V2F) where
    step'          a b = PrimApp PrimStep        $! tup2 (a,b)
    smoothstep'  a b c = PrimApp PrimSmoothStep  $! tup3 (a,b,c)

instance BuiltinStep (Exp stage V3F) (Exp stage V3F) where
    step'          a b = PrimApp PrimStep        $! tup2 (a,b)
    smoothstep'  a b c = PrimApp PrimSmoothStep  $! tup3 (a,b,c)

instance BuiltinStep (Exp stage V4F) (Exp stage V4F) where
    step'          a b = PrimApp PrimStep        $! tup2 (a,b)
    smoothstep'  a b c = PrimApp PrimSmoothStep  $! tup3 (a,b,c)

instance (GPU a, IsVecScalar d a Float) => BuiltinStep (Exp stage a) (Exp stage Float) where
    step'          a b = PrimApp PrimStepS       $! tup2 (a,b)
    smoothstep'  a b c = PrimApp PrimSmoothStepS $! tup3 (a,b,c)

a @. b = dot' a b
a @# b = cross' a b
a @*. b = PrimApp PrimMulMatVec $! tup2 (a,b)
a @.* b = PrimApp PrimMulVecMat $! tup2 (a,b)
a @.*. b = PrimApp PrimMulMatMat $! tup2 (a,b)

complement' a    = PrimApp PrimBNot a
neg'  a = PrimApp PrimNeg a
modf' a = PrimApp PrimModF a

{-
data PrimFun sig where

    -- Vec/Mat (de)construction
    PrimTupToV2             :: IsComponent a                            => PrimFun ((a,a)     -> V2 a)
    PrimTupToV3             :: IsComponent a                            => PrimFun ((a,a,a)   -> V3 a)
    PrimTupToV4             :: IsComponent a                            => PrimFun ((a,a,a,a) -> V4 a)
    PrimV2ToTup             :: IsComponent a                            => PrimFun (V2 a     -> (a,a))
    PrimV3ToTup             :: IsComponent a                            => PrimFun (V3 a   -> (a,a,a))
    PrimV4ToTup             :: IsComponent a                            => PrimFun (V4 a -> (a,a,a,a))
-}
--mkV2 a b = 
--mkV3 
--mkV4

class SpecialConstant a where
    zero'    :: a
    one'     :: a

instance SpecialConstant Bool where
    zero' = False
    one'  = True

instance SpecialConstant Int32 where
    zero' = 0
    one'  = 1

instance SpecialConstant Word32 where
    zero' = 0
    one'  = 1

instance SpecialConstant Float where
    zero' = 0
    one'  = 1

instance (SpecialConstant a) => SpecialConstant (V2 a) where
    zero' = V2 zero' zero'
    one'  = V2 one' one'

instance (SpecialConstant a) => SpecialConstant (V3 a) where
    zero' = V3 zero' zero' zero'
    one'  = V3 one' one' one'

instance (SpecialConstant a) => SpecialConstant (V4 a) where
    zero' = V4 zero' zero' zero' zero'
    one'  = V4 one' one' one' one'

class IdentityMatrix a where
    idmtx' :: a

instance IdentityMatrix M22F where
    idmtx' = V2 (V2 1 0) (V2 0 1)

instance IdentityMatrix M33F where
    idmtx' = V3 (V3 1 0 0) (V3 0 1 0) (V3 0 0 1)

instance IdentityMatrix M44F where
    idmtx' = V4 (V4 1 0 0 0) (V4 0 1 0 0) (V4 0 0 1 0) (V4 0 0 0 1)
{-
  TODO: 
    extendZero
    extendWith
    trim
-}

class PkgVec v where
    unpack' :: (GPU a, GPU (v a), IsComponent a)
            => Exp stage (v a) -> v (Exp stage a)

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

instance PkgVec V2 where
    unpack' v        = let (x,y) = untup2 $! PrimApp PrimV2ToTup v in V2 x y
    pack' (V2 x y)   = PrimApp PrimTupToV2 $! tup2 (x,y)

instance PkgVec V3 where
    unpack' v        = let (x,y,z) = untup3 $! PrimApp PrimV3ToTup v in V3 x y z
    pack' (V3 x y z) = PrimApp PrimTupToV3 $! tup3 (x,y,z)

instance PkgVec V4 where
    unpack' v          = let (x,y,z,w) = untup4 $! PrimApp PrimV4ToTup v in V4 x y z w
    pack' (V4 x y z w) = PrimApp PrimTupToV4 $! tup4 (x,y,z,w)

-- Smart constructor and destructors for tuples
--
tup0 :: Exp freq ()
tup0 = Tup NilTup

tup2 :: (GPU a, GPU b)
     => (Exp stage a, Exp stage b) -> Exp stage (a, b)
tup2 (x1, x2) = Tup (NilTup `SnocTup` x1 `SnocTup` x2)

tup3 :: (GPU a, GPU b, GPU c)
     => (Exp stage a, Exp stage b, Exp stage c) -> Exp stage (a, b, c)
tup3 (x1, x2, x3) = Tup (NilTup `SnocTup` x1 `SnocTup` x2 `SnocTup` x3)

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)
tup4 (x1, x2, x3, x4) = Tup (NilTup `SnocTup` x1 `SnocTup` x2 `SnocTup` x3 `SnocTup` x4)

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)
tup5 (x1, x2, x3, x4, x5) = Tup $! NilTup `SnocTup` x1 `SnocTup` x2 `SnocTup` x3 `SnocTup` x4 `SnocTup` x5

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)
tup6 (x1, x2, x3, x4, x5, x6) = Tup $! NilTup `SnocTup` x1 `SnocTup` x2 `SnocTup` x3 `SnocTup` x4 `SnocTup` x5 `SnocTup` x6

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)
tup7 (x1, x2, x3, x4, x5, x6, x7)
  = Tup $! NilTup `SnocTup` x1 `SnocTup` x2 `SnocTup` x3 `SnocTup` x4 `SnocTup` x5 `SnocTup` x6 `SnocTup` x7

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)
tup8 (x1, x2, x3, x4, x5, x6, x7, x8)
  = Tup $! NilTup `SnocTup` x1 `SnocTup` x2 `SnocTup` x3 `SnocTup` x4 `SnocTup` x5 `SnocTup` x6 `SnocTup` x7 `SnocTup` x8

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)
tup9 (x1, x2, x3, x4, x5, x6, x7, x8, x9)
  = Tup $! NilTup `SnocTup` x1 `SnocTup` x2 `SnocTup` x3 `SnocTup` x4 `SnocTup` x5 `SnocTup` x6 `SnocTup` x7 `SnocTup` x8 `SnocTup` x9

untup2 :: (GPU a, GPU b)
       => Exp stage (a, b) -> (Exp stage a, Exp stage b)
untup2 e = (tix1 `Prj` e, tix0 `Prj` e)

untup3 :: (GPU a, GPU b, GPU c)
       => Exp stage (a, b, c) -> (Exp stage a, Exp stage b, Exp stage c)
untup3 e = (tix2 `Prj` e, tix1 `Prj` e, tix0 `Prj` e)

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)
untup4 e = (tix3 `Prj` e, tix2 `Prj` e, tix1 `Prj` e, tix0 `Prj` e)

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)
untup5 e = (tix4 `Prj` e, tix3 `Prj` e, tix2 `Prj` e, tix1 `Prj` e, tix0 `Prj` e)

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)
untup6 e = (tix5 `Prj` e, tix4 `Prj` e, tix3 `Prj` e, tix2 `Prj` e, tix1 `Prj` e, tix0 `Prj` e)

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)
untup7 e = (tix6 `Prj` e, tix5 `Prj` e, tix4 `Prj` e, tix3 `Prj` e, tix2 `Prj` e, tix1 `Prj` e, tix0 `Prj` e)

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)
untup8 e = (tix7 `Prj` e, tix6 `Prj` e, tix5 `Prj` e, tix4 `Prj` e, tix3 `Prj` e, tix2 `Prj` e, tix1 `Prj` e, tix0 `Prj` e)

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)
untup9 e = (tix8 `Prj` e, tix7 `Prj` e, tix6 `Prj` e, tix5 `Prj` e, tix4 `Prj` e, tix3 `Prj` e, tix2 `Prj` e, tix1 `Prj` e, tix0 `Prj` e)

-- builtin variables
-- vertex shader
vertexID' :: Exp V Int32
vertexID' = PrimVar $ IInt "gl_VertexID"

instanceID' :: Exp V Int32
instanceID' = PrimVar $ IInt "gl_InstanceID"

-- geometry shader
primitiveIDIn' :: Exp G Int32
primitiveIDIn' = PrimVar $ IInt "gl_PrimitiveIDIn"

-- fragment shader
fragCoord' :: Exp F V4F
fragCoord' = PrimVar $ IV4F "gl_FragCoord"

frontFacing' :: Exp F Bool
frontFacing' = PrimVar $ IBool "gl_FrontFacing"

pointCoord' :: Exp F V2F
pointCoord' = PrimVar $ IV2F "gl_PointCoord"

primitiveID' :: Exp F Int32
primitiveID' = PrimVar $ IInt "gl_PrimitiveID"