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

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


eqStmtAnnots :: ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
eqStmtAnnots :: ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
eqStmtAnnots 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 (ConstExprs -> StmtAnnot a -> StmtAnnot a -> Bool
forall a. ConstExprs -> StmtAnnot a -> StmtAnnot a -> Bool
eqStmtAnnot ConstExprs
ce))

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


eqStmt :: ConstExprs -> Stmt a -> Stmt a -> Bool
eqStmt :: ConstExprs -> Stmt a -> Stmt a -> Bool
eqStmt ConstExprs
ce (AssignStmt Name
_ Expr
ea) (AssignStmt Name
_ Expr
eb) =
  -- 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).
  ConstExprs -> Expr -> Bool
isConstExpr ConstExprs
ce Expr
ea Bool -> Bool -> Bool
&& ConstExprs -> Expr -> Bool
isConstExpr ConstExprs
ce Expr
eb Bool -> Bool -> Bool
||
  Expr -> Expr -> Bool
eqExpr Expr
ea Expr
eb
eqStmt ConstExprs
_ (DeclStmt LocalDecl
da) (DeclStmt LocalDecl
db) =
  LocalDecl -> LocalDecl -> Bool
eqLocalDecl LocalDecl
da LocalDecl
db
eqStmt ConstExprs
_ (EmitStmt Emit
ea) (EmitStmt Emit
eb) =
  Emit -> Emit -> Bool
eqEmit Emit
ea Emit
eb
eqStmt ConstExprs
ce (IfStmt NameId
_ [StmtAnnot a]
ta [StmtAnnot a]
ea) (IfStmt NameId
_ [StmtAnnot a]
tb [StmtAnnot a]
eb) =
  ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
forall a. ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
eqStmtAnnots 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
&&
  ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
forall a. ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
eqStmtAnnots 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 ConstExprs
_ Stmt a
_ Stmt a
_ = Bool
False


eqExpr :: Expr -> Expr -> Bool
eqExpr :: Expr -> Expr -> Bool
eqExpr (AtomExpr ExprAtom
ea) (AtomExpr ExprAtom
eb) =
  ExprAtom -> ExprAtom -> Bool
eqExprAtom ExprAtom
ea ExprAtom
eb
eqExpr (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 (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, 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 (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 (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 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 :: NameExpr -> NameExpr -> Bool
eqNameExpr (UniformExpr NameId
na NameId
ma) (UniformExpr NameId
nb NameId
mb) = NameId
na NameId -> NameId -> Bool
forall a. Eq a => a -> a -> Bool
== NameId
nb Bool -> Bool -> Bool
&& NameId
ma NameId -> NameId -> Bool
forall a. Eq a => a -> a -> Bool
== NameId
mb
-- eqName (Name NsT _) (Name NsT _)   = True
-- eqName (Name nsa na) (Name nsb nb) = nsa == nsb && na == nb
eqNameExpr NameExpr
_ NameExpr
_                                     = Bool
True

eqLocalDecl :: LocalDecl -> LocalDecl -> Bool
eqLocalDecl :: LocalDecl -> LocalDecl -> Bool
eqLocalDecl (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 Expr -> Expr -> Bool
eqExpr 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 :: Emit -> Emit -> Bool
eqEmit :: Emit -> Emit -> Bool
eqEmit (EmitPosition Expr
a) (EmitPosition Expr
b) = Expr -> Expr -> Bool
eqExpr Expr
a Expr
b
eqEmit Emit
EmitFragDepth Emit
EmitFragDepth       = Bool
True
eqEmit 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