{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
module Language.GLSL.AST where

import           Control.Applicative              (Applicative (..))
import           Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Text.Lazy.Builder           as LTB
import           GHC.Generics                     (Generic)


data GLSL a = GLSL Version [TopDecl a]
  deriving ((forall x. GLSL a -> Rep (GLSL a) x)
-> (forall x. Rep (GLSL a) x -> GLSL a) -> Generic (GLSL a)
forall x. Rep (GLSL a) x -> GLSL a
forall x. GLSL a -> Rep (GLSL a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (GLSL a) x -> GLSL a
forall a x. GLSL a -> Rep (GLSL a) x
$cto :: forall a x. Rep (GLSL a) x -> GLSL a
$cfrom :: forall a x. GLSL a -> Rep (GLSL a) x
Generic, Int -> GLSL a -> ShowS
[GLSL a] -> ShowS
GLSL a -> String
(Int -> GLSL a -> ShowS)
-> (GLSL a -> String) -> ([GLSL a] -> ShowS) -> Show (GLSL a)
forall a. Show a => Int -> GLSL a -> ShowS
forall a. Show a => [GLSL a] -> ShowS
forall a. Show a => GLSL a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GLSL a] -> ShowS
$cshowList :: forall a. Show a => [GLSL a] -> ShowS
show :: GLSL a -> String
$cshow :: forall a. Show a => GLSL a -> String
showsPrec :: Int -> GLSL a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GLSL a -> ShowS
Show, GLSL a -> GLSL a -> Bool
(GLSL a -> GLSL a -> Bool)
-> (GLSL a -> GLSL a -> Bool) -> Eq (GLSL a)
forall a. Eq a => GLSL a -> GLSL a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GLSL a -> GLSL a -> Bool
$c/= :: forall a. Eq a => GLSL a -> GLSL a -> Bool
== :: GLSL a -> GLSL a -> Bool
$c== :: forall a. Eq a => GLSL a -> GLSL a -> Bool
Eq, a -> GLSL b -> GLSL a
(a -> b) -> GLSL a -> GLSL b
(forall a b. (a -> b) -> GLSL a -> GLSL b)
-> (forall a b. a -> GLSL b -> GLSL a) -> Functor GLSL
forall a b. a -> GLSL b -> GLSL a
forall a b. (a -> b) -> GLSL a -> GLSL b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GLSL b -> GLSL a
$c<$ :: forall a b. a -> GLSL b -> GLSL a
fmap :: (a -> b) -> GLSL a -> GLSL b
$cfmap :: forall a b. (a -> b) -> GLSL a -> GLSL b
Functor, GLSL a -> Bool
(a -> m) -> GLSL a -> m
(a -> b -> b) -> b -> GLSL a -> b
(forall m. Monoid m => GLSL m -> m)
-> (forall m a. Monoid m => (a -> m) -> GLSL a -> m)
-> (forall m a. Monoid m => (a -> m) -> GLSL a -> m)
-> (forall a b. (a -> b -> b) -> b -> GLSL a -> b)
-> (forall a b. (a -> b -> b) -> b -> GLSL a -> b)
-> (forall b a. (b -> a -> b) -> b -> GLSL a -> b)
-> (forall b a. (b -> a -> b) -> b -> GLSL a -> b)
-> (forall a. (a -> a -> a) -> GLSL a -> a)
-> (forall a. (a -> a -> a) -> GLSL a -> a)
-> (forall a. GLSL a -> [a])
-> (forall a. GLSL a -> Bool)
-> (forall a. GLSL a -> Int)
-> (forall a. Eq a => a -> GLSL a -> Bool)
-> (forall a. Ord a => GLSL a -> a)
-> (forall a. Ord a => GLSL a -> a)
-> (forall a. Num a => GLSL a -> a)
-> (forall a. Num a => GLSL a -> a)
-> Foldable GLSL
forall a. Eq a => a -> GLSL a -> Bool
forall a. Num a => GLSL a -> a
forall a. Ord a => GLSL a -> a
forall m. Monoid m => GLSL m -> m
forall a. GLSL a -> Bool
forall a. GLSL a -> Int
forall a. GLSL a -> [a]
forall a. (a -> a -> a) -> GLSL a -> a
forall m a. Monoid m => (a -> m) -> GLSL a -> m
forall b a. (b -> a -> b) -> b -> GLSL a -> b
forall a b. (a -> b -> b) -> b -> GLSL a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: GLSL a -> a
$cproduct :: forall a. Num a => GLSL a -> a
sum :: GLSL a -> a
$csum :: forall a. Num a => GLSL a -> a
minimum :: GLSL a -> a
$cminimum :: forall a. Ord a => GLSL a -> a
maximum :: GLSL a -> a
$cmaximum :: forall a. Ord a => GLSL a -> a
elem :: a -> GLSL a -> Bool
$celem :: forall a. Eq a => a -> GLSL a -> Bool
length :: GLSL a -> Int
$clength :: forall a. GLSL a -> Int
null :: GLSL a -> Bool
$cnull :: forall a. GLSL a -> Bool
toList :: GLSL a -> [a]
$ctoList :: forall a. GLSL a -> [a]
foldl1 :: (a -> a -> a) -> GLSL a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GLSL a -> a
foldr1 :: (a -> a -> a) -> GLSL a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> GLSL a -> a
foldl' :: (b -> a -> b) -> b -> GLSL a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GLSL a -> b
foldl :: (b -> a -> b) -> b -> GLSL a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GLSL a -> b
foldr' :: (a -> b -> b) -> b -> GLSL a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GLSL a -> b
foldr :: (a -> b -> b) -> b -> GLSL a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> GLSL a -> b
foldMap' :: (a -> m) -> GLSL a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GLSL a -> m
foldMap :: (a -> m) -> GLSL a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GLSL a -> m
fold :: GLSL m -> m
$cfold :: forall m. Monoid m => GLSL m -> m
Foldable, Functor GLSL
Foldable GLSL
Functor GLSL
-> Foldable GLSL
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GLSL a -> f (GLSL b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GLSL (f a) -> f (GLSL a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GLSL a -> m (GLSL b))
-> (forall (m :: * -> *) a. Monad m => GLSL (m a) -> m (GLSL a))
-> Traversable GLSL
(a -> f b) -> GLSL a -> f (GLSL b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GLSL (m a) -> m (GLSL a)
forall (f :: * -> *) a. Applicative f => GLSL (f a) -> f (GLSL a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GLSL a -> m (GLSL b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GLSL a -> f (GLSL b)
sequence :: GLSL (m a) -> m (GLSL a)
$csequence :: forall (m :: * -> *) a. Monad m => GLSL (m a) -> m (GLSL a)
mapM :: (a -> m b) -> GLSL a -> m (GLSL b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GLSL a -> m (GLSL b)
sequenceA :: GLSL (f a) -> f (GLSL a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => GLSL (f a) -> f (GLSL a)
traverse :: (a -> f b) -> GLSL a -> f (GLSL b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GLSL a -> f (GLSL b)
$cp2Traversable :: Foldable GLSL
$cp1Traversable :: Functor GLSL
Traversable)

newtype Version = Version Int
  deriving ((forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq)

data TopDecl a
  = LayoutDecl LayoutSpec GlobalDecl
  | GlobalDecl GlobalDecl
  | ProcDecl ProcName [ParamDecl] [StmtAnnot a]
  deriving ((forall x. TopDecl a -> Rep (TopDecl a) x)
-> (forall x. Rep (TopDecl a) x -> TopDecl a)
-> Generic (TopDecl a)
forall x. Rep (TopDecl a) x -> TopDecl a
forall x. TopDecl a -> Rep (TopDecl a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TopDecl a) x -> TopDecl a
forall a x. TopDecl a -> Rep (TopDecl a) x
$cto :: forall a x. Rep (TopDecl a) x -> TopDecl a
$cfrom :: forall a x. TopDecl a -> Rep (TopDecl a) x
Generic, Int -> TopDecl a -> ShowS
[TopDecl a] -> ShowS
TopDecl a -> String
(Int -> TopDecl a -> ShowS)
-> (TopDecl a -> String)
-> ([TopDecl a] -> ShowS)
-> Show (TopDecl a)
forall a. Show a => Int -> TopDecl a -> ShowS
forall a. Show a => [TopDecl a] -> ShowS
forall a. Show a => TopDecl a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopDecl a] -> ShowS
$cshowList :: forall a. Show a => [TopDecl a] -> ShowS
show :: TopDecl a -> String
$cshow :: forall a. Show a => TopDecl a -> String
showsPrec :: Int -> TopDecl a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TopDecl a -> ShowS
Show, TopDecl a -> TopDecl a -> Bool
(TopDecl a -> TopDecl a -> Bool)
-> (TopDecl a -> TopDecl a -> Bool) -> Eq (TopDecl a)
forall a. Eq a => TopDecl a -> TopDecl a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopDecl a -> TopDecl a -> Bool
$c/= :: forall a. Eq a => TopDecl a -> TopDecl a -> Bool
== :: TopDecl a -> TopDecl a -> Bool
$c== :: forall a. Eq a => TopDecl a -> TopDecl a -> Bool
Eq, a -> TopDecl b -> TopDecl a
(a -> b) -> TopDecl a -> TopDecl b
(forall a b. (a -> b) -> TopDecl a -> TopDecl b)
-> (forall a b. a -> TopDecl b -> TopDecl a) -> Functor TopDecl
forall a b. a -> TopDecl b -> TopDecl a
forall a b. (a -> b) -> TopDecl a -> TopDecl b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TopDecl b -> TopDecl a
$c<$ :: forall a b. a -> TopDecl b -> TopDecl a
fmap :: (a -> b) -> TopDecl a -> TopDecl b
$cfmap :: forall a b. (a -> b) -> TopDecl a -> TopDecl b
Functor, TopDecl a -> Bool
(a -> m) -> TopDecl a -> m
(a -> b -> b) -> b -> TopDecl a -> b
(forall m. Monoid m => TopDecl m -> m)
-> (forall m a. Monoid m => (a -> m) -> TopDecl a -> m)
-> (forall m a. Monoid m => (a -> m) -> TopDecl a -> m)
-> (forall a b. (a -> b -> b) -> b -> TopDecl a -> b)
-> (forall a b. (a -> b -> b) -> b -> TopDecl a -> b)
-> (forall b a. (b -> a -> b) -> b -> TopDecl a -> b)
-> (forall b a. (b -> a -> b) -> b -> TopDecl a -> b)
-> (forall a. (a -> a -> a) -> TopDecl a -> a)
-> (forall a. (a -> a -> a) -> TopDecl a -> a)
-> (forall a. TopDecl a -> [a])
-> (forall a. TopDecl a -> Bool)
-> (forall a. TopDecl a -> Int)
-> (forall a. Eq a => a -> TopDecl a -> Bool)
-> (forall a. Ord a => TopDecl a -> a)
-> (forall a. Ord a => TopDecl a -> a)
-> (forall a. Num a => TopDecl a -> a)
-> (forall a. Num a => TopDecl a -> a)
-> Foldable TopDecl
forall a. Eq a => a -> TopDecl a -> Bool
forall a. Num a => TopDecl a -> a
forall a. Ord a => TopDecl a -> a
forall m. Monoid m => TopDecl m -> m
forall a. TopDecl a -> Bool
forall a. TopDecl a -> Int
forall a. TopDecl a -> [a]
forall a. (a -> a -> a) -> TopDecl a -> a
forall m a. Monoid m => (a -> m) -> TopDecl a -> m
forall b a. (b -> a -> b) -> b -> TopDecl a -> b
forall a b. (a -> b -> b) -> b -> TopDecl a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: TopDecl a -> a
$cproduct :: forall a. Num a => TopDecl a -> a
sum :: TopDecl a -> a
$csum :: forall a. Num a => TopDecl a -> a
minimum :: TopDecl a -> a
$cminimum :: forall a. Ord a => TopDecl a -> a
maximum :: TopDecl a -> a
$cmaximum :: forall a. Ord a => TopDecl a -> a
elem :: a -> TopDecl a -> Bool
$celem :: forall a. Eq a => a -> TopDecl a -> Bool
length :: TopDecl a -> Int
$clength :: forall a. TopDecl a -> Int
null :: TopDecl a -> Bool
$cnull :: forall a. TopDecl a -> Bool
toList :: TopDecl a -> [a]
$ctoList :: forall a. TopDecl a -> [a]
foldl1 :: (a -> a -> a) -> TopDecl a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TopDecl a -> a
foldr1 :: (a -> a -> a) -> TopDecl a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> TopDecl a -> a
foldl' :: (b -> a -> b) -> b -> TopDecl a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TopDecl a -> b
foldl :: (b -> a -> b) -> b -> TopDecl a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TopDecl a -> b
foldr' :: (a -> b -> b) -> b -> TopDecl a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TopDecl a -> b
foldr :: (a -> b -> b) -> b -> TopDecl a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> TopDecl a -> b
foldMap' :: (a -> m) -> TopDecl a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TopDecl a -> m
foldMap :: (a -> m) -> TopDecl a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TopDecl a -> m
fold :: TopDecl m -> m
$cfold :: forall m. Monoid m => TopDecl m -> m
Foldable, Functor TopDecl
Foldable TopDecl
Functor TopDecl
-> Foldable TopDecl
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> TopDecl a -> f (TopDecl b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TopDecl (f a) -> f (TopDecl a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TopDecl a -> m (TopDecl b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TopDecl (m a) -> m (TopDecl a))
-> Traversable TopDecl
(a -> f b) -> TopDecl a -> f (TopDecl b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => TopDecl (m a) -> m (TopDecl a)
forall (f :: * -> *) a.
Applicative f =>
TopDecl (f a) -> f (TopDecl a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TopDecl a -> m (TopDecl b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopDecl a -> f (TopDecl b)
sequence :: TopDecl (m a) -> m (TopDecl a)
$csequence :: forall (m :: * -> *) a. Monad m => TopDecl (m a) -> m (TopDecl a)
mapM :: (a -> m b) -> TopDecl a -> m (TopDecl b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TopDecl a -> m (TopDecl b)
sequenceA :: TopDecl (f a) -> f (TopDecl a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TopDecl (f a) -> f (TopDecl a)
traverse :: (a -> f b) -> TopDecl a -> f (TopDecl b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopDecl a -> f (TopDecl b)
$cp2Traversable :: Foldable TopDecl
$cp1Traversable :: Functor TopDecl
Traversable)

data ProcName
  = ProcMain
  | ProcName NameId
  deriving ((forall x. ProcName -> Rep ProcName x)
-> (forall x. Rep ProcName x -> ProcName) -> Generic ProcName
forall x. Rep ProcName x -> ProcName
forall x. ProcName -> Rep ProcName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProcName x -> ProcName
$cfrom :: forall x. ProcName -> Rep ProcName x
Generic, Int -> ProcName -> ShowS
[ProcName] -> ShowS
ProcName -> String
(Int -> ProcName -> ShowS)
-> (ProcName -> String) -> ([ProcName] -> ShowS) -> Show ProcName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcName] -> ShowS
$cshowList :: [ProcName] -> ShowS
show :: ProcName -> String
$cshow :: ProcName -> String
showsPrec :: Int -> ProcName -> ShowS
$cshowsPrec :: Int -> ProcName -> ShowS
Show, ProcName -> ProcName -> Bool
(ProcName -> ProcName -> Bool)
-> (ProcName -> ProcName -> Bool) -> Eq ProcName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcName -> ProcName -> Bool
$c/= :: ProcName -> ProcName -> Bool
== :: ProcName -> ProcName -> Bool
$c== :: ProcName -> ProcName -> Bool
Eq)

data LayoutSpec
  = LayoutStd140
  | LayoutLocation Int
  deriving ((forall x. LayoutSpec -> Rep LayoutSpec x)
-> (forall x. Rep LayoutSpec x -> LayoutSpec) -> Generic LayoutSpec
forall x. Rep LayoutSpec x -> LayoutSpec
forall x. LayoutSpec -> Rep LayoutSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LayoutSpec x -> LayoutSpec
$cfrom :: forall x. LayoutSpec -> Rep LayoutSpec x
Generic, Int -> LayoutSpec -> ShowS
[LayoutSpec] -> ShowS
LayoutSpec -> String
(Int -> LayoutSpec -> ShowS)
-> (LayoutSpec -> String)
-> ([LayoutSpec] -> ShowS)
-> Show LayoutSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutSpec] -> ShowS
$cshowList :: [LayoutSpec] -> ShowS
show :: LayoutSpec -> String
$cshow :: LayoutSpec -> String
showsPrec :: Int -> LayoutSpec -> ShowS
$cshowsPrec :: Int -> LayoutSpec -> ShowS
Show, LayoutSpec -> LayoutSpec -> Bool
(LayoutSpec -> LayoutSpec -> Bool)
-> (LayoutSpec -> LayoutSpec -> Bool) -> Eq LayoutSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutSpec -> LayoutSpec -> Bool
$c/= :: LayoutSpec -> LayoutSpec -> Bool
== :: LayoutSpec -> LayoutSpec -> Bool
$c== :: LayoutSpec -> LayoutSpec -> Bool
Eq)

data ParamDecl
  = Param ParamKind LocalDecl
  deriving ((forall x. ParamDecl -> Rep ParamDecl x)
-> (forall x. Rep ParamDecl x -> ParamDecl) -> Generic ParamDecl
forall x. Rep ParamDecl x -> ParamDecl
forall x. ParamDecl -> Rep ParamDecl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParamDecl x -> ParamDecl
$cfrom :: forall x. ParamDecl -> Rep ParamDecl x
Generic, Int -> ParamDecl -> ShowS
[ParamDecl] -> ShowS
ParamDecl -> String
(Int -> ParamDecl -> ShowS)
-> (ParamDecl -> String)
-> ([ParamDecl] -> ShowS)
-> Show ParamDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamDecl] -> ShowS
$cshowList :: [ParamDecl] -> ShowS
show :: ParamDecl -> String
$cshow :: ParamDecl -> String
showsPrec :: Int -> ParamDecl -> ShowS
$cshowsPrec :: Int -> ParamDecl -> ShowS
Show, ParamDecl -> ParamDecl -> Bool
(ParamDecl -> ParamDecl -> Bool)
-> (ParamDecl -> ParamDecl -> Bool) -> Eq ParamDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamDecl -> ParamDecl -> Bool
$c/= :: ParamDecl -> ParamDecl -> Bool
== :: ParamDecl -> ParamDecl -> Bool
$c== :: ParamDecl -> ParamDecl -> Bool
Eq)

data ParamKind
  = PkIn
  | PkOut
  | PkInout
  deriving ((forall x. ParamKind -> Rep ParamKind x)
-> (forall x. Rep ParamKind x -> ParamKind) -> Generic ParamKind
forall x. Rep ParamKind x -> ParamKind
forall x. ParamKind -> Rep ParamKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParamKind x -> ParamKind
$cfrom :: forall x. ParamKind -> Rep ParamKind x
Generic, Int -> ParamKind -> ShowS
[ParamKind] -> ShowS
ParamKind -> String
(Int -> ParamKind -> ShowS)
-> (ParamKind -> String)
-> ([ParamKind] -> ShowS)
-> Show ParamKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamKind] -> ShowS
$cshowList :: [ParamKind] -> ShowS
show :: ParamKind -> String
$cshow :: ParamKind -> String
showsPrec :: Int -> ParamKind -> ShowS
$cshowsPrec :: Int -> ParamKind -> ShowS
Show, ParamKind -> ParamKind -> Bool
(ParamKind -> ParamKind -> Bool)
-> (ParamKind -> ParamKind -> Bool) -> Eq ParamKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamKind -> ParamKind -> Bool
$c/= :: ParamKind -> ParamKind -> Bool
== :: ParamKind -> ParamKind -> Bool
$c== :: ParamKind -> ParamKind -> Bool
Eq)

data LocalDecl
  = LDecl Type NameId (Maybe Expr)
  deriving ((forall x. LocalDecl -> Rep LocalDecl x)
-> (forall x. Rep LocalDecl x -> LocalDecl) -> Generic LocalDecl
forall x. Rep LocalDecl x -> LocalDecl
forall x. LocalDecl -> Rep LocalDecl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalDecl x -> LocalDecl
$cfrom :: forall x. LocalDecl -> Rep LocalDecl x
Generic, Int -> LocalDecl -> ShowS
[LocalDecl] -> ShowS
LocalDecl -> String
(Int -> LocalDecl -> ShowS)
-> (LocalDecl -> String)
-> ([LocalDecl] -> ShowS)
-> Show LocalDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalDecl] -> ShowS
$cshowList :: [LocalDecl] -> ShowS
show :: LocalDecl -> String
$cshow :: LocalDecl -> String
showsPrec :: Int -> LocalDecl -> ShowS
$cshowsPrec :: Int -> LocalDecl -> ShowS
Show, LocalDecl -> LocalDecl -> Bool
(LocalDecl -> LocalDecl -> Bool)
-> (LocalDecl -> LocalDecl -> Bool) -> Eq LocalDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalDecl -> LocalDecl -> Bool
$c/= :: LocalDecl -> LocalDecl -> Bool
== :: LocalDecl -> LocalDecl -> Bool
$c== :: LocalDecl -> LocalDecl -> Bool
Eq)

data GlobalDecl
  = GDecl GDeclKind Type Name
  deriving ((forall x. GlobalDecl -> Rep GlobalDecl x)
-> (forall x. Rep GlobalDecl x -> GlobalDecl) -> Generic GlobalDecl
forall x. Rep GlobalDecl x -> GlobalDecl
forall x. GlobalDecl -> Rep GlobalDecl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalDecl x -> GlobalDecl
$cfrom :: forall x. GlobalDecl -> Rep GlobalDecl x
Generic, Int -> GlobalDecl -> ShowS
[GlobalDecl] -> ShowS
GlobalDecl -> String
(Int -> GlobalDecl -> ShowS)
-> (GlobalDecl -> String)
-> ([GlobalDecl] -> ShowS)
-> Show GlobalDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalDecl] -> ShowS
$cshowList :: [GlobalDecl] -> ShowS
show :: GlobalDecl -> String
$cshow :: GlobalDecl -> String
showsPrec :: Int -> GlobalDecl -> ShowS
$cshowsPrec :: Int -> GlobalDecl -> ShowS
Show, GlobalDecl -> GlobalDecl -> Bool
(GlobalDecl -> GlobalDecl -> Bool)
-> (GlobalDecl -> GlobalDecl -> Bool) -> Eq GlobalDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalDecl -> GlobalDecl -> Bool
$c/= :: GlobalDecl -> GlobalDecl -> Bool
== :: GlobalDecl -> GlobalDecl -> Bool
$c== :: GlobalDecl -> GlobalDecl -> Bool
Eq)

data GDeclKind
  = GkIn
  | GkOut
  | GkUniform
  deriving ((forall x. GDeclKind -> Rep GDeclKind x)
-> (forall x. Rep GDeclKind x -> GDeclKind) -> Generic GDeclKind
forall x. Rep GDeclKind x -> GDeclKind
forall x. GDeclKind -> Rep GDeclKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GDeclKind x -> GDeclKind
$cfrom :: forall x. GDeclKind -> Rep GDeclKind x
Generic, Int -> GDeclKind -> ShowS
[GDeclKind] -> ShowS
GDeclKind -> String
(Int -> GDeclKind -> ShowS)
-> (GDeclKind -> String)
-> ([GDeclKind] -> ShowS)
-> Show GDeclKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GDeclKind] -> ShowS
$cshowList :: [GDeclKind] -> ShowS
show :: GDeclKind -> String
$cshow :: GDeclKind -> String
showsPrec :: Int -> GDeclKind -> ShowS
$cshowsPrec :: Int -> GDeclKind -> ShowS
Show, GDeclKind -> GDeclKind -> Bool
(GDeclKind -> GDeclKind -> Bool)
-> (GDeclKind -> GDeclKind -> Bool) -> Eq GDeclKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GDeclKind -> GDeclKind -> Bool
$c/= :: GDeclKind -> GDeclKind -> Bool
== :: GDeclKind -> GDeclKind -> Bool
$c== :: GDeclKind -> GDeclKind -> Bool
Eq)

data Type
  = TyBool
  | TyFloat
  | TySampler2D
  | TyVec Int
  | TyMat Int Int
  | TyStruct NameId [(Type, NameId)]
  deriving ((forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Generic, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq)

newtype NameId = NameId Int
  deriving ((forall x. NameId -> Rep NameId x)
-> (forall x. Rep NameId x -> NameId) -> Generic NameId
forall x. Rep NameId x -> NameId
forall x. NameId -> Rep NameId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameId x -> NameId
$cfrom :: forall x. NameId -> Rep NameId x
Generic, Int -> NameId -> ShowS
[NameId] -> ShowS
NameId -> String
(Int -> NameId -> ShowS)
-> (NameId -> String) -> ([NameId] -> ShowS) -> Show NameId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameId] -> ShowS
$cshowList :: [NameId] -> ShowS
show :: NameId -> String
$cshow :: NameId -> String
showsPrec :: Int -> NameId -> ShowS
$cshowsPrec :: Int -> NameId -> ShowS
Show, NameId -> NameId -> Bool
(NameId -> NameId -> Bool)
-> (NameId -> NameId -> Bool) -> Eq NameId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameId -> NameId -> Bool
$c/= :: NameId -> NameId -> Bool
== :: NameId -> NameId -> Bool
$c== :: NameId -> NameId -> Bool
Eq)

data Name
  = Name Namespace NameId
  deriving ((forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Name x -> Name
$cfrom :: forall x. Name -> Rep Name x
Generic, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq)

data Namespace
  = NsT
  | NsS
  | NsU
  | NsVF
  | NsIn
  | NsOut
  deriving ((forall x. Namespace -> Rep Namespace x)
-> (forall x. Rep Namespace x -> Namespace) -> Generic Namespace
forall x. Rep Namespace x -> Namespace
forall x. Namespace -> Rep Namespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Namespace x -> Namespace
$cfrom :: forall x. Namespace -> Rep Namespace x
Generic, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show, Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq)

data FunName
  = PrimAbs
  | PrimAsin
  | PrimAtan
  | PrimCos
  | PrimCross
  | PrimDot
  | PrimFloor
  | PrimFract
  | PrimLength
  | PrimMat3x3
  | PrimMat4x4
  | PrimMod
  | PrimNormalize
  | PrimPow
  | PrimSin
  | PrimSmoothstep
  | PrimSqrt
  | PrimStep
  | PrimTan
  | PrimVec2
  | PrimVec3
  | PrimVec4
  deriving ((forall x. FunName -> Rep FunName x)
-> (forall x. Rep FunName x -> FunName) -> Generic FunName
forall x. Rep FunName x -> FunName
forall x. FunName -> Rep FunName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunName x -> FunName
$cfrom :: forall x. FunName -> Rep FunName x
Generic, Int -> FunName -> ShowS
[FunName] -> ShowS
FunName -> String
(Int -> FunName -> ShowS)
-> (FunName -> String) -> ([FunName] -> ShowS) -> Show FunName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunName] -> ShowS
$cshowList :: [FunName] -> ShowS
show :: FunName -> String
$cshow :: FunName -> String
showsPrec :: Int -> FunName -> ShowS
$cshowsPrec :: Int -> FunName -> ShowS
Show, FunName -> FunName -> Bool
(FunName -> FunName -> Bool)
-> (FunName -> FunName -> Bool) -> Eq FunName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunName -> FunName -> Bool
$c/= :: FunName -> FunName -> Bool
== :: FunName -> FunName -> Bool
$c== :: FunName -> FunName -> Bool
Eq)

data Swizzle
  = X | Y | Z | W
  deriving ((forall x. Swizzle -> Rep Swizzle x)
-> (forall x. Rep Swizzle x -> Swizzle) -> Generic Swizzle
forall x. Rep Swizzle x -> Swizzle
forall x. Swizzle -> Rep Swizzle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Swizzle x -> Swizzle
$cfrom :: forall x. Swizzle -> Rep Swizzle x
Generic, Int -> Swizzle -> ShowS
[Swizzle] -> ShowS
Swizzle -> String
(Int -> Swizzle -> ShowS)
-> (Swizzle -> String) -> ([Swizzle] -> ShowS) -> Show Swizzle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Swizzle] -> ShowS
$cshowList :: [Swizzle] -> ShowS
show :: Swizzle -> String
$cshow :: Swizzle -> String
showsPrec :: Int -> Swizzle -> ShowS
$cshowsPrec :: Int -> Swizzle -> ShowS
Show, Swizzle -> Swizzle -> Bool
(Swizzle -> Swizzle -> Bool)
-> (Swizzle -> Swizzle -> Bool) -> Eq Swizzle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Swizzle -> Swizzle -> Bool
$c/= :: Swizzle -> Swizzle -> Bool
== :: Swizzle -> Swizzle -> Bool
$c== :: Swizzle -> Swizzle -> Bool
Eq)

data NameExpr
  = NameExpr Name
  | UniformExpr NameId NameId
  deriving ((forall x. NameExpr -> Rep NameExpr x)
-> (forall x. Rep NameExpr x -> NameExpr) -> Generic NameExpr
forall x. Rep NameExpr x -> NameExpr
forall x. NameExpr -> Rep NameExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameExpr x -> NameExpr
$cfrom :: forall x. NameExpr -> Rep NameExpr x
Generic, Int -> NameExpr -> ShowS
[NameExpr] -> ShowS
NameExpr -> String
(Int -> NameExpr -> ShowS)
-> (NameExpr -> String) -> ([NameExpr] -> ShowS) -> Show NameExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameExpr] -> ShowS
$cshowList :: [NameExpr] -> ShowS
show :: NameExpr -> String
$cshow :: NameExpr -> String
showsPrec :: Int -> NameExpr -> ShowS
$cshowsPrec :: Int -> NameExpr -> ShowS
Show, NameExpr -> NameExpr -> Bool
(NameExpr -> NameExpr -> Bool)
-> (NameExpr -> NameExpr -> Bool) -> Eq NameExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameExpr -> NameExpr -> Bool
$c/= :: NameExpr -> NameExpr -> Bool
== :: NameExpr -> NameExpr -> Bool
$c== :: NameExpr -> NameExpr -> Bool
Eq)

data Cast
  = Cast
  | NoCast
  deriving ((forall x. Cast -> Rep Cast x)
-> (forall x. Rep Cast x -> Cast) -> Generic Cast
forall x. Rep Cast x -> Cast
forall x. Cast -> Rep Cast x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cast x -> Cast
$cfrom :: forall x. Cast -> Rep Cast x
Generic, Int -> Cast -> ShowS
[Cast] -> ShowS
Cast -> String
(Int -> Cast -> ShowS)
-> (Cast -> String) -> ([Cast] -> ShowS) -> Show Cast
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cast] -> ShowS
$cshowList :: [Cast] -> ShowS
show :: Cast -> String
$cshow :: Cast -> String
showsPrec :: Int -> Cast -> ShowS
$cshowsPrec :: Int -> Cast -> ShowS
Show, Cast -> Cast -> Bool
(Cast -> Cast -> Bool) -> (Cast -> Cast -> Bool) -> Eq Cast
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cast -> Cast -> Bool
$c/= :: Cast -> Cast -> Bool
== :: Cast -> Cast -> Bool
$c== :: Cast -> Cast -> Bool
Eq)

data ExprAtom
  = LitIntExpr Cast Int
  | LitFloatExpr Cast Float
  | IdentifierExpr NameExpr
  | SwizzleExpr NameId Swizzle
  | VecIndexExpr NameExpr Swizzle
  | MatIndexExpr NameExpr Swizzle Swizzle
  deriving ((forall x. ExprAtom -> Rep ExprAtom x)
-> (forall x. Rep ExprAtom x -> ExprAtom) -> Generic ExprAtom
forall x. Rep ExprAtom x -> ExprAtom
forall x. ExprAtom -> Rep ExprAtom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExprAtom x -> ExprAtom
$cfrom :: forall x. ExprAtom -> Rep ExprAtom x
Generic, Int -> ExprAtom -> ShowS
[ExprAtom] -> ShowS
ExprAtom -> String
(Int -> ExprAtom -> ShowS)
-> (ExprAtom -> String) -> ([ExprAtom] -> ShowS) -> Show ExprAtom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExprAtom] -> ShowS
$cshowList :: [ExprAtom] -> ShowS
show :: ExprAtom -> String
$cshow :: ExprAtom -> String
showsPrec :: Int -> ExprAtom -> ShowS
$cshowsPrec :: Int -> ExprAtom -> ShowS
Show, ExprAtom -> ExprAtom -> Bool
(ExprAtom -> ExprAtom -> Bool)
-> (ExprAtom -> ExprAtom -> Bool) -> Eq ExprAtom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExprAtom -> ExprAtom -> Bool
$c/= :: ExprAtom -> ExprAtom -> Bool
== :: ExprAtom -> ExprAtom -> Bool
$c== :: ExprAtom -> ExprAtom -> Bool
Eq)

data Expr
  = UnaryExpr UnaryOp ExprAtom
  | BinaryExpr ExprAtom BinaryOp ExprAtom
  | FunCallExpr FunName [ExprAtom]
  | TextureExpr ExprAtom ExprAtom ExprAtom
  | AtomExpr ExprAtom
  deriving ((forall x. Expr -> Rep Expr x)
-> (forall x. Rep Expr x -> Expr) -> Generic Expr
forall x. Rep Expr x -> Expr
forall x. Expr -> Rep Expr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Expr x -> Expr
$cfrom :: forall x. Expr -> Rep Expr x
Generic, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show, Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq)

data BinaryOp
  = BOpPlus
  | BOpMinus
  | BOpMul
  | BOpDiv
  | BOpGE
  | BOpGT
  | BOpLE
  | BOpLT
  | BOpAnd
  | BOpOr
  deriving ((forall x. BinaryOp -> Rep BinaryOp x)
-> (forall x. Rep BinaryOp x -> BinaryOp) -> Generic BinaryOp
forall x. Rep BinaryOp x -> BinaryOp
forall x. BinaryOp -> Rep BinaryOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinaryOp x -> BinaryOp
$cfrom :: forall x. BinaryOp -> Rep BinaryOp x
Generic, Int -> BinaryOp -> ShowS
[BinaryOp] -> ShowS
BinaryOp -> String
(Int -> BinaryOp -> ShowS)
-> (BinaryOp -> String) -> ([BinaryOp] -> ShowS) -> Show BinaryOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryOp] -> ShowS
$cshowList :: [BinaryOp] -> ShowS
show :: BinaryOp -> String
$cshow :: BinaryOp -> String
showsPrec :: Int -> BinaryOp -> ShowS
$cshowsPrec :: Int -> BinaryOp -> ShowS
Show, BinaryOp -> BinaryOp -> Bool
(BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool) -> Eq BinaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryOp -> BinaryOp -> Bool
$c/= :: BinaryOp -> BinaryOp -> Bool
== :: BinaryOp -> BinaryOp -> Bool
$c== :: BinaryOp -> BinaryOp -> Bool
Eq)

data UnaryOp
  = UOpMinus
  | UOpNot
  deriving ((forall x. UnaryOp -> Rep UnaryOp x)
-> (forall x. Rep UnaryOp x -> UnaryOp) -> Generic UnaryOp
forall x. Rep UnaryOp x -> UnaryOp
forall x. UnaryOp -> Rep UnaryOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnaryOp x -> UnaryOp
$cfrom :: forall x. UnaryOp -> Rep UnaryOp x
Generic, Int -> UnaryOp -> ShowS
[UnaryOp] -> ShowS
UnaryOp -> String
(Int -> UnaryOp -> ShowS)
-> (UnaryOp -> String) -> ([UnaryOp] -> ShowS) -> Show UnaryOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnaryOp] -> ShowS
$cshowList :: [UnaryOp] -> ShowS
show :: UnaryOp -> String
$cshow :: UnaryOp -> String
showsPrec :: Int -> UnaryOp -> ShowS
$cshowsPrec :: Int -> UnaryOp -> ShowS
Show, UnaryOp -> UnaryOp -> Bool
(UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool) -> Eq UnaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnaryOp -> UnaryOp -> Bool
$c/= :: UnaryOp -> UnaryOp -> Bool
== :: UnaryOp -> UnaryOp -> Bool
$c== :: UnaryOp -> UnaryOp -> Bool
Eq)

data StmtAnnot a = SA
  { StmtAnnot a -> a
annot   :: a
  , StmtAnnot a -> Stmt a
unAnnot :: Stmt a
  }
  deriving ((forall x. StmtAnnot a -> Rep (StmtAnnot a) x)
-> (forall x. Rep (StmtAnnot a) x -> StmtAnnot a)
-> Generic (StmtAnnot a)
forall x. Rep (StmtAnnot a) x -> StmtAnnot a
forall x. StmtAnnot a -> Rep (StmtAnnot a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (StmtAnnot a) x -> StmtAnnot a
forall a x. StmtAnnot a -> Rep (StmtAnnot a) x
$cto :: forall a x. Rep (StmtAnnot a) x -> StmtAnnot a
$cfrom :: forall a x. StmtAnnot a -> Rep (StmtAnnot a) x
Generic, Int -> StmtAnnot a -> ShowS
[StmtAnnot a] -> ShowS
StmtAnnot a -> String
(Int -> StmtAnnot a -> ShowS)
-> (StmtAnnot a -> String)
-> ([StmtAnnot a] -> ShowS)
-> Show (StmtAnnot a)
forall a. Show a => Int -> StmtAnnot a -> ShowS
forall a. Show a => [StmtAnnot a] -> ShowS
forall a. Show a => StmtAnnot a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StmtAnnot a] -> ShowS
$cshowList :: forall a. Show a => [StmtAnnot a] -> ShowS
show :: StmtAnnot a -> String
$cshow :: forall a. Show a => StmtAnnot a -> String
showsPrec :: Int -> StmtAnnot a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StmtAnnot a -> ShowS
Show, StmtAnnot a -> StmtAnnot a -> Bool
(StmtAnnot a -> StmtAnnot a -> Bool)
-> (StmtAnnot a -> StmtAnnot a -> Bool) -> Eq (StmtAnnot a)
forall a. Eq a => StmtAnnot a -> StmtAnnot a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StmtAnnot a -> StmtAnnot a -> Bool
$c/= :: forall a. Eq a => StmtAnnot a -> StmtAnnot a -> Bool
== :: StmtAnnot a -> StmtAnnot a -> Bool
$c== :: forall a. Eq a => StmtAnnot a -> StmtAnnot a -> Bool
Eq, a -> StmtAnnot b -> StmtAnnot a
(a -> b) -> StmtAnnot a -> StmtAnnot b
(forall a b. (a -> b) -> StmtAnnot a -> StmtAnnot b)
-> (forall a b. a -> StmtAnnot b -> StmtAnnot a)
-> Functor StmtAnnot
forall a b. a -> StmtAnnot b -> StmtAnnot a
forall a b. (a -> b) -> StmtAnnot a -> StmtAnnot b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StmtAnnot b -> StmtAnnot a
$c<$ :: forall a b. a -> StmtAnnot b -> StmtAnnot a
fmap :: (a -> b) -> StmtAnnot a -> StmtAnnot b
$cfmap :: forall a b. (a -> b) -> StmtAnnot a -> StmtAnnot b
Functor, StmtAnnot a -> Bool
(a -> m) -> StmtAnnot a -> m
(a -> b -> b) -> b -> StmtAnnot a -> b
(forall m. Monoid m => StmtAnnot m -> m)
-> (forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m)
-> (forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m)
-> (forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b)
-> (forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b)
-> (forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b)
-> (forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b)
-> (forall a. (a -> a -> a) -> StmtAnnot a -> a)
-> (forall a. (a -> a -> a) -> StmtAnnot a -> a)
-> (forall a. StmtAnnot a -> [a])
-> (forall a. StmtAnnot a -> Bool)
-> (forall a. StmtAnnot a -> Int)
-> (forall a. Eq a => a -> StmtAnnot a -> Bool)
-> (forall a. Ord a => StmtAnnot a -> a)
-> (forall a. Ord a => StmtAnnot a -> a)
-> (forall a. Num a => StmtAnnot a -> a)
-> (forall a. Num a => StmtAnnot a -> a)
-> Foldable StmtAnnot
forall a. Eq a => a -> StmtAnnot a -> Bool
forall a. Num a => StmtAnnot a -> a
forall a. Ord a => StmtAnnot a -> a
forall m. Monoid m => StmtAnnot m -> m
forall a. StmtAnnot a -> Bool
forall a. StmtAnnot a -> Int
forall a. StmtAnnot a -> [a]
forall a. (a -> a -> a) -> StmtAnnot a -> a
forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m
forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b
forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: StmtAnnot a -> a
$cproduct :: forall a. Num a => StmtAnnot a -> a
sum :: StmtAnnot a -> a
$csum :: forall a. Num a => StmtAnnot a -> a
minimum :: StmtAnnot a -> a
$cminimum :: forall a. Ord a => StmtAnnot a -> a
maximum :: StmtAnnot a -> a
$cmaximum :: forall a. Ord a => StmtAnnot a -> a
elem :: a -> StmtAnnot a -> Bool
$celem :: forall a. Eq a => a -> StmtAnnot a -> Bool
length :: StmtAnnot a -> Int
$clength :: forall a. StmtAnnot a -> Int
null :: StmtAnnot a -> Bool
$cnull :: forall a. StmtAnnot a -> Bool
toList :: StmtAnnot a -> [a]
$ctoList :: forall a. StmtAnnot a -> [a]
foldl1 :: (a -> a -> a) -> StmtAnnot a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> StmtAnnot a -> a
foldr1 :: (a -> a -> a) -> StmtAnnot a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> StmtAnnot a -> a
foldl' :: (b -> a -> b) -> b -> StmtAnnot a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b
foldl :: (b -> a -> b) -> b -> StmtAnnot a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b
foldr' :: (a -> b -> b) -> b -> StmtAnnot a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b
foldr :: (a -> b -> b) -> b -> StmtAnnot a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b
foldMap' :: (a -> m) -> StmtAnnot a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m
foldMap :: (a -> m) -> StmtAnnot a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m
fold :: StmtAnnot m -> m
$cfold :: forall m. Monoid m => StmtAnnot m -> m
Foldable, Functor StmtAnnot
Foldable StmtAnnot
Functor StmtAnnot
-> Foldable StmtAnnot
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> StmtAnnot a -> f (StmtAnnot b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    StmtAnnot (f a) -> f (StmtAnnot a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> StmtAnnot a -> m (StmtAnnot b))
-> (forall (m :: * -> *) a.
    Monad m =>
    StmtAnnot (m a) -> m (StmtAnnot a))
-> Traversable StmtAnnot
(a -> f b) -> StmtAnnot a -> f (StmtAnnot b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
StmtAnnot (m a) -> m (StmtAnnot a)
forall (f :: * -> *) a.
Applicative f =>
StmtAnnot (f a) -> f (StmtAnnot a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StmtAnnot a -> m (StmtAnnot b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StmtAnnot a -> f (StmtAnnot b)
sequence :: StmtAnnot (m a) -> m (StmtAnnot a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
StmtAnnot (m a) -> m (StmtAnnot a)
mapM :: (a -> m b) -> StmtAnnot a -> m (StmtAnnot b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StmtAnnot a -> m (StmtAnnot b)
sequenceA :: StmtAnnot (f a) -> f (StmtAnnot a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
StmtAnnot (f a) -> f (StmtAnnot a)
traverse :: (a -> f b) -> StmtAnnot a -> f (StmtAnnot b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StmtAnnot a -> f (StmtAnnot b)
$cp2Traversable :: Foldable StmtAnnot
$cp1Traversable :: Functor StmtAnnot
Traversable)

instance Applicative StmtAnnot where
  pure :: a -> StmtAnnot a
pure a
a = a -> Stmt a -> StmtAnnot a
forall a. a -> Stmt a -> StmtAnnot a
SA a
a (a -> Stmt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
  liftA2 :: (a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c
liftA2 a -> b -> c
f StmtAnnot a
a StmtAnnot b
b = c -> Stmt c -> StmtAnnot c
forall a. a -> Stmt a -> StmtAnnot a
SA (a -> b -> c
f (StmtAnnot a -> a
forall a. StmtAnnot a -> a
annot StmtAnnot a
a) (StmtAnnot b -> b
forall a. StmtAnnot a -> a
annot StmtAnnot b
b)) (Stmt c -> StmtAnnot c) -> Stmt c -> StmtAnnot c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> Stmt a -> Stmt b -> Stmt c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (StmtAnnot a -> Stmt a
forall a. StmtAnnot a -> Stmt a
unAnnot StmtAnnot a
a) (StmtAnnot b -> Stmt b
forall a. StmtAnnot a -> Stmt a
unAnnot StmtAnnot b
b)

data Stmt a
  = AssignStmt Name Expr
  | DeclStmt LocalDecl
  | EmitStmt Emit
  | IfStmt NameId [StmtAnnot a] [StmtAnnot a]
  deriving ((forall x. Stmt a -> Rep (Stmt a) x)
-> (forall x. Rep (Stmt a) x -> Stmt a) -> Generic (Stmt a)
forall x. Rep (Stmt a) x -> Stmt a
forall x. Stmt a -> Rep (Stmt a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Stmt a) x -> Stmt a
forall a x. Stmt a -> Rep (Stmt a) x
$cto :: forall a x. Rep (Stmt a) x -> Stmt a
$cfrom :: forall a x. Stmt a -> Rep (Stmt a) x
Generic, Int -> Stmt a -> ShowS
[Stmt a] -> ShowS
Stmt a -> String
(Int -> Stmt a -> ShowS)
-> (Stmt a -> String) -> ([Stmt a] -> ShowS) -> Show (Stmt a)
forall a. Show a => Int -> Stmt a -> ShowS
forall a. Show a => [Stmt a] -> ShowS
forall a. Show a => Stmt a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stmt a] -> ShowS
$cshowList :: forall a. Show a => [Stmt a] -> ShowS
show :: Stmt a -> String
$cshow :: forall a. Show a => Stmt a -> String
showsPrec :: Int -> Stmt a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stmt a -> ShowS
Show, Stmt a -> Stmt a -> Bool
(Stmt a -> Stmt a -> Bool)
-> (Stmt a -> Stmt a -> Bool) -> Eq (Stmt a)
forall a. Eq a => Stmt a -> Stmt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stmt a -> Stmt a -> Bool
$c/= :: forall a. Eq a => Stmt a -> Stmt a -> Bool
== :: Stmt a -> Stmt a -> Bool
$c== :: forall a. Eq a => Stmt a -> Stmt a -> Bool
Eq, a -> Stmt b -> Stmt a
(a -> b) -> Stmt a -> Stmt b
(forall a b. (a -> b) -> Stmt a -> Stmt b)
-> (forall a b. a -> Stmt b -> Stmt a) -> Functor Stmt
forall a b. a -> Stmt b -> Stmt a
forall a b. (a -> b) -> Stmt a -> Stmt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Stmt b -> Stmt a
$c<$ :: forall a b. a -> Stmt b -> Stmt a
fmap :: (a -> b) -> Stmt a -> Stmt b
$cfmap :: forall a b. (a -> b) -> Stmt a -> Stmt b
Functor, Stmt a -> Bool
(a -> m) -> Stmt a -> m
(a -> b -> b) -> b -> Stmt a -> b
(forall m. Monoid m => Stmt m -> m)
-> (forall m a. Monoid m => (a -> m) -> Stmt a -> m)
-> (forall m a. Monoid m => (a -> m) -> Stmt a -> m)
-> (forall a b. (a -> b -> b) -> b -> Stmt a -> b)
-> (forall a b. (a -> b -> b) -> b -> Stmt a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stmt a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stmt a -> b)
-> (forall a. (a -> a -> a) -> Stmt a -> a)
-> (forall a. (a -> a -> a) -> Stmt a -> a)
-> (forall a. Stmt a -> [a])
-> (forall a. Stmt a -> Bool)
-> (forall a. Stmt a -> Int)
-> (forall a. Eq a => a -> Stmt a -> Bool)
-> (forall a. Ord a => Stmt a -> a)
-> (forall a. Ord a => Stmt a -> a)
-> (forall a. Num a => Stmt a -> a)
-> (forall a. Num a => Stmt a -> a)
-> Foldable Stmt
forall a. Eq a => a -> Stmt a -> Bool
forall a. Num a => Stmt a -> a
forall a. Ord a => Stmt a -> a
forall m. Monoid m => Stmt m -> m
forall a. Stmt a -> Bool
forall a. Stmt a -> Int
forall a. Stmt a -> [a]
forall a. (a -> a -> a) -> Stmt a -> a
forall m a. Monoid m => (a -> m) -> Stmt a -> m
forall b a. (b -> a -> b) -> b -> Stmt a -> b
forall a b. (a -> b -> b) -> b -> Stmt a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Stmt a -> a
$cproduct :: forall a. Num a => Stmt a -> a
sum :: Stmt a -> a
$csum :: forall a. Num a => Stmt a -> a
minimum :: Stmt a -> a
$cminimum :: forall a. Ord a => Stmt a -> a
maximum :: Stmt a -> a
$cmaximum :: forall a. Ord a => Stmt a -> a
elem :: a -> Stmt a -> Bool
$celem :: forall a. Eq a => a -> Stmt a -> Bool
length :: Stmt a -> Int
$clength :: forall a. Stmt a -> Int
null :: Stmt a -> Bool
$cnull :: forall a. Stmt a -> Bool
toList :: Stmt a -> [a]
$ctoList :: forall a. Stmt a -> [a]
foldl1 :: (a -> a -> a) -> Stmt a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Stmt a -> a
foldr1 :: (a -> a -> a) -> Stmt a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Stmt a -> a
foldl' :: (b -> a -> b) -> b -> Stmt a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Stmt a -> b
foldl :: (b -> a -> b) -> b -> Stmt a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Stmt a -> b
foldr' :: (a -> b -> b) -> b -> Stmt a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Stmt a -> b
foldr :: (a -> b -> b) -> b -> Stmt a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Stmt a -> b
foldMap' :: (a -> m) -> Stmt a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Stmt a -> m
foldMap :: (a -> m) -> Stmt a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Stmt a -> m
fold :: Stmt m -> m
$cfold :: forall m. Monoid m => Stmt m -> m
Foldable, Functor Stmt
Foldable Stmt
Functor Stmt
-> Foldable Stmt
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Stmt a -> f (Stmt b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Stmt (f a) -> f (Stmt a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Stmt a -> m (Stmt b))
-> (forall (m :: * -> *) a. Monad m => Stmt (m a) -> m (Stmt a))
-> Traversable Stmt
(a -> f b) -> Stmt a -> f (Stmt b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Stmt (m a) -> m (Stmt a)
forall (f :: * -> *) a. Applicative f => Stmt (f a) -> f (Stmt a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stmt a -> m (Stmt b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stmt a -> f (Stmt b)
sequence :: Stmt (m a) -> m (Stmt a)
$csequence :: forall (m :: * -> *) a. Monad m => Stmt (m a) -> m (Stmt a)
mapM :: (a -> m b) -> Stmt a -> m (Stmt b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stmt a -> m (Stmt b)
sequenceA :: Stmt (f a) -> f (Stmt a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Stmt (f a) -> f (Stmt a)
traverse :: (a -> f b) -> Stmt a -> f (Stmt b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stmt a -> f (Stmt b)
$cp2Traversable :: Foldable Stmt
$cp1Traversable :: Functor Stmt
Traversable)

instance Applicative Stmt where
  -- Arbitrary decision because "pure" doesn't really make sense.
  pure :: a -> Stmt a
pure a
_ = Emit -> Stmt a
forall a. Emit -> Stmt a
EmitStmt Emit
EmitFragDepth

  liftA2 :: (a -> b -> c) -> Stmt a -> Stmt b -> Stmt c
liftA2 a -> b -> c
f (IfStmt NameId
n [StmtAnnot a]
t1 [StmtAnnot a]
e1) (IfStmt NameId
_ [StmtAnnot b]
t2 [StmtAnnot b]
e2) = NameId -> [StmtAnnot c] -> [StmtAnnot c] -> Stmt c
forall a. NameId -> [StmtAnnot a] -> [StmtAnnot a] -> Stmt a
IfStmt NameId
n
    (((StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
-> [StmtAnnot a] -> [StmtAnnot b] -> [StmtAnnot c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
 -> [StmtAnnot a] -> [StmtAnnot b] -> [StmtAnnot c])
-> ((a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
-> (a -> b -> c)
-> [StmtAnnot a]
-> [StmtAnnot b]
-> [StmtAnnot c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2) a -> b -> c
f [StmtAnnot a]
t1 [StmtAnnot b]
t2)
    (((StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
-> [StmtAnnot a] -> [StmtAnnot b] -> [StmtAnnot c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
 -> [StmtAnnot a] -> [StmtAnnot b] -> [StmtAnnot c])
-> ((a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
-> (a -> b -> c)
-> [StmtAnnot a]
-> [StmtAnnot b]
-> [StmtAnnot c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2) a -> b -> c
f [StmtAnnot a]
e1 [StmtAnnot b]
e2)
  liftA2 a -> b -> c
_ (AssignStmt Name
n Expr
e) Stmt b
_ = Name -> Expr -> Stmt c
forall a. Name -> Expr -> Stmt a
AssignStmt Name
n Expr
e
  liftA2 a -> b -> c
_ (DeclStmt LocalDecl
d) Stmt b
_ = LocalDecl -> Stmt c
forall a. LocalDecl -> Stmt a
DeclStmt LocalDecl
d
  liftA2 a -> b -> c
_ (EmitStmt Emit
e) Stmt b
_ = Emit -> Stmt c
forall a. Emit -> Stmt a
EmitStmt Emit
e
  liftA2 a -> b -> c
_ (IfStmt NameId
n [StmtAnnot a]
_ [StmtAnnot a]
_) Stmt b
_ = NameId -> [StmtAnnot c] -> [StmtAnnot c] -> Stmt c
forall a. NameId -> [StmtAnnot a] -> [StmtAnnot a] -> Stmt a
IfStmt NameId
n [] []


data Emit
  = EmitPosition Expr
  | EmitFragDepth
  deriving ((forall x. Emit -> Rep Emit x)
-> (forall x. Rep Emit x -> Emit) -> Generic Emit
forall x. Rep Emit x -> Emit
forall x. Emit -> Rep Emit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Emit x -> Emit
$cfrom :: forall x. Emit -> Rep Emit x
Generic, Int -> Emit -> ShowS
[Emit] -> ShowS
Emit -> String
(Int -> Emit -> ShowS)
-> (Emit -> String) -> ([Emit] -> ShowS) -> Show Emit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Emit] -> ShowS
$cshowList :: [Emit] -> ShowS
show :: Emit -> String
$cshow :: Emit -> String
showsPrec :: Int -> Emit -> ShowS
$cshowsPrec :: Int -> Emit -> ShowS
Show, Emit -> Emit -> Bool
(Emit -> Emit -> Bool) -> (Emit -> Emit -> Bool) -> Eq Emit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Emit -> Emit -> Bool
$c/= :: Emit -> Emit -> Bool
== :: Emit -> Emit -> Bool
$c== :: Emit -> Emit -> Bool
Eq)


class Annot a where
  parseAnnot :: Parser a
  ppAnnot :: a -> Maybe LTB.Builder

instance Annot () where
  parseAnnot :: Parser ()
parseAnnot = () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  ppAnnot :: () -> Maybe Builder
ppAnnot = Maybe Builder -> () -> Maybe Builder
forall a b. a -> b -> a
const Maybe Builder
forall a. Maybe a
Nothing

instance (Annot a, Annot b) => Annot (a, b) where
  parseAnnot :: Parser (a, b)
parseAnnot = String -> Parser (a, b)
forall a. HasCallStack => String -> a
error String
"not implemented"
  ppAnnot :: (a, b) -> Maybe Builder
ppAnnot (a
a, b
b) = do
    Builder
ppA <- a -> Maybe Builder
forall a. Annot a => a -> Maybe Builder
ppAnnot a
a
    Builder
ppB <- b -> Maybe Builder
forall a. Annot a => a -> Maybe Builder
ppAnnot b
b
    Builder -> Maybe Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ppA Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ppB Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

----------------------------------

argCountForFunName :: FunName -> Int
argCountForFunName :: FunName -> Int
argCountForFunName FunName
PrimAbs        = Int
1
argCountForFunName FunName
PrimAsin       = Int
1
argCountForFunName FunName
PrimAtan       = Int
2
argCountForFunName FunName
PrimCos        = Int
1
argCountForFunName FunName
PrimCross      = Int
2
argCountForFunName FunName
PrimDot        = Int
2
argCountForFunName FunName
PrimFloor      = Int
1
argCountForFunName FunName
PrimFract      = Int
1
argCountForFunName FunName
PrimLength     = Int
1
argCountForFunName FunName
PrimMat3x3     = Int
3
argCountForFunName FunName
PrimMat4x4     = Int
4
argCountForFunName FunName
PrimMod        = Int
2
argCountForFunName FunName
PrimNormalize  = Int
1
argCountForFunName FunName
PrimPow        = Int
2
argCountForFunName FunName
PrimSin        = Int
1
argCountForFunName FunName
PrimSmoothstep = Int
3
argCountForFunName FunName
PrimSqrt       = Int
1
argCountForFunName FunName
PrimStep       = Int
2
argCountForFunName FunName
PrimTan        = Int
1
argCountForFunName FunName
PrimVec2       = Int
2
argCountForFunName FunName
PrimVec3       = Int
3
argCountForFunName FunName
PrimVec4       = Int
4

isLitExpr :: ExprAtom -> Bool
isLitExpr :: ExprAtom -> Bool
isLitExpr LitFloatExpr{} = Bool
True
isLitExpr LitIntExpr{}   = Bool
True
isLitExpr ExprAtom
_              = Bool
False

isIdentifierExpr :: ExprAtom -> Bool
isIdentifierExpr :: ExprAtom -> Bool
isIdentifierExpr IdentifierExpr{} = Bool
True
isIdentifierExpr ExprAtom
_                = Bool
False