module Language.GLSL.ConstExpr
  ( ConstExprs
  , collectConstExprs
  , isConstExpr
  , empty
  ) where

import qualified Data.IntSet       as S
import           Language.GLSL.AST


newtype ConstExprs = ConstExprs S.IntSet

empty :: ConstExprs
empty :: ConstExprs
empty = IntSet -> ConstExprs
ConstExprs IntSet
S.empty

collectConstExprs :: [StmtAnnot a] -> ConstExprs
collectConstExprs :: [StmtAnnot a] -> ConstExprs
collectConstExprs = IntSet -> ConstExprs
ConstExprs (IntSet -> ConstExprs)
-> ([StmtAnnot a] -> IntSet) -> [StmtAnnot a] -> ConstExprs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StmtAnnot a -> IntSet -> IntSet)
-> IntSet -> [StmtAnnot a] -> IntSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Stmt a -> IntSet -> IntSet
forall a. Stmt a -> IntSet -> IntSet
add (Stmt a -> IntSet -> IntSet)
-> (StmtAnnot a -> Stmt a) -> StmtAnnot a -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StmtAnnot a -> Stmt a
forall a. StmtAnnot a -> Stmt a
unAnnot) IntSet
S.empty
  where
    add :: Stmt a -> S.IntSet -> S.IntSet
    add :: Stmt a -> IntSet -> IntSet
add (AssignStmt (Name Namespace
NsT (NameId Int
n)) Expr
e) IntSet
s
      | ConstExprs -> Expr -> Bool
isConstExpr (IntSet -> ConstExprs
ConstExprs IntSet
s) Expr
e = Int -> IntSet -> IntSet
S.insert Int
n IntSet
s
    add Stmt a
_ IntSet
s = IntSet
s


isConstExpr :: ConstExprs -> Expr -> Bool
isConstExpr :: ConstExprs -> Expr -> Bool
isConstExpr ConstExprs
ce (BinaryExpr ExprAtom
l BinaryOp
BOpMul ExprAtom
r) =
  (ExprAtom -> Bool) -> [ExprAtom] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ExprAtom -> Bool
isZero [ExprAtom
l, ExprAtom
r] Bool -> Bool -> Bool
|| (ExprAtom -> Bool) -> [ExprAtom] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ConstExprs -> ExprAtom -> Bool
isConstExprAtom ConstExprs
ce) [ExprAtom
l, ExprAtom
r]

isConstExpr ConstExprs
ce (AtomExpr ExprAtom
e)         = ConstExprs -> ExprAtom -> Bool
isConstExprAtom ConstExprs
ce ExprAtom
e
isConstExpr ConstExprs
ce (UnaryExpr UnaryOp
_ ExprAtom
e)      = ConstExprs -> ExprAtom -> Bool
isConstExprAtom ConstExprs
ce ExprAtom
e
isConstExpr ConstExprs
ce (BinaryExpr ExprAtom
l BinaryOp
_ ExprAtom
r)   = (ExprAtom -> Bool) -> [ExprAtom] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ConstExprs -> ExprAtom -> Bool
isConstExprAtom ConstExprs
ce) [ExprAtom
l, ExprAtom
r]
isConstExpr ConstExprs
ce (FunCallExpr FunName
_ [ExprAtom]
args) = (ExprAtom -> Bool) -> [ExprAtom] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ConstExprs -> ExprAtom -> Bool
isConstExprAtom ConstExprs
ce) [ExprAtom]
args
isConstExpr ConstExprs
_ TextureExpr{}         = Bool
False


isConstExprAtom :: ConstExprs -> ExprAtom -> Bool
isConstExprAtom :: ConstExprs -> ExprAtom -> Bool
isConstExprAtom (ConstExprs IntSet
ce) (IdentifierExpr (NameExpr (Name Namespace
NsT (NameId Int
n)))) =
  Int -> IntSet -> Bool
S.member Int
n IntSet
ce

isConstExprAtom ConstExprs
_ LitIntExpr{}   = Bool
True
isConstExprAtom ConstExprs
_ LitFloatExpr{} = Bool
True
isConstExprAtom ConstExprs
_ ExprAtom
_              = Bool
False


isZero :: ExprAtom -> Bool
isZero :: ExprAtom -> Bool
isZero (LitIntExpr Cast
_ Int
0)   = Bool
True
isZero (LitFloatExpr Cast
_ Float
0) = Bool
True
isZero ExprAtom
_                  = Bool
False