-- | Structural equality, ignoring the variable names.
module Language.GLSL.StructuralEquality where

import           Language.GLSL.AST
import           Language.GLSL.ConstExpr (ConstExprs, isConstExpr)


eqStmtAnnots :: Maybe ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
eqStmtAnnots :: Maybe ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
eqStmtAnnots Maybe ConstExprs
ce = ((StmtAnnot a, StmtAnnot a) -> Bool)
-> [(StmtAnnot a, StmtAnnot a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((StmtAnnot a -> StmtAnnot a -> Bool)
-> (StmtAnnot a, StmtAnnot a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe ConstExprs -> StmtAnnot a -> StmtAnnot a -> Bool
forall a. Maybe ConstExprs -> StmtAnnot a -> StmtAnnot a -> Bool
eqStmtAnnot Maybe ConstExprs
ce))

eqStmtAnnot :: Maybe ConstExprs -> StmtAnnot a -> StmtAnnot a -> Bool
eqStmtAnnot :: Maybe ConstExprs -> StmtAnnot a -> StmtAnnot a -> Bool
eqStmtAnnot Maybe ConstExprs
ce (SA a
_ Stmt a
a) (SA a
_ Stmt a
b) = Maybe ConstExprs -> Stmt a -> Stmt a -> Bool
forall a. Maybe ConstExprs -> Stmt a -> Stmt a -> Bool
eqStmt Maybe ConstExprs
ce Stmt a
a Stmt a
b


eqStmt :: Maybe ConstExprs -> Stmt a -> Stmt a -> Bool
eqStmt :: Maybe ConstExprs -> Stmt a -> Stmt a -> Bool
eqStmt Maybe ConstExprs
ce (AssignStmt Name
_ Expr
ea) (AssignStmt Name
_ Expr
eb) =
  Maybe ConstExprs -> Expr -> Expr -> Bool
eqExpr Maybe ConstExprs
ce Expr
ea Expr
eb
eqStmt Maybe ConstExprs
ce (DeclStmt LocalDecl
da) (DeclStmt LocalDecl
db) =
  Maybe ConstExprs -> LocalDecl -> LocalDecl -> Bool
eqLocalDecl Maybe ConstExprs
ce LocalDecl
da LocalDecl
db
eqStmt Maybe ConstExprs
ce (EmitStmt Emit
ea) (EmitStmt Emit
eb) =
  Maybe ConstExprs -> Emit -> Emit -> Bool
eqEmit Maybe ConstExprs
ce Emit
ea Emit
eb
eqStmt Maybe ConstExprs
ce (IfStmt NameId
_ [StmtAnnot a]
ta [StmtAnnot a]
ea) (IfStmt NameId
_ [StmtAnnot a]
tb [StmtAnnot a]
eb) =
  [StmtAnnot a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StmtAnnot a]
ta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [StmtAnnot a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StmtAnnot a]
tb Bool -> Bool -> Bool
&&
  [StmtAnnot a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StmtAnnot a]
ea Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [StmtAnnot a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StmtAnnot a]
eb Bool -> Bool -> Bool
&&
  Maybe ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
forall a. Maybe ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
eqStmtAnnots Maybe ConstExprs
ce ([StmtAnnot a] -> [StmtAnnot a] -> [(StmtAnnot a, StmtAnnot a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [StmtAnnot a]
ta [StmtAnnot a]
tb) Bool -> Bool -> Bool
&&
  Maybe ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
forall a. Maybe ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
eqStmtAnnots Maybe ConstExprs
ce ([StmtAnnot a] -> [StmtAnnot a] -> [(StmtAnnot a, StmtAnnot a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [StmtAnnot a]
ea [StmtAnnot a]
eb)
eqStmt Maybe ConstExprs
_ Stmt a
_ Stmt a
_ = Bool
False


eqExpr :: Maybe ConstExprs -> Expr -> Expr -> Bool
-- We consider constant expressions to be equal, since we can just pass that
-- constant into the function as an argument. Most of the time, it's small
-- things like 1.0 or (-1.0) (possibly in a t-var, hence the ConstExprs set).
eqExpr :: Maybe ConstExprs -> Expr -> Expr -> Bool
eqExpr (Just ConstExprs
ce) Expr
a Expr
b | ConstExprs -> Expr -> Bool
isConstExpr ConstExprs
ce Expr
a Bool -> Bool -> Bool
&& ConstExprs -> Expr -> Bool
isConstExpr ConstExprs
ce Expr
b = Bool
True
eqExpr Maybe ConstExprs
_ (AtomExpr ExprAtom
ea) (AtomExpr ExprAtom
eb) =
  ExprAtom -> ExprAtom -> Bool
eqExprAtom ExprAtom
ea ExprAtom
eb
eqExpr Maybe ConstExprs
_ (UnaryExpr UnaryOp
ua ExprAtom
ea) (UnaryExpr UnaryOp
ub ExprAtom
eb) =
  UnaryOp
ua UnaryOp -> UnaryOp -> Bool
forall a. Eq a => a -> a -> Bool
== UnaryOp
ub Bool -> Bool -> Bool
&&
  ExprAtom -> ExprAtom -> Bool
eqExprAtom ExprAtom
ea ExprAtom
eb
eqExpr Maybe ConstExprs
_ (FunCallExpr FunName
fa [ExprAtom]
aa) (FunCallExpr FunName
fb [ExprAtom]
ab) =
  FunName
fa FunName -> FunName -> Bool
forall a. Eq a => a -> a -> Bool
== FunName
fb Bool -> Bool -> Bool
&&
  [ExprAtom] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExprAtom]
aa Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [ExprAtom] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExprAtom]
ab Bool -> Bool -> Bool
&&
  ((ExprAtom, ExprAtom) -> Bool) -> [(ExprAtom, ExprAtom)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((ExprAtom -> ExprAtom -> Bool) -> (ExprAtom, ExprAtom) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ExprAtom -> ExprAtom -> Bool
eqExprAtom) ([ExprAtom] -> [ExprAtom] -> [(ExprAtom, ExprAtom)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ExprAtom]
aa [ExprAtom]
ab)
eqExpr Maybe ConstExprs
_ (TextureExpr ExprAtom
ta ExprAtom
xa ExprAtom
ya) (TextureExpr ExprAtom
tb ExprAtom
xb ExprAtom
yb) =
  ((ExprAtom, ExprAtom) -> Bool) -> [(ExprAtom, ExprAtom)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((ExprAtom -> ExprAtom -> Bool) -> (ExprAtom, ExprAtom) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ExprAtom -> ExprAtom -> Bool
eqExprAtom) [(ExprAtom
ta, ExprAtom
tb), (ExprAtom
xa, ExprAtom
xb), (ExprAtom
ya, ExprAtom
yb)]
eqExpr Maybe ConstExprs
_ (BinaryExpr ExprAtom
la BinaryOp
oa ExprAtom
ra) (BinaryExpr ExprAtom
lb BinaryOp
ob ExprAtom
rb) =
  BinaryOp
oa BinaryOp -> BinaryOp -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryOp
ob Bool -> Bool -> Bool
&&
  ExprAtom -> ExprAtom -> Bool
eqExprAtom ExprAtom
la ExprAtom
lb Bool -> Bool -> Bool
&&
  ExprAtom -> ExprAtom -> Bool
eqExprAtom ExprAtom
ra ExprAtom
rb
eqExpr Maybe ConstExprs
_ Expr
_ Expr
_ =
  Bool
False


eqExprAtom :: ExprAtom -> ExprAtom -> Bool
eqExprAtom :: ExprAtom -> ExprAtom -> Bool
eqExprAtom (LitIntExpr Cast
_ Int
_) (LitIntExpr Cast
_ Int
_)             = Bool
True
eqExprAtom (LitIntExpr Cast
_ Int
_) (LitFloatExpr Cast
_ Float
_)           = Bool
True
eqExprAtom (LitFloatExpr Cast
_ Float
_) (LitFloatExpr Cast
_ Float
_)         = Bool
True
eqExprAtom (LitFloatExpr Cast
_ Float
_) (LitIntExpr Cast
_ Int
_)           = Bool
True
eqExprAtom (IdentifierExpr NameExpr
a) (IdentifierExpr NameExpr
b)         = NameExpr -> NameExpr -> Bool
eqNameExpr NameExpr
a NameExpr
b
eqExprAtom (SwizzleExpr NameId
_ Swizzle
a) (SwizzleExpr NameId
_ Swizzle
b)           = Swizzle
a Swizzle -> Swizzle -> Bool
forall a. Eq a => a -> a -> Bool
== Swizzle
b
eqExprAtom (VecIndexExpr NameExpr
_ Swizzle
ia) (VecIndexExpr NameExpr
_ Swizzle
ib)       = Swizzle
ia Swizzle -> Swizzle -> Bool
forall a. Eq a => a -> a -> Bool
== Swizzle
ib
eqExprAtom (MatIndexExpr NameExpr
_ Swizzle
ia Swizzle
ja) (MatIndexExpr NameExpr
_ Swizzle
ib Swizzle
jb) = Swizzle
ia Swizzle -> Swizzle -> Bool
forall a. Eq a => a -> a -> Bool
== Swizzle
ib Bool -> Bool -> Bool
&& Swizzle
ja Swizzle -> Swizzle -> Bool
forall a. Eq a => a -> a -> Bool
== Swizzle
jb
eqExprAtom ExprAtom
_ ExprAtom
_                                           = Bool
False

-- | All variable names are equal.
--
--   We used to ignore temporary names only, considering all other names as
--   globals and a fixed part of the code. This check is quite expensive and it
--   turns out that most of the time the global variables *are* the same. If
--   they are not, we'll need to pass them as arguments to our new function, but
--   this is rare enough so it won't increase the average function parameter
--   list length too much.
eqNameExpr :: NameExpr -> NameExpr -> Bool
-- eqNameExpr (UniformExpr na ma) (UniformExpr nb mb) = na == nb && ma == mb
-- eqName (Name NsT _) (Name NsT _)   = True
-- eqName (Name nsa na) (Name nsb nb) = nsa == nsb && na == nb
eqNameExpr :: NameExpr -> NameExpr -> Bool
eqNameExpr NameExpr
_ NameExpr
_                                     = Bool
True

eqLocalDecl :: Maybe ConstExprs -> LocalDecl -> LocalDecl -> Bool
eqLocalDecl :: Maybe ConstExprs -> LocalDecl -> LocalDecl -> Bool
eqLocalDecl Maybe ConstExprs
ce (LDecl Type
tya NameId
_ Maybe Expr
ea) (LDecl Type
tyb NameId
_ Maybe Expr
eb) =
  Type -> Type -> Bool
eqType Type
tya Type
tyb Bool -> Bool -> Bool
&& (Expr -> Expr -> Bool) -> Maybe Expr -> Maybe Expr -> Bool
forall a. (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
eqMaybe (Maybe ConstExprs -> Expr -> Expr -> Bool
eqExpr Maybe ConstExprs
ce) Maybe Expr
ea Maybe Expr
eb


eqType :: Type -> Type -> Bool
eqType :: Type -> Type -> Bool
eqType = Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
(==)


eqEmit :: Maybe ConstExprs -> Emit -> Emit -> Bool
eqEmit :: Maybe ConstExprs -> Emit -> Emit -> Bool
eqEmit Maybe ConstExprs
ce (EmitPosition Expr
a) (EmitPosition Expr
b) = Maybe ConstExprs -> Expr -> Expr -> Bool
eqExpr Maybe ConstExprs
ce Expr
a Expr
b
eqEmit Maybe ConstExprs
_ Emit
EmitFragDepth Emit
EmitFragDepth        = Bool
True
eqEmit Maybe ConstExprs
_ Emit
_ Emit
_                                = Bool
False


eqMaybe :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
eqMaybe :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
eqMaybe a -> a -> Bool
f (Just a
a) (Just a
b) = a -> a -> Bool
f a
a a
b
eqMaybe a -> a -> Bool
_ Maybe a
Nothing Maybe a
Nothing   = Bool
True
eqMaybe a -> a -> Bool
_ Maybe a
_ Maybe a
_               = Bool
False