{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeAbstractions #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Mischief.Shader.Internal.State where

import Control.Monad.State
import Data.Data hiding (cast)
import Data.Map (Map)
import Data.Singletons (SingI, demote)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.TypeLits (Nat, type (+))
import Mischief.Shader.Internal.Singletons
import Unsafe.Coerce (unsafeCoerce)
import Prelude hiding (cos, sin)

data ErasedValue where
  ErasedValue :: a -> ErasedValue

data ShaderState = ShaderState
  { ShaderState -> VarIndex
counter :: VarIndex,
    ShaderState -> Stmt
ast :: Stmt,
    ShaderState -> Map TypeRep ErasedValue
dict :: Map TypeRep ErasedValue
  }

newtype VarIndex = VarIndex Integer
  deriving newtype (Int -> VarIndex -> ShowS
[VarIndex] -> ShowS
VarIndex -> String
(Int -> VarIndex -> ShowS)
-> (VarIndex -> String) -> ([VarIndex] -> ShowS) -> Show VarIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarIndex -> ShowS
showsPrec :: Int -> VarIndex -> ShowS
$cshow :: VarIndex -> String
show :: VarIndex -> String
$cshowList :: [VarIndex] -> ShowS
showList :: [VarIndex] -> ShowS
Show, Integer -> VarIndex
VarIndex -> VarIndex
VarIndex -> VarIndex -> VarIndex
(VarIndex -> VarIndex -> VarIndex)
-> (VarIndex -> VarIndex -> VarIndex)
-> (VarIndex -> VarIndex -> VarIndex)
-> (VarIndex -> VarIndex)
-> (VarIndex -> VarIndex)
-> (VarIndex -> VarIndex)
-> (Integer -> VarIndex)
-> Num VarIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: VarIndex -> VarIndex -> VarIndex
+ :: VarIndex -> VarIndex -> VarIndex
$c- :: VarIndex -> VarIndex -> VarIndex
- :: VarIndex -> VarIndex -> VarIndex
$c* :: VarIndex -> VarIndex -> VarIndex
* :: VarIndex -> VarIndex -> VarIndex
$cnegate :: VarIndex -> VarIndex
negate :: VarIndex -> VarIndex
$cabs :: VarIndex -> VarIndex
abs :: VarIndex -> VarIndex
$csignum :: VarIndex -> VarIndex
signum :: VarIndex -> VarIndex
$cfromInteger :: Integer -> VarIndex
fromInteger :: Integer -> VarIndex
Num)

nameIndex :: VarIndex -> Text
nameIndex :: VarIndex -> Text
nameIndex VarIndex
i = Text
"v" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (VarIndex -> String
forall a. Show a => a -> String
show VarIndex
i)

data Stmt where
  Concat :: Stmt -> Stmt -> Stmt
  Let :: VarIndex -> Expr a -> Stmt
  Return :: Expr a -> Stmt
  Debug :: Text -> Stmt
  Empty :: Stmt

data CustomType a = CustomType

instance Eq (CustomType a) where
  CustomType a
_ == :: CustomType a -> CustomType a -> Bool
== CustomType a
_ = Bool
False

data Expr (a :: Types) where
  Function :: Text -> [Param] -> Expr a
  Add :: (SingI a) => Expr a -> Expr a -> Expr a
  Sub :: (SingI a) => Expr a -> Expr a -> Expr a
  Mult :: (SingI a) => Expr a -> Expr a -> Expr a
  Div :: (SingI a) => Expr a -> Expr a -> Expr a
  Neg :: (SingI a) => Expr a -> Expr a
  Abs :: (SingI a) => Expr a -> Expr a
  Signum :: (SingI a) => Expr a -> Expr a
  Cast :: (SingI a, SingI b) => Proxy b -> Expr a -> Expr b
  CastVec :: (SingI (VectorType n a), SingI (VectorType n b)) => Proxy (VectorType n b) -> Expr (VectorType n a) -> Expr (VectorType n b)
  ConstantInt :: Int -> Expr (Primitive TInt)
  ConstantFloat :: Float -> Expr (Primitive TFloat)
  ConstantUInt :: Int -> Expr (Primitive TUInt)
  ConstantArray :: forall (a' :: Types). (SingI a') => (Proxy a') -> [Expr a'] -> Expr (ArrayType a')
  ConstantVec :: forall (n :: Nat) (a' :: PrimitiveTypes). (PrintVecElements n a', SingI (VectorType n a')) => Proxy (VectorType n a') -> VecInit n a' -> Expr (VectorType n a')
  ConstantMat :: forall (n :: Nat) (m :: Nat). (PrintMatElements n m, SingI (MatrixType n m)) => Proxy (MatrixType n m) -> MatInit n m -> Expr (MatrixType n m)
  AccessField :: (SingI a) => Expr a -> Text -> Expr b
  Index :: (SingI (ArrayType a)) => Expr (ArrayType a) -> Expr (Primitive TUInt) -> Expr a
  Var :: (SingI a) => VarIndex -> Expr a
  BindingVar :: (SingI a) => Integer -> Expr a
  BuiltInVar :: (SingI a) => Text -> Expr a
  StructInit :: Text -> [Text] -> Expr a
  LocationVar :: (SingI a) => Integer -> Expr a
  VarCustom :: Text -> Expr a
  CustomOperator :: Text -> Expr a -> Expr b -> Expr c
  Void :: (SingI a) => Expr a
  AppendVecs :: forall (n :: Nat) (m :: Nat) a. (SingI a, PrintVecElements (n + m) a, SingI (VectorType (n + m) a)) => Proxy (VectorType (n + m) a) -> Expr (VectorType n a) -> Expr (VectorType m a) -> Expr (VectorType (n + m) a)
  ExtendVec :: forall (n :: Nat) a. (SingI a, PrintVecElements (n + 1) a, SingI (VectorType (n + 1) a)) => Proxy (VectorType (n + 1) a) -> Expr (VectorType n a) -> Expr (Primitive a) -> Expr (VectorType (n + 1) a)
  ConstantBool :: Bool -> Expr TBool
  If :: Expr TBool -> Expr a -> Expr a -> Expr a

data Param where
  Param :: (SingI a) => Expr a -> Param

type family VectorOrSingleOf a where
  VectorOrSingleOf (VectorType n a) = a
  VectorOrSingleOf (Primitive a) = a

instance (SingI a) => Num (Expr (Primitive a)) where
  + :: Expr ('Primitive a) -> Expr ('Primitive a) -> Expr ('Primitive a)
(+) = Expr ('Primitive a) -> Expr ('Primitive a) -> Expr ('Primitive a)
forall (a :: Types). SingI a => Expr a -> Expr a -> Expr a
Add
  * :: Expr ('Primitive a) -> Expr ('Primitive a) -> Expr ('Primitive a)
(*) = Expr ('Primitive a) -> Expr ('Primitive a) -> Expr ('Primitive a)
forall (a :: Types). SingI a => Expr a -> Expr a -> Expr a
Mult
  abs :: Expr ('Primitive a) -> Expr ('Primitive a)
abs = Expr ('Primitive a) -> Expr ('Primitive a)
forall (a :: Types). SingI a => Expr a -> Expr a
Abs
  signum :: Expr ('Primitive a) -> Expr ('Primitive a)
signum = Expr ('Primitive a) -> Expr ('Primitive a)
forall (a :: Types). SingI a => Expr a -> Expr a
Signum
  fromInteger :: Integer -> Expr ('Primitive a)
fromInteger Integer
i =
    let t :: Demote PrimitiveTypes
t = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: PrimitiveTypes).
(SingKind PrimitiveTypes, SingI a) =>
Demote PrimitiveTypes
demote @a
     in case Demote PrimitiveTypes
t of
          Demote PrimitiveTypes
PrimitiveTypes
TInt -> Expr ('Primitive 'TInt) -> Expr ('Primitive a)
forall a b. a -> b
unsafeCoerce (Expr ('Primitive 'TInt) -> Expr ('Primitive a))
-> Expr ('Primitive 'TInt) -> Expr ('Primitive a)
forall a b. (a -> b) -> a -> b
$ Int -> Expr ('Primitive 'TInt)
ConstantInt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)
          Demote PrimitiveTypes
PrimitiveTypes
TFloat -> Expr ('Primitive 'TFloat) -> Expr ('Primitive a)
forall a b. a -> b
unsafeCoerce (Expr ('Primitive 'TFloat) -> Expr ('Primitive a))
-> Expr ('Primitive 'TFloat) -> Expr ('Primitive a)
forall a b. (a -> b) -> a -> b
$ Float -> Expr ('Primitive 'TFloat)
ConstantFloat (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
i)
          Demote PrimitiveTypes
PrimitiveTypes
TUInt -> Expr ('Primitive 'TUInt) -> Expr ('Primitive a)
forall a b. a -> b
unsafeCoerce (Expr ('Primitive 'TUInt) -> Expr ('Primitive a))
-> Expr ('Primitive 'TUInt) -> Expr ('Primitive a)
forall a b. (a -> b) -> a -> b
$ Int -> Expr ('Primitive 'TUInt)
ConstantUInt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)
  negate :: Expr ('Primitive a) -> Expr ('Primitive a)
negate = Expr ('Primitive a) -> Expr ('Primitive a)
forall (a :: Types). SingI a => Expr a -> Expr a
Neg

instance Fractional (Expr (Primitive TFloat)) where
  fromRational :: Rational -> Expr ('Primitive 'TFloat)
fromRational = Float -> Expr ('Primitive 'TFloat)
ConstantFloat (Float -> Expr ('Primitive 'TFloat))
-> (Rational -> Float) -> Rational -> Expr ('Primitive 'TFloat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational
  recip :: Expr ('Primitive 'TFloat) -> Expr ('Primitive 'TFloat)
recip = Expr ('Primitive 'TFloat)
-> Expr ('Primitive 'TFloat) -> Expr ('Primitive 'TFloat)
forall (a :: Types). SingI a => Expr a -> Expr a -> Expr a
Div Expr ('Primitive 'TFloat)
1
  / :: Expr ('Primitive 'TFloat)
-> Expr ('Primitive 'TFloat) -> Expr ('Primitive 'TFloat)
(/) = Expr ('Primitive 'TFloat)
-> Expr ('Primitive 'TFloat) -> Expr ('Primitive 'TFloat)
forall (a :: Types). SingI a => Expr a -> Expr a -> Expr a
Div

type family VecInit (n :: Nat) (a :: PrimitiveTypes) where
  VecInit 2 a = (Expr (Primitive a), Expr (Primitive a))
  VecInit 3 a = (Expr (Primitive a), Expr (Primitive a), Expr (Primitive a))
  VecInit 4 a = (Expr (Primitive a), Expr (Primitive a), Expr (Primitive a), Expr (Primitive a))

class PrintVecElements (n :: Nat) (a :: PrimitiveTypes) where
  printVecElements :: VecInit n a -> Text

instance PrintVecElements 2 a where
  printVecElements :: VecInit 2 a -> Text
printVecElements (Expr ('Primitive a)
a, Expr ('Primitive a)
b) = Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b

instance PrintVecElements 3 a where
  printVecElements :: VecInit 3 a -> Text
printVecElements (Expr ('Primitive a)
a, Expr ('Primitive a)
b, Expr ('Primitive a)
c) = Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
c

instance PrintVecElements 4 a where
  printVecElements :: VecInit 4 a -> Text
printVecElements (Expr ('Primitive a)
a, Expr ('Primitive a)
b, Expr ('Primitive a)
c, Expr ('Primitive a)
d) = Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
d

type family ArrayInit (n :: Nat) a where
  ArrayInit 2 a = (Expr a, Expr a)
  ArrayInit 3 a = (Expr a, Expr a, Expr a)
  ArrayInit 4 a = (Expr a, Expr a, Expr a, Expr a)
  ArrayInit 5 a = (Expr a, Expr a, Expr a, Expr a, Expr a)
  ArrayInit 6 a = (Expr a, Expr a, Expr a, Expr a, Expr a, Expr a)

class PrintArrayElements (n :: Nat) (a :: Types) where
  printArrayElements :: ArrayInit n a -> Text

instance PrintArrayElements 2 a where
  printArrayElements :: ArrayInit 2 a -> Text
printArrayElements (Expr a
a, Expr a
b) = Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b

instance PrintArrayElements 3 a where
  printArrayElements :: ArrayInit 3 a -> Text
printArrayElements (Expr a
a, Expr a
b, Expr a
c) = Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
c

instance PrintArrayElements 4 a where
  printArrayElements :: ArrayInit 4 a -> Text
printArrayElements (Expr a
a, Expr a
b, Expr a
c, Expr a
d) = Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
d

instance PrintArrayElements 5 a where
  printArrayElements :: ArrayInit 5 a -> Text
printArrayElements (Expr a
a, Expr a
b, Expr a
c, Expr a
d, Expr a
e) = Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
e

instance PrintArrayElements 6 a where
  printArrayElements :: ArrayInit 6 a -> Text
printArrayElements (Expr a
a, Expr a
b, Expr a
c, Expr a
d, Expr a
e, Expr a
f) = Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
f

type family MatInit (n :: Nat) (m :: Nat) where
  MatInit 2 a = (Expr (VectorType a TFloat), Expr (VectorType a TFloat))
  MatInit 3 a = (Expr (VectorType a TFloat), Expr (VectorType a TFloat), Expr (VectorType a TFloat))
  MatInit 4 a = (Expr (VectorType a TFloat), Expr (VectorType a TFloat), Expr (VectorType a TFloat), Expr (VectorType a TFloat))

class PrintMatElements (n :: Nat) (m :: Nat) where
  printMatElements :: MatInit n m -> Text

instance PrintMatElements 2 n where
  printMatElements :: MatInit 2 n -> Text
printMatElements (Expr ('VectorType n 'TFloat)
a, Expr ('VectorType n 'TFloat)
b) =
    Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
b

instance PrintMatElements 3 n where
  printMatElements :: MatInit 3 n -> Text
printMatElements (Expr ('VectorType n 'TFloat)
a, Expr ('VectorType n 'TFloat)
b, Expr ('VectorType n 'TFloat)
c) =
    Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
c

instance PrintMatElements 4 n where
  printMatElements :: MatInit 4 n -> Text
printMatElements (Expr ('VectorType n 'TFloat)
a, Expr ('VectorType n 'TFloat)
b, Expr ('VectorType n 'TFloat)
c, Expr ('VectorType n 'TFloat)
d) =
    Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n 'TFloat) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n 'TFloat)
d

showArgs :: [Param] -> Text
showArgs :: [Param] -> Text
showArgs [] = Text
""
showArgs [Param Expr a
x] = Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
x
showArgs ((Param Expr a
x) : [Param]
xs) = Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Param] -> Text
showArgs [Param]
xs

exprToWGSL :: Expr a -> Text
exprToWGSL :: forall (a :: Types). Expr a -> Text
exprToWGSL (Function Text
t [Param]
x) = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Param] -> Text
showArgs [Param]
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (Add Expr a
a Expr a
b) = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" + " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (Mult Expr a
a Expr a
b) = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" * " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (Sub Expr a
a Expr a
b) = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (Div Expr a
a Expr a
b) = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" / " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (Neg Expr a
a) = Text
"(-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (Abs Expr a
a) = Expr (ZonkAny 0) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL (Text -> [Param] -> Expr (ZonkAny 0)
forall (a :: Types). Text -> [Param] -> Expr a
Function Text
"abs" [Expr a -> Param
forall (a :: Types). SingI a => Expr a -> Param
Param Expr a
a])
exprToWGSL (Signum Expr a
a) = Expr (ZonkAny 1) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL (Text -> [Param] -> Expr (ZonkAny 1)
forall (a :: Types). Text -> [Param] -> Expr a
Function Text
"sign" [Expr a -> Param
forall (a :: Types). SingI a => Expr a -> Param
Param Expr a
a])
exprToWGSL (Cast (Proxy a
_ :: Proxy b) (Expr a
a :: Expr a)) =
  let aType :: Demote Types
aType = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @a
      bType :: Demote Types
bType = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @b
   in if Demote Types
Types
aType Types -> Types -> Bool
forall a. Eq a => a -> a -> Bool
== Demote Types
Types
bType
        then Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a
        else case Demote Types
bType of
          Primitive PrimitiveTypes
TInt -> Text
"i32(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          Primitive PrimitiveTypes
TFloat -> Text
"f32(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          Primitive PrimitiveTypes
TUInt -> Text
"u32(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          Demote Types
_ -> Text
forall a. HasCallStack => a
undefined
exprToWGSL (CastVec (Proxy ('VectorType n b)
_ :: Proxy b) (Expr ('VectorType n a)
a :: Expr a)) =
  let aType :: Demote Types
aType = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @a
      bType :: Demote Types
bType = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @b
   in if Demote Types
Types
aType Types -> Types -> Bool
forall a. Eq a => a -> a -> Bool
== Demote Types
Types
bType
        then Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a
        else case Demote Types
bType of
          VectorType Nat
2 PrimitiveTypes
TInt -> Text
"vec2<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          VectorType Nat
2 PrimitiveTypes
TFloat -> Text
"vec2<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          VectorType Nat
2 PrimitiveTypes
TUInt -> Text
"vec2<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          VectorType Nat
3 PrimitiveTypes
TInt -> Text
"vec3<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          VectorType Nat
3 PrimitiveTypes
TFloat -> Text
"vec3<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          VectorType Nat
3 PrimitiveTypes
TUInt -> Text
"vec3<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          VectorType Nat
4 PrimitiveTypes
TInt -> Text
"vec4<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          VectorType Nat
4 PrimitiveTypes
TFloat -> Text
"vec4<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          VectorType Nat
4 PrimitiveTypes
TUInt -> Text
"vec4<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          Demote Types
_ -> Text
forall a. HasCallStack => a
undefined
exprToWGSL (ConstantArray (Proxy a'
_ :: Proxy a) [Expr a']
x) =
  let element :: Text
element = Types -> Text
typeToWGSL' (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @a)
   in Text
"array<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
element Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
T.show ([Expr a'] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr a']
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((Expr a' -> Text) -> [Expr a'] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Expr a' -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL [Expr a']
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (ConstantVec @n @a' (Proxy ('VectorType n a')
_ :: Proxy a) VecInit n a'
x) =
  let elements :: Text
elements = forall (n :: Nat) (a :: PrimitiveTypes).
PrintVecElements n a =>
VecInit n a -> Text
printVecElements @n @a' VecInit n a'
x
   in case forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @a of
        VectorType Nat
2 PrimitiveTypes
TInt -> Text
"vec2<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        VectorType Nat
2 PrimitiveTypes
TFloat -> Text
"vec2<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        VectorType Nat
2 PrimitiveTypes
TUInt -> Text
"vec2<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        VectorType Nat
3 PrimitiveTypes
TInt -> Text
"vec3<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        VectorType Nat
3 PrimitiveTypes
TFloat -> Text
"vec3<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        VectorType Nat
3 PrimitiveTypes
TUInt -> Text
"vec3<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        VectorType Nat
4 PrimitiveTypes
TInt -> Text
"vec4<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        VectorType Nat
4 PrimitiveTypes
TFloat -> Text
"vec4<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        VectorType Nat
4 PrimitiveTypes
TUInt -> Text
"vec4<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        Demote Types
_ -> Text
forall a. HasCallStack => a
undefined
exprToWGSL (ConstantMat @n @m (Proxy ('MatrixType n m)
_ :: Proxy a) MatInit n m
x) =
  let elements :: Text
elements = forall (n :: Nat) (m :: Nat).
PrintMatElements n m =>
MatInit n m -> Text
printMatElements @n @m MatInit n m
x
   in case forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @a of
        MatrixType Nat
2 Nat
2 -> Text
"mat2x2<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        MatrixType Nat
3 Nat
2 -> Text
"mat2x3<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        MatrixType Nat
4 Nat
2 -> Text
"mat2x4<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        MatrixType Nat
2 Nat
3 -> Text
"mat3x2<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        MatrixType Nat
3 Nat
3 -> Text
"mat3x3<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        MatrixType Nat
4 Nat
3 -> Text
"mat3x4<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        MatrixType Nat
2 Nat
4 -> Text
"mat4x2<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        MatrixType Nat
3 Nat
4 -> Text
"mat4x3<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        MatrixType Nat
4 Nat
4 -> Text
"mat4x4<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elements Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        Demote Types
_ -> Text
forall a. HasCallStack => a
undefined
exprToWGSL (ConstantInt Int
x) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"i"
exprToWGSL (ConstantFloat Float
x) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Float -> String
forall a. Show a => a -> String
show Float
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"f"
exprToWGSL (ConstantUInt Int
x) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"u"
exprToWGSL (Var VarIndex
x) = VarIndex -> Text
nameIndex VarIndex
x
exprToWGSL (BindingVar Integer
x) = Text
"b" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
x)
exprToWGSL Expr a
Void = Text
""
exprToWGSL (AccessField Expr a
x Text
f) = Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
exprToWGSL (Index Expr ('ArrayType a)
a Expr ('Primitive 'TUInt)
i) = Expr ('ArrayType a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('ArrayType a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive 'TUInt) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive 'TUInt)
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
exprToWGSL (BuiltInVar Text
x) = Text
"input." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
exprToWGSL (LocationVar Integer
x) = Text
"input.l" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
x)
exprToWGSL (StructInit Text
"" [Text
p]) = Text
p
exprToWGSL (StructInit Text
name [Text]
params) = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," [Text]
params Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (CustomOperator Text
op Expr a
a Expr b
b) = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr b -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr b
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
exprToWGSL (VarCustom Text
t) = Text
t
exprToWGSL (AppendVecs (Proxy ('VectorType (n + m) a)
_ :: Proxy v) Expr ('VectorType n a)
a Expr ('VectorType m a)
b) = case forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @v of
  VectorType Nat
2 PrimitiveTypes
TInt -> Text
"vec2<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
2 PrimitiveTypes
TFloat -> Text
"vec2<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
2 PrimitiveTypes
TUInt -> Text
"vec2<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
3 PrimitiveTypes
TInt -> Text
"vec3<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
3 PrimitiveTypes
TFloat -> Text
"vec3<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
3 PrimitiveTypes
TUInt -> Text
"vec3<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
4 PrimitiveTypes
TInt -> Text
"vec4<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
4 PrimitiveTypes
TFloat -> Text
"vec4<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
4 PrimitiveTypes
TUInt -> Text
"vec4<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType m a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType m a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  Demote Types
_ -> Text
forall a. HasCallStack => a
undefined
exprToWGSL (ExtendVec (Proxy ('VectorType (n + 1) a)
_ :: Proxy v) Expr ('VectorType n a)
a Expr ('Primitive a)
b) = case forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @v of
  VectorType Nat
2 PrimitiveTypes
TInt -> Text
"vec2<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
2 PrimitiveTypes
TFloat -> Text
"vec2<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
2 PrimitiveTypes
TUInt -> Text
"vec2<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
3 PrimitiveTypes
TInt -> Text
"vec3<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
3 PrimitiveTypes
TFloat -> Text
"vec3<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
3 PrimitiveTypes
TUInt -> Text
"vec3<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
4 PrimitiveTypes
TInt -> Text
"vec4<i32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
4 PrimitiveTypes
TFloat -> Text
"vec4<f32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  VectorType Nat
4 PrimitiveTypes
TUInt -> Text
"vec4<u32>(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('VectorType n a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('VectorType n a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ('Primitive a) -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr ('Primitive a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  Demote Types
_ -> Text
forall a. HasCallStack => a
undefined
exprToWGSL (ConstantBool Bool
b) = if Bool
b then Text
"true" else Text
"false"
exprToWGSL (If Expr 'TBool
bool Expr a
a Expr a
b) = Text
"if " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'TBool -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr 'TBool
bool Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"} else {" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

stmtToWGSL :: Stmt -> Text
stmtToWGSL :: Stmt -> Text
stmtToWGSL Stmt
Empty = Text
""
stmtToWGSL (Concat Stmt
Empty Stmt
a) = Stmt -> Text
stmtToWGSL Stmt
a
stmtToWGSL (Concat Stmt
a Stmt
b) = Stmt -> Text
stmtToWGSL Stmt
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Stmt -> Text
stmtToWGSL Stmt
b
stmtToWGSL (Let VarIndex
a Expr a
b) = Text
"  let " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VarIndex -> Text
nameIndex VarIndex
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
stmtToWGSL (Return Expr a
a) = Text
"  return " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall (a :: Types). Expr a -> Text
exprToWGSL Expr a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
stmtToWGSL (Debug Text
t) = Text
"  //" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

-- stmtToWGSL (VLet a b) = "  var " <> nameIndex a <> " = " <> exprToWGSL b <> ";"

newtype Shader m a = Shader (State ShaderState a) deriving newtype ((forall a b. (a -> b) -> Shader m a -> Shader m b)
-> (forall a b. a -> Shader m b -> Shader m a)
-> Functor (Shader m)
forall k (m :: k) a b. a -> Shader m b -> Shader m a
forall k (m :: k) a b. (a -> b) -> Shader m a -> Shader m b
forall a b. a -> Shader m b -> Shader m a
forall a b. (a -> b) -> Shader m a -> Shader m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k (m :: k) a b. (a -> b) -> Shader m a -> Shader m b
fmap :: forall a b. (a -> b) -> Shader m a -> Shader m b
$c<$ :: forall k (m :: k) a b. a -> Shader m b -> Shader m a
<$ :: forall a b. a -> Shader m b -> Shader m a
Functor, Functor (Shader m)
Functor (Shader m) =>
(forall a. a -> Shader m a)
-> (forall a b. Shader m (a -> b) -> Shader m a -> Shader m b)
-> (forall a b c.
    (a -> b -> c) -> Shader m a -> Shader m b -> Shader m c)
-> (forall a b. Shader m a -> Shader m b -> Shader m b)
-> (forall a b. Shader m a -> Shader m b -> Shader m a)
-> Applicative (Shader m)
forall a. a -> Shader m a
forall k (m :: k). Functor (Shader m)
forall k (m :: k) a. a -> Shader m a
forall k (m :: k) a b. Shader m a -> Shader m b -> Shader m a
forall k (m :: k) a b. Shader m a -> Shader m b -> Shader m b
forall k (m :: k) a b.
Shader m (a -> b) -> Shader m a -> Shader m b
forall k (m :: k) a b c.
(a -> b -> c) -> Shader m a -> Shader m b -> Shader m c
forall a b. Shader m a -> Shader m b -> Shader m a
forall a b. Shader m a -> Shader m b -> Shader m b
forall a b. Shader m (a -> b) -> Shader m a -> Shader m b
forall a b c.
(a -> b -> c) -> Shader m a -> Shader m b -> Shader m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall k (m :: k) a. a -> Shader m a
pure :: forall a. a -> Shader m a
$c<*> :: forall k (m :: k) a b.
Shader m (a -> b) -> Shader m a -> Shader m b
<*> :: forall a b. Shader m (a -> b) -> Shader m a -> Shader m b
$cliftA2 :: forall k (m :: k) a b c.
(a -> b -> c) -> Shader m a -> Shader m b -> Shader m c
liftA2 :: forall a b c.
(a -> b -> c) -> Shader m a -> Shader m b -> Shader m c
$c*> :: forall k (m :: k) a b. Shader m a -> Shader m b -> Shader m b
*> :: forall a b. Shader m a -> Shader m b -> Shader m b
$c<* :: forall k (m :: k) a b. Shader m a -> Shader m b -> Shader m a
<* :: forall a b. Shader m a -> Shader m b -> Shader m a
Applicative, Applicative (Shader m)
Applicative (Shader m) =>
(forall a b. Shader m a -> (a -> Shader m b) -> Shader m b)
-> (forall a b. Shader m a -> Shader m b -> Shader m b)
-> (forall a. a -> Shader m a)
-> Monad (Shader m)
forall a. a -> Shader m a
forall k (m :: k). Applicative (Shader m)
forall k (m :: k) a. a -> Shader m a
forall k (m :: k) a b. Shader m a -> Shader m b -> Shader m b
forall k (m :: k) a b.
Shader m a -> (a -> Shader m b) -> Shader m b
forall a b. Shader m a -> Shader m b -> Shader m b
forall a b. Shader m a -> (a -> Shader m b) -> Shader m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall k (m :: k) a b.
Shader m a -> (a -> Shader m b) -> Shader m b
>>= :: forall a b. Shader m a -> (a -> Shader m b) -> Shader m b
$c>> :: forall k (m :: k) a b. Shader m a -> Shader m b -> Shader m b
>> :: forall a b. Shader m a -> Shader m b -> Shader m b
$creturn :: forall k (m :: k) a. a -> Shader m a
return :: forall a. a -> Shader m a
Monad, MonadState ShaderState)

typeToWGSL :: forall (a :: Types). (SingI a) => Expr a -> Text
typeToWGSL :: forall (a :: Types). SingI a => Expr a -> Text
typeToWGSL Expr a
_ = Types -> Text
typeToWGSL' (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Types). (SingKind Types, SingI a) => Demote Types
demote @a)

typeToWGSL' :: Types -> Text
typeToWGSL' :: Types -> Text
typeToWGSL' Types
a = case Types
a of
  Primitive PrimitiveTypes
TInt -> Text
"i32"
  Primitive PrimitiveTypes
TFloat -> Text
"f32"
  Primitive PrimitiveTypes
TUInt -> Text
"u32"
  -- ArrayType n t -> "array<" <> typeToWGSL' t <> ", " <> T.pack (show n) <> ">"
  VectorType Nat
2 PrimitiveTypes
TFloat -> Text
"vec2<f32>"
  VectorType Nat
2 PrimitiveTypes
TInt -> Text
"vec2<i32>"
  VectorType Nat
2 PrimitiveTypes
TUInt -> Text
"vec2<u32>"
  VectorType Nat
3 PrimitiveTypes
TFloat -> Text
"vec3<f32>"
  VectorType Nat
3 PrimitiveTypes
TInt -> Text
"vec3<i32>"
  VectorType Nat
3 PrimitiveTypes
TUInt -> Text
"vec3<u32>"
  VectorType Nat
4 PrimitiveTypes
TFloat -> Text
"vec4<f32>"
  VectorType Nat
4 PrimitiveTypes
TInt -> Text
"vec4<i32>"
  VectorType Nat
4 PrimitiveTypes
TUInt -> Text
"vec4<u32>"
  MatrixType Nat
2 Nat
2 -> Text
"mat2x2<f32>"
  MatrixType Nat
2 Nat
3 -> Text
"mat2x3<f32>"
  MatrixType Nat
2 Nat
4 -> Text
"mat2x4<f32>"
  MatrixType Nat
3 Nat
2 -> Text
"mat3x2<f32>"
  MatrixType Nat
3 Nat
3 -> Text
"mat3x3<f32>"
  MatrixType Nat
3 Nat
4 -> Text
"mat3x4<f32>"
  MatrixType Nat
4 Nat
2 -> Text
"mat4x2<f32>"
  MatrixType Nat
4 Nat
3 -> Text
"mat4x3<f32>"
  MatrixType Nat
4 Nat
4 -> Text
"mat4x4<f32>"
  Types
_ -> Text
forall a. HasCallStack => a
undefined

addStmt :: Stmt -> Shader m ()
addStmt :: forall {k} (m :: k). Stmt -> Shader m ()
addStmt Stmt
stmt = do
  state <- Shader m ShaderState
forall s (m :: * -> *). MonadState s m => m s
get
  put state {ast = Concat state.ast stmt}

newVarIndex :: Shader m VarIndex
newVarIndex :: forall {k} (m :: k). Shader m VarIndex
newVarIndex = do
  ShaderState {counter, ast, dict} <- Shader m ShaderState
forall s (m :: * -> *). MonadState s m => m s
get
  put (ShaderState {counter = counter + 1, ast, dict})
  pure counter

var :: (SingI a) => Expr a -> Shader m (Expr a)
var :: forall {k} (a :: Types) (m :: k).
SingI a =>
Expr a -> Shader m (Expr a)
var Expr a
expr = do
  index <- Shader m VarIndex
forall {k} (m :: k). Shader m VarIndex
newVarIndex
  addStmt (Let index expr)
  pure $ Var index

comment :: Text -> Shader m ()
comment :: forall {k} (m :: k). Text -> Shader m ()
comment Text
t = Stmt -> Shader m ()
forall {k} (m :: k). Stmt -> Shader m ()
addStmt (Text -> Stmt
Debug Text
t)

data CPU

data GPU

data Internal