-- For GHC version 7.10 or higher {-# LANGUAGE GADTs, KindSignatures, DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} module AbsJava ( Tree(..) , ProgramFile , Import , TypeDeclaration , ClassHeader , FieldDeclaration , MethodBody , LVarStatement , Body , Stm , DeclaratorName , VarDecl , VariableInits , ArrayInits , MethodDecl , Parameter , SelectionStm , ElseIfStm , JumpStm , GuardStm , Catch , IterStm , ForInit , Modifier , BasicType , TypeSpec , TypeName , BracketsOpt , Exp , SpecName , NewAlloc , ArrAcc , SpecExp , SpecExpNP , MthCall , FieldAcc , Args , DimExpr , Constant , Unary_operator , Assignment_op , Semi , Ident , Unsigned , Long , UnsignedLong , Hexadecimal , HexUnsigned , HexLong , HexUnsLong , Octal , OctalUnsigned , OctalLong , OctalUnsLong , JDouble , JFloat , JLongDouble , UnicodeChar , JChar , johnMajorEq , module ComposOpJava ) where import Prelude ((.), (>), (&&), (==)) import Prelude ((.), (>), (&&), (==)) import qualified Prelude as P import ComposOpJava data Tag = ProgramFile_ | Import_ | TypeDeclaration_ | ClassHeader_ | FieldDeclaration_ | MethodBody_ | LVarStatement_ | Body_ | Stm_ | DeclaratorName_ | VarDecl_ | VariableInits_ | ArrayInits_ | MethodDecl_ | Parameter_ | SelectionStm_ | ElseIfStm_ | JumpStm_ | GuardStm_ | Catch_ | IterStm_ | ForInit_ | Modifier_ | BasicType_ | TypeSpec_ | TypeName_ | BracketsOpt_ | Exp_ | SpecName_ | NewAlloc_ | ArrAcc_ | SpecExp_ | SpecExpNP_ | MthCall_ | FieldAcc_ | Args_ | DimExpr_ | Constant_ | Unary_operator_ | Assignment_op_ | Semi_ | Ident_ | Unsigned_ | Long_ | UnsignedLong_ | Hexadecimal_ | HexUnsigned_ | HexLong_ | HexUnsLong_ | Octal_ | OctalUnsigned_ | OctalLong_ | OctalUnsLong_ | JDouble_ | JFloat_ | JLongDouble_ | UnicodeChar_ | JChar_ type ProgramFile = Tree 'ProgramFile_ type Import = Tree 'Import_ type TypeDeclaration = Tree 'TypeDeclaration_ type ClassHeader = Tree 'ClassHeader_ type FieldDeclaration = Tree 'FieldDeclaration_ type MethodBody = Tree 'MethodBody_ type LVarStatement = Tree 'LVarStatement_ type Body = Tree 'Body_ type Stm = Tree 'Stm_ type DeclaratorName = Tree 'DeclaratorName_ type VarDecl = Tree 'VarDecl_ type VariableInits = Tree 'VariableInits_ type ArrayInits = Tree 'ArrayInits_ type MethodDecl = Tree 'MethodDecl_ type Parameter = Tree 'Parameter_ type SelectionStm = Tree 'SelectionStm_ type ElseIfStm = Tree 'ElseIfStm_ type JumpStm = Tree 'JumpStm_ type GuardStm = Tree 'GuardStm_ type Catch = Tree 'Catch_ type IterStm = Tree 'IterStm_ type ForInit = Tree 'ForInit_ type Modifier = Tree 'Modifier_ type BasicType = Tree 'BasicType_ type TypeSpec = Tree 'TypeSpec_ type TypeName = Tree 'TypeName_ type BracketsOpt = Tree 'BracketsOpt_ type Exp = Tree 'Exp_ type SpecName = Tree 'SpecName_ type NewAlloc = Tree 'NewAlloc_ type ArrAcc = Tree 'ArrAcc_ type SpecExp = Tree 'SpecExp_ type SpecExpNP = Tree 'SpecExpNP_ type MthCall = Tree 'MthCall_ type FieldAcc = Tree 'FieldAcc_ type Args = Tree 'Args_ type DimExpr = Tree 'DimExpr_ type Constant = Tree 'Constant_ type Unary_operator = Tree 'Unary_operator_ type Assignment_op = Tree 'Assignment_op_ type Semi = Tree 'Semi_ type Ident = Tree 'Ident_ type Unsigned = Tree 'Unsigned_ type Long = Tree 'Long_ type UnsignedLong = Tree 'UnsignedLong_ type Hexadecimal = Tree 'Hexadecimal_ type HexUnsigned = Tree 'HexUnsigned_ type HexLong = Tree 'HexLong_ type HexUnsLong = Tree 'HexUnsLong_ type Octal = Tree 'Octal_ type OctalUnsigned = Tree 'OctalUnsigned_ type OctalLong = Tree 'OctalLong_ type OctalUnsLong = Tree 'OctalUnsLong_ type JDouble = Tree 'JDouble_ type JFloat = Tree 'JFloat_ type JLongDouble = Tree 'JLongDouble_ type UnicodeChar = Tree 'UnicodeChar_ type JChar = Tree 'JChar_ data Tree (a :: Tag) where ProgF :: [Import] -> [TypeDeclaration] -> Tree 'ProgramFile_ Prpkg :: [Ident] -> [Semi] -> [Import] -> [TypeDeclaration] -> Tree 'ProgramFile_ ImportA :: [Ident] -> [Semi] -> Tree 'Import_ ImportN :: [Ident] -> [Semi] -> Tree 'Import_ TypeDecl :: ClassHeader -> [FieldDeclaration] -> Tree 'TypeDeclaration_ ClassDec :: [Modifier] -> Ident -> Tree 'ClassHeader_ ClassDecE :: [Modifier] -> Ident -> [TypeName] -> Tree 'ClassHeader_ ClassDecEI :: [Modifier] -> Ident -> [TypeName] -> [TypeName] -> Tree 'ClassHeader_ ClassDecI :: [Modifier] -> Ident -> [TypeName] -> Tree 'ClassHeader_ InterDec :: [Modifier] -> Ident -> Tree 'ClassHeader_ InterDecE :: [Modifier] -> Ident -> [TypeName] -> Tree 'ClassHeader_ InterDecEI :: [Modifier] -> Ident -> [TypeName] -> [TypeName] -> Tree 'ClassHeader_ InterDecI :: [Modifier] -> Ident -> [TypeName] -> Tree 'ClassHeader_ Dblk :: Body -> Tree 'FieldDeclaration_ Dconst :: [Modifier] -> Ident -> [Parameter] -> Body -> Tree 'FieldDeclaration_ Dconstt :: [Modifier] -> Ident -> [Parameter] -> [TypeName] -> Body -> Tree 'FieldDeclaration_ Dinnerclass :: TypeDeclaration -> Tree 'FieldDeclaration_ Dmth :: [Modifier] -> TypeSpec -> MethodDecl -> MethodBody -> Tree 'FieldDeclaration_ Dmthth :: [Modifier] -> TypeSpec -> MethodDecl -> [TypeName] -> MethodBody -> Tree 'FieldDeclaration_ Dvar :: [Modifier] -> TypeSpec -> [VarDecl] -> Tree 'FieldDeclaration_ IBody :: Tree 'MethodBody_ MBody :: Body -> Tree 'MethodBody_ LVar :: TypeSpec -> [VarDecl] -> Tree 'LVarStatement_ LVarf :: TypeSpec -> [VarDecl] -> Tree 'LVarStatement_ Statem :: Stm -> Tree 'LVarStatement_ BodyImpl :: [LVarStatement] -> Tree 'Body_ Case :: Exp -> Tree 'Stm_ Dflt :: Tree 'Stm_ Exps :: Exp -> Tree 'Stm_ Grd :: GuardStm -> Tree 'Stm_ Iter :: IterStm -> Tree 'Stm_ Jmp :: JumpStm -> Tree 'Stm_ LV :: [LVarStatement] -> Tree 'Stm_ Lbl :: Ident -> Tree 'Stm_ Sel :: SelectionStm -> Tree 'Stm_ Sem :: Tree 'Stm_ DeclArray :: Ident -> [BracketsOpt] -> Tree 'DeclaratorName_ DeclName :: Ident -> Tree 'DeclaratorName_ VDecl :: Ident -> Tree 'VarDecl_ VDeclAssign :: DeclaratorName -> VariableInits -> Tree 'VarDecl_ IArri :: ArrayInits -> Tree 'VariableInits_ IEmpt :: Tree 'VariableInits_ IExp :: Exp -> Tree 'VariableInits_ Vai :: ArrayInits -> VariableInits -> Tree 'ArrayInits_ Vainit :: VariableInits -> Tree 'ArrayInits_ Vais :: ArrayInits -> Tree 'ArrayInits_ Mth :: DeclaratorName -> [Parameter] -> Tree 'MethodDecl_ MthdArr :: MethodDecl -> BracketsOpt -> Tree 'MethodDecl_ Param :: TypeSpec -> DeclaratorName -> Tree 'Parameter_ Pfinal :: TypeSpec -> DeclaratorName -> Tree 'Parameter_ If :: Exp -> Stm -> [ElseIfStm] -> Stm -> Tree 'SelectionStm_ Ifone :: Exp -> Stm -> [ElseIfStm] -> Tree 'SelectionStm_ Switch :: Exp -> Body -> Tree 'SelectionStm_ Elseif :: Exp -> Stm -> Tree 'ElseIfStm_ Break :: Tree 'JumpStm_ Brlabel :: Ident -> Tree 'JumpStm_ Continue :: Tree 'JumpStm_ Continuelabel :: Ident -> Tree 'JumpStm_ Return :: Tree 'JumpStm_ ReturnExp :: Exp -> Tree 'JumpStm_ Throw :: Exp -> Tree 'JumpStm_ Synchronized :: Exp -> Body -> Tree 'GuardStm_ Try :: Body -> [Catch] -> Tree 'GuardStm_ Tryfinally :: Body -> [Catch] -> Body -> Tree 'GuardStm_ Catch1 :: TypeSpec -> Ident -> Body -> Tree 'Catch_ Catch2 :: TypeSpec -> Body -> Tree 'Catch_ Do :: Stm -> Exp -> Tree 'IterStm_ For :: ForInit -> [Exp] -> [Exp] -> Stm -> Tree 'IterStm_ While :: Exp -> Stm -> Tree 'IterStm_ DeclVar :: TypeSpec -> [VarDecl] -> Tree 'ForInit_ DeclVarFinal :: TypeSpec -> [VarDecl] -> Tree 'ForInit_ Exprs1 :: [Exp] -> Tree 'ForInit_ Mabstract :: Tree 'Modifier_ Mfinal :: Tree 'Modifier_ Mnative :: Tree 'Modifier_ Mprivate :: Tree 'Modifier_ Mprotected :: Tree 'Modifier_ Mpublic :: Tree 'Modifier_ Mstatic :: Tree 'Modifier_ Msync :: Tree 'Modifier_ Mtransient :: Tree 'Modifier_ Mvolatile :: Tree 'Modifier_ Tboolean :: Tree 'BasicType_ Tbyte :: Tree 'BasicType_ Tchar :: Tree 'BasicType_ Tdouble :: Tree 'BasicType_ Tfloat :: Tree 'BasicType_ Tint :: Tree 'BasicType_ Tlong :: Tree 'BasicType_ Tshort :: Tree 'BasicType_ ArrayType :: TypeName -> [BracketsOpt] -> Tree 'TypeSpec_ NamedType :: TypeName -> Tree 'TypeSpec_ BuiltIn :: BasicType -> Tree 'TypeName_ ClassType :: [Ident] -> Tree 'TypeName_ BracketsEmpty :: Tree 'BracketsOpt_ Earr :: ArrAcc -> Tree 'Exp_ Earrcoercion :: [Ident] -> [BracketsOpt] -> Exp -> Tree 'Exp_ Eassign :: Exp -> Assignment_op -> Exp -> Tree 'Exp_ Ebcoercion :: BasicType -> Exp -> Tree 'Exp_ Ebitand :: Exp -> Exp -> Tree 'Exp_ Ebitexor :: Exp -> Exp -> Tree 'Exp_ Ebitor :: Exp -> Exp -> Tree 'Exp_ Econdition :: Exp -> Exp -> Exp -> Tree 'Exp_ Econst :: Constant -> Tree 'Exp_ Ediv :: Exp -> Exp -> Tree 'Exp_ Eeq :: Exp -> Exp -> Tree 'Exp_ Eexpcoercion :: Exp -> Exp -> Tree 'Exp_ Efld :: FieldAcc -> Tree 'Exp_ Ege :: Exp -> Exp -> Tree 'Exp_ Egrthen :: Exp -> Exp -> Tree 'Exp_ Eland :: Exp -> Exp -> Tree 'Exp_ Ele :: Exp -> Exp -> Tree 'Exp_ Eleft :: Exp -> Exp -> Tree 'Exp_ Elor :: Exp -> Exp -> Tree 'Exp_ Elthen :: Exp -> Exp -> Tree 'Exp_ Eminus :: Exp -> Exp -> Tree 'Exp_ Emod :: Exp -> Exp -> Tree 'Exp_ Emth :: MthCall -> Tree 'Exp_ Eneq :: Exp -> Exp -> Tree 'Exp_ Enewalloc :: NewAlloc -> Tree 'Exp_ Eplus :: Exp -> Exp -> Tree 'Exp_ Epostdec :: Exp -> Tree 'Exp_ Epostinc :: Exp -> Tree 'Exp_ Epredec :: Exp -> Tree 'Exp_ Epreinc :: Exp -> Tree 'Exp_ Epreop :: Unary_operator -> Exp -> Tree 'Exp_ Eright :: Exp -> Exp -> Tree 'Exp_ Especname :: SpecName -> Tree 'Exp_ Estring :: P.String -> Tree 'Exp_ Etimes :: Exp -> Exp -> Tree 'Exp_ Etrip :: Exp -> Exp -> Tree 'Exp_ Etype :: Exp -> TypeName -> Tree 'Exp_ Evar :: [Ident] -> Tree 'Exp_ SSnull :: Tree 'SpecName_ SSsuper :: Tree 'SpecName_ SSthis :: Tree 'SpecName_ Anewarray :: TypeName -> [DimExpr] -> Tree 'NewAlloc_ Anewarriempty :: TypeName -> [DimExpr] -> Tree 'NewAlloc_ Anewarrinits :: TypeName -> [DimExpr] -> ArrayInits -> Tree 'NewAlloc_ Anewclass :: TypeName -> Args -> Tree 'NewAlloc_ Anewinnerclass :: TypeName -> Args -> [FieldDeclaration] -> Tree 'NewAlloc_ Aarr :: [Ident] -> Exp -> Tree 'ArrAcc_ Aarr1 :: SpecExp -> Exp -> Tree 'ArrAcc_ Cep :: Exp -> Tree 'SpecExp_ Cnp :: SpecExpNP -> Tree 'SpecExp_ Cthis :: SpecName -> Tree 'SpecExp_ CNLit :: Constant -> Tree 'SpecExpNP_ CNParr :: ArrAcc -> Tree 'SpecExpNP_ CNPfld :: FieldAcc -> Tree 'SpecExpNP_ CNPmth :: MthCall -> Tree 'SpecExpNP_ Mmth :: [Ident] -> Args -> Tree 'MthCall_ Mmth1 :: SpecExpNP -> Args -> Tree 'MthCall_ Mmthspec :: SpecName -> Args -> Tree 'MthCall_ Fclass :: [Ident] -> Tree 'FieldAcc_ Ffclass2 :: BasicType -> Tree 'FieldAcc_ Ffthis :: [Ident] -> Tree 'FieldAcc_ Ffvar :: SpecExp -> Ident -> Tree 'FieldAcc_ Ffvar1 :: NewAlloc -> Ident -> Tree 'FieldAcc_ ArgList :: [Exp] -> Tree 'Args_ Dim :: Exp -> Tree 'DimExpr_ Ecdouble :: JDouble -> Tree 'Constant_ Ecfloat :: JFloat -> Tree 'Constant_ Echar :: JChar -> Tree 'Constant_ Eclongdouble :: JLongDouble -> Tree 'Constant_ Edouble :: P.Double -> Tree 'Constant_ Efalse :: Tree 'Constant_ Efloat :: P.Double -> Tree 'Constant_ Ehexadec :: Hexadecimal -> Tree 'Constant_ Ehexalong :: HexLong -> Tree 'Constant_ Ehexaunsign :: HexUnsigned -> Tree 'Constant_ Ehexaunslong :: HexUnsLong -> Tree 'Constant_ Eint :: P.Integer -> Tree 'Constant_ Elong :: Long -> Tree 'Constant_ Elonger :: P.Integer -> Tree 'Constant_ Eoctal :: Octal -> Tree 'Constant_ Eoctallong :: OctalLong -> Tree 'Constant_ Eoctalunsign :: OctalUnsigned -> Tree 'Constant_ Eoctalunslong :: OctalUnsLong -> Tree 'Constant_ Etrue :: Tree 'Constant_ Eunicode :: UnicodeChar -> Tree 'Constant_ Eunsigned :: Unsigned -> Tree 'Constant_ Eunsignlong :: UnsignedLong -> Tree 'Constant_ Complement :: Tree 'Unary_operator_ Logicalneg :: Tree 'Unary_operator_ Negative :: Tree 'Unary_operator_ Plus :: Tree 'Unary_operator_ Assign :: Tree 'Assignment_op_ AssignAdd :: Tree 'Assignment_op_ AssignAnd :: Tree 'Assignment_op_ AssignDiv :: Tree 'Assignment_op_ AssignLeft :: Tree 'Assignment_op_ AssignMod :: Tree 'Assignment_op_ AssignMul :: Tree 'Assignment_op_ AssignOr :: Tree 'Assignment_op_ AssignRight :: Tree 'Assignment_op_ AssignSub :: Tree 'Assignment_op_ AssignTrip :: Tree 'Assignment_op_ AssignXor :: Tree 'Assignment_op_ Sem1 :: Tree 'Semi_ Ident ::P.String -> Tree 'Ident_ Unsigned ::P.String -> Tree 'Unsigned_ Long ::P.String -> Tree 'Long_ UnsignedLong ::P.String -> Tree 'UnsignedLong_ Hexadecimal ::P.String -> Tree 'Hexadecimal_ HexUnsigned ::P.String -> Tree 'HexUnsigned_ HexLong ::P.String -> Tree 'HexLong_ HexUnsLong ::P.String -> Tree 'HexUnsLong_ Octal ::P.String -> Tree 'Octal_ OctalUnsigned ::P.String -> Tree 'OctalUnsigned_ OctalLong ::P.String -> Tree 'OctalLong_ OctalUnsLong ::P.String -> Tree 'OctalUnsLong_ JDouble ::P.String -> Tree 'JDouble_ JFloat ::P.String -> Tree 'JFloat_ JLongDouble ::P.String -> Tree 'JLongDouble_ UnicodeChar ::P.String -> Tree 'UnicodeChar_ JChar ::P.String -> Tree 'JChar_ instance Compos Tree where compos r a f = \case ProgF imports typeDeclarations -> r ProgF `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) imports `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeDeclarations Prpkg idents semis imports typeDeclarations -> r Prpkg `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) semis `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) imports `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeDeclarations ImportA idents semis -> r ImportA `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) semis ImportN idents semis -> r ImportN `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) semis TypeDecl classHeader fieldDeclarations -> r TypeDecl `a` f classHeader `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) fieldDeclarations ClassDec modifiers x -> r ClassDec `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x ClassDecE modifiers x typeNames -> r ClassDecE `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames ClassDecEI modifiers x typeNames1 typeNames2 -> r ClassDecEI `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames1 `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames2 ClassDecI modifiers x typeNames -> r ClassDecI `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames InterDec modifiers x -> r InterDec `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x InterDecE modifiers x typeNames -> r InterDecE `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames InterDecEI modifiers x typeNames1 typeNames2 -> r InterDecEI `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames1 `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames2 InterDecI modifiers x typeNames -> r InterDecI `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames Dblk body -> r Dblk `a` f body Dconst modifiers x parameters body -> r Dconst `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) parameters `a` f body Dconstt modifiers x parameters typeNames body -> r Dconstt `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) parameters `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames `a` f body Dinnerclass typeDeclaration -> r Dinnerclass `a` f typeDeclaration Dmth modifiers typeSpec methodDecl methodBody -> r Dmth `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f typeSpec `a` f methodDecl `a` f methodBody Dmthth modifiers typeSpec methodDecl typeNames methodBody -> r Dmthth `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f typeSpec `a` f methodDecl `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) typeNames `a` f methodBody Dvar modifiers typeSpec varDecls -> r Dvar `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) modifiers `a` f typeSpec `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) varDecls MBody body -> r MBody `a` f body LVar typeSpec varDecls -> r LVar `a` f typeSpec `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) varDecls LVarf typeSpec varDecls -> r LVarf `a` f typeSpec `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) varDecls Statem stm -> r Statem `a` f stm BodyImpl lVarStatements -> r BodyImpl `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) lVarStatements Case exp -> r Case `a` f exp Exps exp -> r Exps `a` f exp Grd guardStm -> r Grd `a` f guardStm Iter iterStm -> r Iter `a` f iterStm Jmp jumpStm -> r Jmp `a` f jumpStm LV lVarStatements -> r LV `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) lVarStatements Lbl x -> r Lbl `a` f x Sel selectionStm -> r Sel `a` f selectionStm DeclArray x bracketsOpts -> r DeclArray `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) bracketsOpts DeclName x -> r DeclName `a` f x VDecl x -> r VDecl `a` f x VDeclAssign declaratorName variableInits -> r VDeclAssign `a` f declaratorName `a` f variableInits IArri arrayInits -> r IArri `a` f arrayInits IExp exp -> r IExp `a` f exp Vai arrayInits variableInits -> r Vai `a` f arrayInits `a` f variableInits Vainit variableInits -> r Vainit `a` f variableInits Vais arrayInits -> r Vais `a` f arrayInits Mth declaratorName parameters -> r Mth `a` f declaratorName `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) parameters MthdArr methodDecl bracketsOpt -> r MthdArr `a` f methodDecl `a` f bracketsOpt Param typeSpec declaratorName -> r Param `a` f typeSpec `a` f declaratorName Pfinal typeSpec declaratorName -> r Pfinal `a` f typeSpec `a` f declaratorName If exp stm1 elseIfStms stm2 -> r If `a` f exp `a` f stm1 `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) elseIfStms `a` f stm2 Ifone exp stm elseIfStms -> r Ifone `a` f exp `a` f stm `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) elseIfStms Switch exp body -> r Switch `a` f exp `a` f body Elseif exp stm -> r Elseif `a` f exp `a` f stm Brlabel x -> r Brlabel `a` f x Continuelabel x -> r Continuelabel `a` f x ReturnExp exp -> r ReturnExp `a` f exp Throw exp -> r Throw `a` f exp Synchronized exp body -> r Synchronized `a` f exp `a` f body Try body catchs -> r Try `a` f body `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) catchs Tryfinally body1 catchs body2 -> r Tryfinally `a` f body1 `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) catchs `a` f body2 Catch1 typeSpec x body -> r Catch1 `a` f typeSpec `a` f x `a` f body Catch2 typeSpec body -> r Catch2 `a` f typeSpec `a` f body Do stm exp -> r Do `a` f stm `a` f exp For forInit exps1 exps2 stm -> r For `a` f forInit `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) exps1 `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) exps2 `a` f stm While exp stm -> r While `a` f exp `a` f stm DeclVar typeSpec varDecls -> r DeclVar `a` f typeSpec `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) varDecls DeclVarFinal typeSpec varDecls -> r DeclVarFinal `a` f typeSpec `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) varDecls Exprs1 exps -> r Exprs1 `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) exps ArrayType typeName bracketsOpts -> r ArrayType `a` f typeName `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) bracketsOpts NamedType typeName -> r NamedType `a` f typeName BuiltIn basicType -> r BuiltIn `a` f basicType ClassType idents -> r ClassType `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents Earr arrAcc -> r Earr `a` f arrAcc Earrcoercion idents bracketsOpts exp -> r Earrcoercion `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) bracketsOpts `a` f exp Eassign exp1 assignment_op exp2 -> r Eassign `a` f exp1 `a` f assignment_op `a` f exp2 Ebcoercion basicType exp -> r Ebcoercion `a` f basicType `a` f exp Ebitand exp1 exp2 -> r Ebitand `a` f exp1 `a` f exp2 Ebitexor exp1 exp2 -> r Ebitexor `a` f exp1 `a` f exp2 Ebitor exp1 exp2 -> r Ebitor `a` f exp1 `a` f exp2 Econdition exp1 exp2 exp3 -> r Econdition `a` f exp1 `a` f exp2 `a` f exp3 Econst constant -> r Econst `a` f constant Ediv exp1 exp2 -> r Ediv `a` f exp1 `a` f exp2 Eeq exp1 exp2 -> r Eeq `a` f exp1 `a` f exp2 Eexpcoercion exp1 exp2 -> r Eexpcoercion `a` f exp1 `a` f exp2 Efld fieldAcc -> r Efld `a` f fieldAcc Ege exp1 exp2 -> r Ege `a` f exp1 `a` f exp2 Egrthen exp1 exp2 -> r Egrthen `a` f exp1 `a` f exp2 Eland exp1 exp2 -> r Eland `a` f exp1 `a` f exp2 Ele exp1 exp2 -> r Ele `a` f exp1 `a` f exp2 Eleft exp1 exp2 -> r Eleft `a` f exp1 `a` f exp2 Elor exp1 exp2 -> r Elor `a` f exp1 `a` f exp2 Elthen exp1 exp2 -> r Elthen `a` f exp1 `a` f exp2 Eminus exp1 exp2 -> r Eminus `a` f exp1 `a` f exp2 Emod exp1 exp2 -> r Emod `a` f exp1 `a` f exp2 Emth mthCall -> r Emth `a` f mthCall Eneq exp1 exp2 -> r Eneq `a` f exp1 `a` f exp2 Enewalloc newAlloc -> r Enewalloc `a` f newAlloc Eplus exp1 exp2 -> r Eplus `a` f exp1 `a` f exp2 Epostdec exp -> r Epostdec `a` f exp Epostinc exp -> r Epostinc `a` f exp Epredec exp -> r Epredec `a` f exp Epreinc exp -> r Epreinc `a` f exp Epreop unary_operator exp -> r Epreop `a` f unary_operator `a` f exp Eright exp1 exp2 -> r Eright `a` f exp1 `a` f exp2 Especname specName -> r Especname `a` f specName Etimes exp1 exp2 -> r Etimes `a` f exp1 `a` f exp2 Etrip exp1 exp2 -> r Etrip `a` f exp1 `a` f exp2 Etype exp typeName -> r Etype `a` f exp `a` f typeName Evar idents -> r Evar `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents Anewarray typeName dimExprs -> r Anewarray `a` f typeName `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) dimExprs Anewarriempty typeName dimExprs -> r Anewarriempty `a` f typeName `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) dimExprs Anewarrinits typeName dimExprs arrayInits -> r Anewarrinits `a` f typeName `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) dimExprs `a` f arrayInits Anewclass typeName args -> r Anewclass `a` f typeName `a` f args Anewinnerclass typeName args fieldDeclarations -> r Anewinnerclass `a` f typeName `a` f args `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) fieldDeclarations Aarr idents exp -> r Aarr `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents `a` f exp Aarr1 specExp exp -> r Aarr1 `a` f specExp `a` f exp Cep exp -> r Cep `a` f exp Cnp specExpNP -> r Cnp `a` f specExpNP Cthis specName -> r Cthis `a` f specName CNLit constant -> r CNLit `a` f constant CNParr arrAcc -> r CNParr `a` f arrAcc CNPfld fieldAcc -> r CNPfld `a` f fieldAcc CNPmth mthCall -> r CNPmth `a` f mthCall Mmth idents args -> r Mmth `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents `a` f args Mmth1 specExpNP args -> r Mmth1 `a` f specExpNP `a` f args Mmthspec specName args -> r Mmthspec `a` f specName `a` f args Fclass idents -> r Fclass `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents Ffclass2 basicType -> r Ffclass2 `a` f basicType Ffthis idents -> r Ffthis `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents Ffvar specExp x -> r Ffvar `a` f specExp `a` f x Ffvar1 newAlloc x -> r Ffvar1 `a` f newAlloc `a` f x ArgList exps -> r ArgList `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) exps Dim exp -> r Dim `a` f exp Ecdouble jDouble -> r Ecdouble `a` f jDouble Ecfloat jFloat -> r Ecfloat `a` f jFloat Echar jChar -> r Echar `a` f jChar Eclongdouble jLongDouble -> r Eclongdouble `a` f jLongDouble Ehexadec hexadecimal -> r Ehexadec `a` f hexadecimal Ehexalong hexLong -> r Ehexalong `a` f hexLong Ehexaunsign hexUnsigned -> r Ehexaunsign `a` f hexUnsigned Ehexaunslong hexUnsLong -> r Ehexaunslong `a` f hexUnsLong Elong long -> r Elong `a` f long Eoctal octal -> r Eoctal `a` f octal Eoctallong octalLong -> r Eoctallong `a` f octalLong Eoctalunsign octalUnsigned -> r Eoctalunsign `a` f octalUnsigned Eoctalunslong octalUnsLong -> r Eoctalunslong `a` f octalUnsLong Eunicode unicodeChar -> r Eunicode `a` f unicodeChar Eunsigned unsigned -> r Eunsigned `a` f unsigned Eunsignlong unsignedLong -> r Eunsignlong `a` f unsignedLong t -> r t instance P.Show (Tree c) where showsPrec n = \case Ident str -> opar . P.showString "Ident" . P.showChar ' ' . P.showsPrec 1 str . cpar Unsigned str -> opar . P.showString "Unsigned" . P.showChar ' ' . P.showsPrec 1 str . cpar Long str -> opar . P.showString "Long" . P.showChar ' ' . P.showsPrec 1 str . cpar UnsignedLong str -> opar . P.showString "UnsignedLong" . P.showChar ' ' . P.showsPrec 1 str . cpar Hexadecimal str -> opar . P.showString "Hexadecimal" . P.showChar ' ' . P.showsPrec 1 str . cpar HexUnsigned str -> opar . P.showString "HexUnsigned" . P.showChar ' ' . P.showsPrec 1 str . cpar HexLong str -> opar . P.showString "HexLong" . P.showChar ' ' . P.showsPrec 1 str . cpar HexUnsLong str -> opar . P.showString "HexUnsLong" . P.showChar ' ' . P.showsPrec 1 str . cpar Octal str -> opar . P.showString "Octal" . P.showChar ' ' . P.showsPrec 1 str . cpar OctalUnsigned str -> opar . P.showString "OctalUnsigned" . P.showChar ' ' . P.showsPrec 1 str . cpar OctalLong str -> opar . P.showString "OctalLong" . P.showChar ' ' . P.showsPrec 1 str . cpar OctalUnsLong str -> opar . P.showString "OctalUnsLong" . P.showChar ' ' . P.showsPrec 1 str . cpar JDouble str -> opar . P.showString "JDouble" . P.showChar ' ' . P.showsPrec 1 str . cpar JFloat str -> opar . P.showString "JFloat" . P.showChar ' ' . P.showsPrec 1 str . cpar JLongDouble str -> opar . P.showString "JLongDouble" . P.showChar ' ' . P.showsPrec 1 str . cpar UnicodeChar str -> opar . P.showString "UnicodeChar" . P.showChar ' ' . P.showsPrec 1 str . cpar JChar str -> opar . P.showString "JChar" . P.showChar ' ' . P.showsPrec 1 str . cpar ProgF imports typeDeclarations -> opar . P.showString "ProgF" . P.showChar ' ' . P.showsPrec 1 imports . P.showChar ' ' . P.showsPrec 1 typeDeclarations . cpar Prpkg idents semis imports typeDeclarations -> opar . P.showString "Prpkg" . P.showChar ' ' . P.showsPrec 1 idents . P.showChar ' ' . P.showsPrec 1 semis . P.showChar ' ' . P.showsPrec 1 imports . P.showChar ' ' . P.showsPrec 1 typeDeclarations . cpar ImportA idents semis -> opar . P.showString "ImportA" . P.showChar ' ' . P.showsPrec 1 idents . P.showChar ' ' . P.showsPrec 1 semis . cpar ImportN idents semis -> opar . P.showString "ImportN" . P.showChar ' ' . P.showsPrec 1 idents . P.showChar ' ' . P.showsPrec 1 semis . cpar TypeDecl classHeader fieldDeclarations -> opar . P.showString "TypeDecl" . P.showChar ' ' . P.showsPrec 1 classHeader . P.showChar ' ' . P.showsPrec 1 fieldDeclarations . cpar ClassDec modifiers x -> opar . P.showString "ClassDec" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . cpar ClassDecE modifiers x typeNames -> opar . P.showString "ClassDecE" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeNames . cpar ClassDecEI modifiers x typeNames1 typeNames2 -> opar . P.showString "ClassDecEI" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeNames1 . P.showChar ' ' . P.showsPrec 1 typeNames2 . cpar ClassDecI modifiers x typeNames -> opar . P.showString "ClassDecI" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeNames . cpar InterDec modifiers x -> opar . P.showString "InterDec" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . cpar InterDecE modifiers x typeNames -> opar . P.showString "InterDecE" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeNames . cpar InterDecEI modifiers x typeNames1 typeNames2 -> opar . P.showString "InterDecEI" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeNames1 . P.showChar ' ' . P.showsPrec 1 typeNames2 . cpar InterDecI modifiers x typeNames -> opar . P.showString "InterDecI" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeNames . cpar Dblk body -> opar . P.showString "Dblk" . P.showChar ' ' . P.showsPrec 1 body . cpar Dconst modifiers x parameters body -> opar . P.showString "Dconst" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 parameters . P.showChar ' ' . P.showsPrec 1 body . cpar Dconstt modifiers x parameters typeNames body -> opar . P.showString "Dconstt" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 parameters . P.showChar ' ' . P.showsPrec 1 typeNames . P.showChar ' ' . P.showsPrec 1 body . cpar Dinnerclass typeDeclaration -> opar . P.showString "Dinnerclass" . P.showChar ' ' . P.showsPrec 1 typeDeclaration . cpar Dmth modifiers typeSpec methodDecl methodBody -> opar . P.showString "Dmth" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 methodDecl . P.showChar ' ' . P.showsPrec 1 methodBody . cpar Dmthth modifiers typeSpec methodDecl typeNames methodBody -> opar . P.showString "Dmthth" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 methodDecl . P.showChar ' ' . P.showsPrec 1 typeNames . P.showChar ' ' . P.showsPrec 1 methodBody . cpar Dvar modifiers typeSpec varDecls -> opar . P.showString "Dvar" . P.showChar ' ' . P.showsPrec 1 modifiers . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 varDecls . cpar IBody -> P.showString "IBody" MBody body -> opar . P.showString "MBody" . P.showChar ' ' . P.showsPrec 1 body . cpar LVar typeSpec varDecls -> opar . P.showString "LVar" . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 varDecls . cpar LVarf typeSpec varDecls -> opar . P.showString "LVarf" . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 varDecls . cpar Statem stm -> opar . P.showString "Statem" . P.showChar ' ' . P.showsPrec 1 stm . cpar BodyImpl lVarStatements -> opar . P.showString "BodyImpl" . P.showChar ' ' . P.showsPrec 1 lVarStatements . cpar Case exp -> opar . P.showString "Case" . P.showChar ' ' . P.showsPrec 1 exp . cpar Dflt -> P.showString "Dflt" Exps exp -> opar . P.showString "Exps" . P.showChar ' ' . P.showsPrec 1 exp . cpar Grd guardStm -> opar . P.showString "Grd" . P.showChar ' ' . P.showsPrec 1 guardStm . cpar Iter iterStm -> opar . P.showString "Iter" . P.showChar ' ' . P.showsPrec 1 iterStm . cpar Jmp jumpStm -> opar . P.showString "Jmp" . P.showChar ' ' . P.showsPrec 1 jumpStm . cpar LV lVarStatements -> opar . P.showString "LV" . P.showChar ' ' . P.showsPrec 1 lVarStatements . cpar Lbl x -> opar . P.showString "Lbl" . P.showChar ' ' . P.showsPrec 1 x . cpar Sel selectionStm -> opar . P.showString "Sel" . P.showChar ' ' . P.showsPrec 1 selectionStm . cpar Sem -> P.showString "Sem" DeclArray x bracketsOpts -> opar . P.showString "DeclArray" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 bracketsOpts . cpar DeclName x -> opar . P.showString "DeclName" . P.showChar ' ' . P.showsPrec 1 x . cpar VDecl x -> opar . P.showString "VDecl" . P.showChar ' ' . P.showsPrec 1 x . cpar VDeclAssign declaratorName variableInits -> opar . P.showString "VDeclAssign" . P.showChar ' ' . P.showsPrec 1 declaratorName . P.showChar ' ' . P.showsPrec 1 variableInits . cpar IArri arrayInits -> opar . P.showString "IArri" . P.showChar ' ' . P.showsPrec 1 arrayInits . cpar IEmpt -> P.showString "IEmpt" IExp exp -> opar . P.showString "IExp" . P.showChar ' ' . P.showsPrec 1 exp . cpar Vai arrayInits variableInits -> opar . P.showString "Vai" . P.showChar ' ' . P.showsPrec 1 arrayInits . P.showChar ' ' . P.showsPrec 1 variableInits . cpar Vainit variableInits -> opar . P.showString "Vainit" . P.showChar ' ' . P.showsPrec 1 variableInits . cpar Vais arrayInits -> opar . P.showString "Vais" . P.showChar ' ' . P.showsPrec 1 arrayInits . cpar Mth declaratorName parameters -> opar . P.showString "Mth" . P.showChar ' ' . P.showsPrec 1 declaratorName . P.showChar ' ' . P.showsPrec 1 parameters . cpar MthdArr methodDecl bracketsOpt -> opar . P.showString "MthdArr" . P.showChar ' ' . P.showsPrec 1 methodDecl . P.showChar ' ' . P.showsPrec 1 bracketsOpt . cpar Param typeSpec declaratorName -> opar . P.showString "Param" . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 declaratorName . cpar Pfinal typeSpec declaratorName -> opar . P.showString "Pfinal" . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 declaratorName . cpar If exp stm1 elseIfStms stm2 -> opar . P.showString "If" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm1 . P.showChar ' ' . P.showsPrec 1 elseIfStms . P.showChar ' ' . P.showsPrec 1 stm2 . cpar Ifone exp stm elseIfStms -> opar . P.showString "Ifone" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm . P.showChar ' ' . P.showsPrec 1 elseIfStms . cpar Switch exp body -> opar . P.showString "Switch" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 body . cpar Elseif exp stm -> opar . P.showString "Elseif" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm . cpar Break -> P.showString "Break" Brlabel x -> opar . P.showString "Brlabel" . P.showChar ' ' . P.showsPrec 1 x . cpar Continue -> P.showString "Continue" Continuelabel x -> opar . P.showString "Continuelabel" . P.showChar ' ' . P.showsPrec 1 x . cpar Return -> P.showString "Return" ReturnExp exp -> opar . P.showString "ReturnExp" . P.showChar ' ' . P.showsPrec 1 exp . cpar Throw exp -> opar . P.showString "Throw" . P.showChar ' ' . P.showsPrec 1 exp . cpar Synchronized exp body -> opar . P.showString "Synchronized" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 body . cpar Try body catchs -> opar . P.showString "Try" . P.showChar ' ' . P.showsPrec 1 body . P.showChar ' ' . P.showsPrec 1 catchs . cpar Tryfinally body1 catchs body2 -> opar . P.showString "Tryfinally" . P.showChar ' ' . P.showsPrec 1 body1 . P.showChar ' ' . P.showsPrec 1 catchs . P.showChar ' ' . P.showsPrec 1 body2 . cpar Catch1 typeSpec x body -> opar . P.showString "Catch1" . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 body . cpar Catch2 typeSpec body -> opar . P.showString "Catch2" . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 body . cpar Do stm exp -> opar . P.showString "Do" . P.showChar ' ' . P.showsPrec 1 stm . P.showChar ' ' . P.showsPrec 1 exp . cpar For forInit exps1 exps2 stm -> opar . P.showString "For" . P.showChar ' ' . P.showsPrec 1 forInit . P.showChar ' ' . P.showsPrec 1 exps1 . P.showChar ' ' . P.showsPrec 1 exps2 . P.showChar ' ' . P.showsPrec 1 stm . cpar While exp stm -> opar . P.showString "While" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm . cpar DeclVar typeSpec varDecls -> opar . P.showString "DeclVar" . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 varDecls . cpar DeclVarFinal typeSpec varDecls -> opar . P.showString "DeclVarFinal" . P.showChar ' ' . P.showsPrec 1 typeSpec . P.showChar ' ' . P.showsPrec 1 varDecls . cpar Exprs1 exps -> opar . P.showString "Exprs1" . P.showChar ' ' . P.showsPrec 1 exps . cpar Mabstract -> P.showString "Mabstract" Mfinal -> P.showString "Mfinal" Mnative -> P.showString "Mnative" Mprivate -> P.showString "Mprivate" Mprotected -> P.showString "Mprotected" Mpublic -> P.showString "Mpublic" Mstatic -> P.showString "Mstatic" Msync -> P.showString "Msync" Mtransient -> P.showString "Mtransient" Mvolatile -> P.showString "Mvolatile" Tboolean -> P.showString "Tboolean" Tbyte -> P.showString "Tbyte" Tchar -> P.showString "Tchar" Tdouble -> P.showString "Tdouble" Tfloat -> P.showString "Tfloat" Tint -> P.showString "Tint" Tlong -> P.showString "Tlong" Tshort -> P.showString "Tshort" ArrayType typeName bracketsOpts -> opar . P.showString "ArrayType" . P.showChar ' ' . P.showsPrec 1 typeName . P.showChar ' ' . P.showsPrec 1 bracketsOpts . cpar NamedType typeName -> opar . P.showString "NamedType" . P.showChar ' ' . P.showsPrec 1 typeName . cpar BuiltIn basicType -> opar . P.showString "BuiltIn" . P.showChar ' ' . P.showsPrec 1 basicType . cpar ClassType idents -> opar . P.showString "ClassType" . P.showChar ' ' . P.showsPrec 1 idents . cpar BracketsEmpty -> P.showString "BracketsEmpty" Earr arrAcc -> opar . P.showString "Earr" . P.showChar ' ' . P.showsPrec 1 arrAcc . cpar Earrcoercion idents bracketsOpts exp -> opar . P.showString "Earrcoercion" . P.showChar ' ' . P.showsPrec 1 idents . P.showChar ' ' . P.showsPrec 1 bracketsOpts . P.showChar ' ' . P.showsPrec 1 exp . cpar Eassign exp1 assignment_op exp2 -> opar . P.showString "Eassign" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 assignment_op . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Ebcoercion basicType exp -> opar . P.showString "Ebcoercion" . P.showChar ' ' . P.showsPrec 1 basicType . P.showChar ' ' . P.showsPrec 1 exp . cpar Ebitand exp1 exp2 -> opar . P.showString "Ebitand" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Ebitexor exp1 exp2 -> opar . P.showString "Ebitexor" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Ebitor exp1 exp2 -> opar . P.showString "Ebitor" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Econdition exp1 exp2 exp3 -> opar . P.showString "Econdition" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . P.showChar ' ' . P.showsPrec 1 exp3 . cpar Econst constant -> opar . P.showString "Econst" . P.showChar ' ' . P.showsPrec 1 constant . cpar Ediv exp1 exp2 -> opar . P.showString "Ediv" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Eeq exp1 exp2 -> opar . P.showString "Eeq" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Eexpcoercion exp1 exp2 -> opar . P.showString "Eexpcoercion" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Efld fieldAcc -> opar . P.showString "Efld" . P.showChar ' ' . P.showsPrec 1 fieldAcc . cpar Ege exp1 exp2 -> opar . P.showString "Ege" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Egrthen exp1 exp2 -> opar . P.showString "Egrthen" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Eland exp1 exp2 -> opar . P.showString "Eland" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Ele exp1 exp2 -> opar . P.showString "Ele" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Eleft exp1 exp2 -> opar . P.showString "Eleft" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Elor exp1 exp2 -> opar . P.showString "Elor" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Elthen exp1 exp2 -> opar . P.showString "Elthen" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Eminus exp1 exp2 -> opar . P.showString "Eminus" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Emod exp1 exp2 -> opar . P.showString "Emod" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Emth mthCall -> opar . P.showString "Emth" . P.showChar ' ' . P.showsPrec 1 mthCall . cpar Eneq exp1 exp2 -> opar . P.showString "Eneq" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Enewalloc newAlloc -> opar . P.showString "Enewalloc" . P.showChar ' ' . P.showsPrec 1 newAlloc . cpar Eplus exp1 exp2 -> opar . P.showString "Eplus" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Epostdec exp -> opar . P.showString "Epostdec" . P.showChar ' ' . P.showsPrec 1 exp . cpar Epostinc exp -> opar . P.showString "Epostinc" . P.showChar ' ' . P.showsPrec 1 exp . cpar Epredec exp -> opar . P.showString "Epredec" . P.showChar ' ' . P.showsPrec 1 exp . cpar Epreinc exp -> opar . P.showString "Epreinc" . P.showChar ' ' . P.showsPrec 1 exp . cpar Epreop unary_operator exp -> opar . P.showString "Epreop" . P.showChar ' ' . P.showsPrec 1 unary_operator . P.showChar ' ' . P.showsPrec 1 exp . cpar Eright exp1 exp2 -> opar . P.showString "Eright" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Especname specName -> opar . P.showString "Especname" . P.showChar ' ' . P.showsPrec 1 specName . cpar Estring str -> opar . P.showString "Estring" . P.showChar ' ' . P.showsPrec 1 str . cpar Etimes exp1 exp2 -> opar . P.showString "Etimes" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Etrip exp1 exp2 -> opar . P.showString "Etrip" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Etype exp typeName -> opar . P.showString "Etype" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 typeName . cpar Evar idents -> opar . P.showString "Evar" . P.showChar ' ' . P.showsPrec 1 idents . cpar SSnull -> P.showString "SSnull" SSsuper -> P.showString "SSsuper" SSthis -> P.showString "SSthis" Anewarray typeName dimExprs -> opar . P.showString "Anewarray" . P.showChar ' ' . P.showsPrec 1 typeName . P.showChar ' ' . P.showsPrec 1 dimExprs . cpar Anewarriempty typeName dimExprs -> opar . P.showString "Anewarriempty" . P.showChar ' ' . P.showsPrec 1 typeName . P.showChar ' ' . P.showsPrec 1 dimExprs . cpar Anewarrinits typeName dimExprs arrayInits -> opar . P.showString "Anewarrinits" . P.showChar ' ' . P.showsPrec 1 typeName . P.showChar ' ' . P.showsPrec 1 dimExprs . P.showChar ' ' . P.showsPrec 1 arrayInits . cpar Anewclass typeName args -> opar . P.showString "Anewclass" . P.showChar ' ' . P.showsPrec 1 typeName . P.showChar ' ' . P.showsPrec 1 args . cpar Anewinnerclass typeName args fieldDeclarations -> opar . P.showString "Anewinnerclass" . P.showChar ' ' . P.showsPrec 1 typeName . P.showChar ' ' . P.showsPrec 1 args . P.showChar ' ' . P.showsPrec 1 fieldDeclarations . cpar Aarr idents exp -> opar . P.showString "Aarr" . P.showChar ' ' . P.showsPrec 1 idents . P.showChar ' ' . P.showsPrec 1 exp . cpar Aarr1 specExp exp -> opar . P.showString "Aarr1" . P.showChar ' ' . P.showsPrec 1 specExp . P.showChar ' ' . P.showsPrec 1 exp . cpar Cep exp -> opar . P.showString "Cep" . P.showChar ' ' . P.showsPrec 1 exp . cpar Cnp specExpNP -> opar . P.showString "Cnp" . P.showChar ' ' . P.showsPrec 1 specExpNP . cpar Cthis specName -> opar . P.showString "Cthis" . P.showChar ' ' . P.showsPrec 1 specName . cpar CNLit constant -> opar . P.showString "CNLit" . P.showChar ' ' . P.showsPrec 1 constant . cpar CNParr arrAcc -> opar . P.showString "CNParr" . P.showChar ' ' . P.showsPrec 1 arrAcc . cpar CNPfld fieldAcc -> opar . P.showString "CNPfld" . P.showChar ' ' . P.showsPrec 1 fieldAcc . cpar CNPmth mthCall -> opar . P.showString "CNPmth" . P.showChar ' ' . P.showsPrec 1 mthCall . cpar Mmth idents args -> opar . P.showString "Mmth" . P.showChar ' ' . P.showsPrec 1 idents . P.showChar ' ' . P.showsPrec 1 args . cpar Mmth1 specExpNP args -> opar . P.showString "Mmth1" . P.showChar ' ' . P.showsPrec 1 specExpNP . P.showChar ' ' . P.showsPrec 1 args . cpar Mmthspec specName args -> opar . P.showString "Mmthspec" . P.showChar ' ' . P.showsPrec 1 specName . P.showChar ' ' . P.showsPrec 1 args . cpar Fclass idents -> opar . P.showString "Fclass" . P.showChar ' ' . P.showsPrec 1 idents . cpar Ffclass2 basicType -> opar . P.showString "Ffclass2" . P.showChar ' ' . P.showsPrec 1 basicType . cpar Ffthis idents -> opar . P.showString "Ffthis" . P.showChar ' ' . P.showsPrec 1 idents . cpar Ffvar specExp x -> opar . P.showString "Ffvar" . P.showChar ' ' . P.showsPrec 1 specExp . P.showChar ' ' . P.showsPrec 1 x . cpar Ffvar1 newAlloc x -> opar . P.showString "Ffvar1" . P.showChar ' ' . P.showsPrec 1 newAlloc . P.showChar ' ' . P.showsPrec 1 x . cpar ArgList exps -> opar . P.showString "ArgList" . P.showChar ' ' . P.showsPrec 1 exps . cpar Dim exp -> opar . P.showString "Dim" . P.showChar ' ' . P.showsPrec 1 exp . cpar Ecdouble jDouble -> opar . P.showString "Ecdouble" . P.showChar ' ' . P.showsPrec 1 jDouble . cpar Ecfloat jFloat -> opar . P.showString "Ecfloat" . P.showChar ' ' . P.showsPrec 1 jFloat . cpar Echar jChar -> opar . P.showString "Echar" . P.showChar ' ' . P.showsPrec 1 jChar . cpar Eclongdouble jLongDouble -> opar . P.showString "Eclongdouble" . P.showChar ' ' . P.showsPrec 1 jLongDouble . cpar Edouble d -> opar . P.showString "Edouble" . P.showChar ' ' . P.showsPrec 1 d . cpar Efalse -> P.showString "Efalse" Efloat d -> opar . P.showString "Efloat" . P.showChar ' ' . P.showsPrec 1 d . cpar Ehexadec hexadecimal -> opar . P.showString "Ehexadec" . P.showChar ' ' . P.showsPrec 1 hexadecimal . cpar Ehexalong hexLong -> opar . P.showString "Ehexalong" . P.showChar ' ' . P.showsPrec 1 hexLong . cpar Ehexaunsign hexUnsigned -> opar . P.showString "Ehexaunsign" . P.showChar ' ' . P.showsPrec 1 hexUnsigned . cpar Ehexaunslong hexUnsLong -> opar . P.showString "Ehexaunslong" . P.showChar ' ' . P.showsPrec 1 hexUnsLong . cpar Eint n -> opar . P.showString "Eint" . P.showChar ' ' . P.showsPrec 1 n . cpar Elong long -> opar . P.showString "Elong" . P.showChar ' ' . P.showsPrec 1 long . cpar Elonger n -> opar . P.showString "Elonger" . P.showChar ' ' . P.showsPrec 1 n . cpar Eoctal octal -> opar . P.showString "Eoctal" . P.showChar ' ' . P.showsPrec 1 octal . cpar Eoctallong octalLong -> opar . P.showString "Eoctallong" . P.showChar ' ' . P.showsPrec 1 octalLong . cpar Eoctalunsign octalUnsigned -> opar . P.showString "Eoctalunsign" . P.showChar ' ' . P.showsPrec 1 octalUnsigned . cpar Eoctalunslong octalUnsLong -> opar . P.showString "Eoctalunslong" . P.showChar ' ' . P.showsPrec 1 octalUnsLong . cpar Etrue -> P.showString "Etrue" Eunicode unicodeChar -> opar . P.showString "Eunicode" . P.showChar ' ' . P.showsPrec 1 unicodeChar . cpar Eunsigned unsigned -> opar . P.showString "Eunsigned" . P.showChar ' ' . P.showsPrec 1 unsigned . cpar Eunsignlong unsignedLong -> opar . P.showString "Eunsignlong" . P.showChar ' ' . P.showsPrec 1 unsignedLong . cpar Complement -> P.showString "Complement" Logicalneg -> P.showString "Logicalneg" Negative -> P.showString "Negative" Plus -> P.showString "Plus" Assign -> P.showString "Assign" AssignAdd -> P.showString "AssignAdd" AssignAnd -> P.showString "AssignAnd" AssignDiv -> P.showString "AssignDiv" AssignLeft -> P.showString "AssignLeft" AssignMod -> P.showString "AssignMod" AssignMul -> P.showString "AssignMul" AssignOr -> P.showString "AssignOr" AssignRight -> P.showString "AssignRight" AssignSub -> P.showString "AssignSub" AssignTrip -> P.showString "AssignTrip" AssignXor -> P.showString "AssignXor" Sem1 -> P.showString "Sem1" where opar = if n > 0 then P.showChar '(' else P.id cpar = if n > 0 then P.showChar ')' else P.id instance P.Eq (Tree c) where (==) = johnMajorEq instance P.Ord (Tree c) where compare x y = P.compare (index x) (index y) `P.mappend` compareSame x y index :: Tree c -> P.Int index (ProgF _ _) = 1 index (Prpkg _ _ _ _) = 2 index (ImportA _ _) = 3 index (ImportN _ _) = 4 index (TypeDecl _ _) = 5 index (ClassDec _ _) = 6 index (ClassDecE _ _ _) = 7 index (ClassDecEI _ _ _ _) = 8 index (ClassDecI _ _ _) = 9 index (InterDec _ _) = 10 index (InterDecE _ _ _) = 11 index (InterDecEI _ _ _ _) = 12 index (InterDecI _ _ _) = 13 index (Dblk _) = 14 index (Dconst _ _ _ _) = 15 index (Dconstt _ _ _ _ _) = 16 index (Dinnerclass _) = 17 index (Dmth _ _ _ _) = 18 index (Dmthth _ _ _ _ _) = 19 index (Dvar _ _ _) = 20 index (IBody ) = 21 index (MBody _) = 22 index (LVar _ _) = 23 index (LVarf _ _) = 24 index (Statem _) = 25 index (BodyImpl _) = 26 index (Case _) = 27 index (Dflt ) = 28 index (Exps _) = 29 index (Grd _) = 30 index (Iter _) = 31 index (Jmp _) = 32 index (LV _) = 33 index (Lbl _) = 34 index (Sel _) = 35 index (Sem ) = 36 index (DeclArray _ _) = 37 index (DeclName _) = 38 index (VDecl _) = 39 index (VDeclAssign _ _) = 40 index (IArri _) = 41 index (IEmpt ) = 42 index (IExp _) = 43 index (Vai _ _) = 44 index (Vainit _) = 45 index (Vais _) = 46 index (Mth _ _) = 47 index (MthdArr _ _) = 48 index (Param _ _) = 49 index (Pfinal _ _) = 50 index (If _ _ _ _) = 51 index (Ifone _ _ _) = 52 index (Switch _ _) = 53 index (Elseif _ _) = 54 index (Break ) = 55 index (Brlabel _) = 56 index (Continue ) = 57 index (Continuelabel _) = 58 index (Return ) = 59 index (ReturnExp _) = 60 index (Throw _) = 61 index (Synchronized _ _) = 62 index (Try _ _) = 63 index (Tryfinally _ _ _) = 64 index (Catch1 _ _ _) = 65 index (Catch2 _ _) = 66 index (Do _ _) = 67 index (For _ _ _ _) = 68 index (While _ _) = 69 index (DeclVar _ _) = 70 index (DeclVarFinal _ _) = 71 index (Exprs1 _) = 72 index (Mabstract ) = 73 index (Mfinal ) = 74 index (Mnative ) = 75 index (Mprivate ) = 76 index (Mprotected ) = 77 index (Mpublic ) = 78 index (Mstatic ) = 79 index (Msync ) = 80 index (Mtransient ) = 81 index (Mvolatile ) = 82 index (Tboolean ) = 83 index (Tbyte ) = 84 index (Tchar ) = 85 index (Tdouble ) = 86 index (Tfloat ) = 87 index (Tint ) = 88 index (Tlong ) = 89 index (Tshort ) = 90 index (ArrayType _ _) = 91 index (NamedType _) = 92 index (BuiltIn _) = 93 index (ClassType _) = 94 index (BracketsEmpty ) = 95 index (Earr _) = 96 index (Earrcoercion _ _ _) = 97 index (Eassign _ _ _) = 98 index (Ebcoercion _ _) = 99 index (Ebitand _ _) = 100 index (Ebitexor _ _) = 101 index (Ebitor _ _) = 102 index (Econdition _ _ _) = 103 index (Econst _) = 104 index (Ediv _ _) = 105 index (Eeq _ _) = 106 index (Eexpcoercion _ _) = 107 index (Efld _) = 108 index (Ege _ _) = 109 index (Egrthen _ _) = 110 index (Eland _ _) = 111 index (Ele _ _) = 112 index (Eleft _ _) = 113 index (Elor _ _) = 114 index (Elthen _ _) = 115 index (Eminus _ _) = 116 index (Emod _ _) = 117 index (Emth _) = 118 index (Eneq _ _) = 119 index (Enewalloc _) = 120 index (Eplus _ _) = 121 index (Epostdec _) = 122 index (Epostinc _) = 123 index (Epredec _) = 124 index (Epreinc _) = 125 index (Epreop _ _) = 126 index (Eright _ _) = 127 index (Especname _) = 128 index (Estring _) = 129 index (Etimes _ _) = 130 index (Etrip _ _) = 131 index (Etype _ _) = 132 index (Evar _) = 133 index (SSnull ) = 134 index (SSsuper ) = 135 index (SSthis ) = 136 index (Anewarray _ _) = 137 index (Anewarriempty _ _) = 138 index (Anewarrinits _ _ _) = 139 index (Anewclass _ _) = 140 index (Anewinnerclass _ _ _) = 141 index (Aarr _ _) = 142 index (Aarr1 _ _) = 143 index (Cep _) = 144 index (Cnp _) = 145 index (Cthis _) = 146 index (CNLit _) = 147 index (CNParr _) = 148 index (CNPfld _) = 149 index (CNPmth _) = 150 index (Mmth _ _) = 151 index (Mmth1 _ _) = 152 index (Mmthspec _ _) = 153 index (Fclass _) = 154 index (Ffclass2 _) = 155 index (Ffthis _) = 156 index (Ffvar _ _) = 157 index (Ffvar1 _ _) = 158 index (ArgList _) = 159 index (Dim _) = 160 index (Ecdouble _) = 161 index (Ecfloat _) = 162 index (Echar _) = 163 index (Eclongdouble _) = 164 index (Edouble _) = 165 index (Efalse ) = 166 index (Efloat _) = 167 index (Ehexadec _) = 168 index (Ehexalong _) = 169 index (Ehexaunsign _) = 170 index (Ehexaunslong _) = 171 index (Eint _) = 172 index (Elong _) = 173 index (Elonger _) = 174 index (Eoctal _) = 175 index (Eoctallong _) = 176 index (Eoctalunsign _) = 177 index (Eoctalunslong _) = 178 index (Etrue ) = 179 index (Eunicode _) = 180 index (Eunsigned _) = 181 index (Eunsignlong _) = 182 index (Complement ) = 183 index (Logicalneg ) = 184 index (Negative ) = 185 index (Plus ) = 186 index (Assign ) = 187 index (AssignAdd ) = 188 index (AssignAnd ) = 189 index (AssignDiv ) = 190 index (AssignLeft ) = 191 index (AssignMod ) = 192 index (AssignMul ) = 193 index (AssignOr ) = 194 index (AssignRight ) = 195 index (AssignSub ) = 196 index (AssignTrip ) = 197 index (AssignXor ) = 198 index (Sem1 ) = 199 index (Ident _) = 200 index (Unsigned _) = 201 index (Long _) = 202 index (UnsignedLong _) = 203 index (Hexadecimal _) = 204 index (HexUnsigned _) = 205 index (HexLong _) = 206 index (HexUnsLong _) = 207 index (Octal _) = 208 index (OctalUnsigned _) = 209 index (OctalLong _) = 210 index (OctalUnsLong _) = 211 index (JDouble _) = 212 index (JFloat _) = 213 index (JLongDouble _) = 214 index (UnicodeChar _) = 215 index (JChar _) = 216 johnMajorEq :: Tree a -> Tree b -> P.Bool johnMajorEq (ProgF imports typeDeclarations) (ProgF imports_ typeDeclarations_) = imports == imports_ && typeDeclarations == typeDeclarations_ johnMajorEq (Prpkg idents semis imports typeDeclarations) (Prpkg idents_ semis_ imports_ typeDeclarations_) = idents == idents_ && semis == semis_ && imports == imports_ && typeDeclarations == typeDeclarations_ johnMajorEq (ImportA idents semis) (ImportA idents_ semis_) = idents == idents_ && semis == semis_ johnMajorEq (ImportN idents semis) (ImportN idents_ semis_) = idents == idents_ && semis == semis_ johnMajorEq (TypeDecl classHeader fieldDeclarations) (TypeDecl classHeader_ fieldDeclarations_) = classHeader == classHeader_ && fieldDeclarations == fieldDeclarations_ johnMajorEq (ClassDec modifiers x) (ClassDec modifiers_ x_) = modifiers == modifiers_ && x == x_ johnMajorEq (ClassDecE modifiers x typeNames) (ClassDecE modifiers_ x_ typeNames_) = modifiers == modifiers_ && x == x_ && typeNames == typeNames_ johnMajorEq (ClassDecEI modifiers x typeNames1 typeNames2) (ClassDecEI modifiers_ x_ typeNames1_ typeNames2_) = modifiers == modifiers_ && x == x_ && typeNames1 == typeNames1_ && typeNames2 == typeNames2_ johnMajorEq (ClassDecI modifiers x typeNames) (ClassDecI modifiers_ x_ typeNames_) = modifiers == modifiers_ && x == x_ && typeNames == typeNames_ johnMajorEq (InterDec modifiers x) (InterDec modifiers_ x_) = modifiers == modifiers_ && x == x_ johnMajorEq (InterDecE modifiers x typeNames) (InterDecE modifiers_ x_ typeNames_) = modifiers == modifiers_ && x == x_ && typeNames == typeNames_ johnMajorEq (InterDecEI modifiers x typeNames1 typeNames2) (InterDecEI modifiers_ x_ typeNames1_ typeNames2_) = modifiers == modifiers_ && x == x_ && typeNames1 == typeNames1_ && typeNames2 == typeNames2_ johnMajorEq (InterDecI modifiers x typeNames) (InterDecI modifiers_ x_ typeNames_) = modifiers == modifiers_ && x == x_ && typeNames == typeNames_ johnMajorEq (Dblk body) (Dblk body_) = body == body_ johnMajorEq (Dconst modifiers x parameters body) (Dconst modifiers_ x_ parameters_ body_) = modifiers == modifiers_ && x == x_ && parameters == parameters_ && body == body_ johnMajorEq (Dconstt modifiers x parameters typeNames body) (Dconstt modifiers_ x_ parameters_ typeNames_ body_) = modifiers == modifiers_ && x == x_ && parameters == parameters_ && typeNames == typeNames_ && body == body_ johnMajorEq (Dinnerclass typeDeclaration) (Dinnerclass typeDeclaration_) = typeDeclaration == typeDeclaration_ johnMajorEq (Dmth modifiers typeSpec methodDecl methodBody) (Dmth modifiers_ typeSpec_ methodDecl_ methodBody_) = modifiers == modifiers_ && typeSpec == typeSpec_ && methodDecl == methodDecl_ && methodBody == methodBody_ johnMajorEq (Dmthth modifiers typeSpec methodDecl typeNames methodBody) (Dmthth modifiers_ typeSpec_ methodDecl_ typeNames_ methodBody_) = modifiers == modifiers_ && typeSpec == typeSpec_ && methodDecl == methodDecl_ && typeNames == typeNames_ && methodBody == methodBody_ johnMajorEq (Dvar modifiers typeSpec varDecls) (Dvar modifiers_ typeSpec_ varDecls_) = modifiers == modifiers_ && typeSpec == typeSpec_ && varDecls == varDecls_ johnMajorEq IBody IBody = P.True johnMajorEq (MBody body) (MBody body_) = body == body_ johnMajorEq (LVar typeSpec varDecls) (LVar typeSpec_ varDecls_) = typeSpec == typeSpec_ && varDecls == varDecls_ johnMajorEq (LVarf typeSpec varDecls) (LVarf typeSpec_ varDecls_) = typeSpec == typeSpec_ && varDecls == varDecls_ johnMajorEq (Statem stm) (Statem stm_) = stm == stm_ johnMajorEq (BodyImpl lVarStatements) (BodyImpl lVarStatements_) = lVarStatements == lVarStatements_ johnMajorEq (Case exp) (Case exp_) = exp == exp_ johnMajorEq Dflt Dflt = P.True johnMajorEq (Exps exp) (Exps exp_) = exp == exp_ johnMajorEq (Grd guardStm) (Grd guardStm_) = guardStm == guardStm_ johnMajorEq (Iter iterStm) (Iter iterStm_) = iterStm == iterStm_ johnMajorEq (Jmp jumpStm) (Jmp jumpStm_) = jumpStm == jumpStm_ johnMajorEq (LV lVarStatements) (LV lVarStatements_) = lVarStatements == lVarStatements_ johnMajorEq (Lbl x) (Lbl x_) = x == x_ johnMajorEq (Sel selectionStm) (Sel selectionStm_) = selectionStm == selectionStm_ johnMajorEq Sem Sem = P.True johnMajorEq (DeclArray x bracketsOpts) (DeclArray x_ bracketsOpts_) = x == x_ && bracketsOpts == bracketsOpts_ johnMajorEq (DeclName x) (DeclName x_) = x == x_ johnMajorEq (VDecl x) (VDecl x_) = x == x_ johnMajorEq (VDeclAssign declaratorName variableInits) (VDeclAssign declaratorName_ variableInits_) = declaratorName == declaratorName_ && variableInits == variableInits_ johnMajorEq (IArri arrayInits) (IArri arrayInits_) = arrayInits == arrayInits_ johnMajorEq IEmpt IEmpt = P.True johnMajorEq (IExp exp) (IExp exp_) = exp == exp_ johnMajorEq (Vai arrayInits variableInits) (Vai arrayInits_ variableInits_) = arrayInits == arrayInits_ && variableInits == variableInits_ johnMajorEq (Vainit variableInits) (Vainit variableInits_) = variableInits == variableInits_ johnMajorEq (Vais arrayInits) (Vais arrayInits_) = arrayInits == arrayInits_ johnMajorEq (Mth declaratorName parameters) (Mth declaratorName_ parameters_) = declaratorName == declaratorName_ && parameters == parameters_ johnMajorEq (MthdArr methodDecl bracketsOpt) (MthdArr methodDecl_ bracketsOpt_) = methodDecl == methodDecl_ && bracketsOpt == bracketsOpt_ johnMajorEq (Param typeSpec declaratorName) (Param typeSpec_ declaratorName_) = typeSpec == typeSpec_ && declaratorName == declaratorName_ johnMajorEq (Pfinal typeSpec declaratorName) (Pfinal typeSpec_ declaratorName_) = typeSpec == typeSpec_ && declaratorName == declaratorName_ johnMajorEq (If exp stm1 elseIfStms stm2) (If exp_ stm1_ elseIfStms_ stm2_) = exp == exp_ && stm1 == stm1_ && elseIfStms == elseIfStms_ && stm2 == stm2_ johnMajorEq (Ifone exp stm elseIfStms) (Ifone exp_ stm_ elseIfStms_) = exp == exp_ && stm == stm_ && elseIfStms == elseIfStms_ johnMajorEq (Switch exp body) (Switch exp_ body_) = exp == exp_ && body == body_ johnMajorEq (Elseif exp stm) (Elseif exp_ stm_) = exp == exp_ && stm == stm_ johnMajorEq Break Break = P.True johnMajorEq (Brlabel x) (Brlabel x_) = x == x_ johnMajorEq Continue Continue = P.True johnMajorEq (Continuelabel x) (Continuelabel x_) = x == x_ johnMajorEq Return Return = P.True johnMajorEq (ReturnExp exp) (ReturnExp exp_) = exp == exp_ johnMajorEq (Throw exp) (Throw exp_) = exp == exp_ johnMajorEq (Synchronized exp body) (Synchronized exp_ body_) = exp == exp_ && body == body_ johnMajorEq (Try body catchs) (Try body_ catchs_) = body == body_ && catchs == catchs_ johnMajorEq (Tryfinally body1 catchs body2) (Tryfinally body1_ catchs_ body2_) = body1 == body1_ && catchs == catchs_ && body2 == body2_ johnMajorEq (Catch1 typeSpec x body) (Catch1 typeSpec_ x_ body_) = typeSpec == typeSpec_ && x == x_ && body == body_ johnMajorEq (Catch2 typeSpec body) (Catch2 typeSpec_ body_) = typeSpec == typeSpec_ && body == body_ johnMajorEq (Do stm exp) (Do stm_ exp_) = stm == stm_ && exp == exp_ johnMajorEq (For forInit exps1 exps2 stm) (For forInit_ exps1_ exps2_ stm_) = forInit == forInit_ && exps1 == exps1_ && exps2 == exps2_ && stm == stm_ johnMajorEq (While exp stm) (While exp_ stm_) = exp == exp_ && stm == stm_ johnMajorEq (DeclVar typeSpec varDecls) (DeclVar typeSpec_ varDecls_) = typeSpec == typeSpec_ && varDecls == varDecls_ johnMajorEq (DeclVarFinal typeSpec varDecls) (DeclVarFinal typeSpec_ varDecls_) = typeSpec == typeSpec_ && varDecls == varDecls_ johnMajorEq (Exprs1 exps) (Exprs1 exps_) = exps == exps_ johnMajorEq Mabstract Mabstract = P.True johnMajorEq Mfinal Mfinal = P.True johnMajorEq Mnative Mnative = P.True johnMajorEq Mprivate Mprivate = P.True johnMajorEq Mprotected Mprotected = P.True johnMajorEq Mpublic Mpublic = P.True johnMajorEq Mstatic Mstatic = P.True johnMajorEq Msync Msync = P.True johnMajorEq Mtransient Mtransient = P.True johnMajorEq Mvolatile Mvolatile = P.True johnMajorEq Tboolean Tboolean = P.True johnMajorEq Tbyte Tbyte = P.True johnMajorEq Tchar Tchar = P.True johnMajorEq Tdouble Tdouble = P.True johnMajorEq Tfloat Tfloat = P.True johnMajorEq Tint Tint = P.True johnMajorEq Tlong Tlong = P.True johnMajorEq Tshort Tshort = P.True johnMajorEq (ArrayType typeName bracketsOpts) (ArrayType typeName_ bracketsOpts_) = typeName == typeName_ && bracketsOpts == bracketsOpts_ johnMajorEq (NamedType typeName) (NamedType typeName_) = typeName == typeName_ johnMajorEq (BuiltIn basicType) (BuiltIn basicType_) = basicType == basicType_ johnMajorEq (ClassType idents) (ClassType idents_) = idents == idents_ johnMajorEq BracketsEmpty BracketsEmpty = P.True johnMajorEq (Earr arrAcc) (Earr arrAcc_) = arrAcc == arrAcc_ johnMajorEq (Earrcoercion idents bracketsOpts exp) (Earrcoercion idents_ bracketsOpts_ exp_) = idents == idents_ && bracketsOpts == bracketsOpts_ && exp == exp_ johnMajorEq (Eassign exp1 assignment_op exp2) (Eassign exp1_ assignment_op_ exp2_) = exp1 == exp1_ && assignment_op == assignment_op_ && exp2 == exp2_ johnMajorEq (Ebcoercion basicType exp) (Ebcoercion basicType_ exp_) = basicType == basicType_ && exp == exp_ johnMajorEq (Ebitand exp1 exp2) (Ebitand exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Ebitexor exp1 exp2) (Ebitexor exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Ebitor exp1 exp2) (Ebitor exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Econdition exp1 exp2 exp3) (Econdition exp1_ exp2_ exp3_) = exp1 == exp1_ && exp2 == exp2_ && exp3 == exp3_ johnMajorEq (Econst constant) (Econst constant_) = constant == constant_ johnMajorEq (Ediv exp1 exp2) (Ediv exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Eeq exp1 exp2) (Eeq exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Eexpcoercion exp1 exp2) (Eexpcoercion exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Efld fieldAcc) (Efld fieldAcc_) = fieldAcc == fieldAcc_ johnMajorEq (Ege exp1 exp2) (Ege exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Egrthen exp1 exp2) (Egrthen exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Eland exp1 exp2) (Eland exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Ele exp1 exp2) (Ele exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Eleft exp1 exp2) (Eleft exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Elor exp1 exp2) (Elor exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Elthen exp1 exp2) (Elthen exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Eminus exp1 exp2) (Eminus exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Emod exp1 exp2) (Emod exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Emth mthCall) (Emth mthCall_) = mthCall == mthCall_ johnMajorEq (Eneq exp1 exp2) (Eneq exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Enewalloc newAlloc) (Enewalloc newAlloc_) = newAlloc == newAlloc_ johnMajorEq (Eplus exp1 exp2) (Eplus exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Epostdec exp) (Epostdec exp_) = exp == exp_ johnMajorEq (Epostinc exp) (Epostinc exp_) = exp == exp_ johnMajorEq (Epredec exp) (Epredec exp_) = exp == exp_ johnMajorEq (Epreinc exp) (Epreinc exp_) = exp == exp_ johnMajorEq (Epreop unary_operator exp) (Epreop unary_operator_ exp_) = unary_operator == unary_operator_ && exp == exp_ johnMajorEq (Eright exp1 exp2) (Eright exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Especname specName) (Especname specName_) = specName == specName_ johnMajorEq (Estring str) (Estring str_) = str == str_ johnMajorEq (Etimes exp1 exp2) (Etimes exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Etrip exp1 exp2) (Etrip exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Etype exp typeName) (Etype exp_ typeName_) = exp == exp_ && typeName == typeName_ johnMajorEq (Evar idents) (Evar idents_) = idents == idents_ johnMajorEq SSnull SSnull = P.True johnMajorEq SSsuper SSsuper = P.True johnMajorEq SSthis SSthis = P.True johnMajorEq (Anewarray typeName dimExprs) (Anewarray typeName_ dimExprs_) = typeName == typeName_ && dimExprs == dimExprs_ johnMajorEq (Anewarriempty typeName dimExprs) (Anewarriempty typeName_ dimExprs_) = typeName == typeName_ && dimExprs == dimExprs_ johnMajorEq (Anewarrinits typeName dimExprs arrayInits) (Anewarrinits typeName_ dimExprs_ arrayInits_) = typeName == typeName_ && dimExprs == dimExprs_ && arrayInits == arrayInits_ johnMajorEq (Anewclass typeName args) (Anewclass typeName_ args_) = typeName == typeName_ && args == args_ johnMajorEq (Anewinnerclass typeName args fieldDeclarations) (Anewinnerclass typeName_ args_ fieldDeclarations_) = typeName == typeName_ && args == args_ && fieldDeclarations == fieldDeclarations_ johnMajorEq (Aarr idents exp) (Aarr idents_ exp_) = idents == idents_ && exp == exp_ johnMajorEq (Aarr1 specExp exp) (Aarr1 specExp_ exp_) = specExp == specExp_ && exp == exp_ johnMajorEq (Cep exp) (Cep exp_) = exp == exp_ johnMajorEq (Cnp specExpNP) (Cnp specExpNP_) = specExpNP == specExpNP_ johnMajorEq (Cthis specName) (Cthis specName_) = specName == specName_ johnMajorEq (CNLit constant) (CNLit constant_) = constant == constant_ johnMajorEq (CNParr arrAcc) (CNParr arrAcc_) = arrAcc == arrAcc_ johnMajorEq (CNPfld fieldAcc) (CNPfld fieldAcc_) = fieldAcc == fieldAcc_ johnMajorEq (CNPmth mthCall) (CNPmth mthCall_) = mthCall == mthCall_ johnMajorEq (Mmth idents args) (Mmth idents_ args_) = idents == idents_ && args == args_ johnMajorEq (Mmth1 specExpNP args) (Mmth1 specExpNP_ args_) = specExpNP == specExpNP_ && args == args_ johnMajorEq (Mmthspec specName args) (Mmthspec specName_ args_) = specName == specName_ && args == args_ johnMajorEq (Fclass idents) (Fclass idents_) = idents == idents_ johnMajorEq (Ffclass2 basicType) (Ffclass2 basicType_) = basicType == basicType_ johnMajorEq (Ffthis idents) (Ffthis idents_) = idents == idents_ johnMajorEq (Ffvar specExp x) (Ffvar specExp_ x_) = specExp == specExp_ && x == x_ johnMajorEq (Ffvar1 newAlloc x) (Ffvar1 newAlloc_ x_) = newAlloc == newAlloc_ && x == x_ johnMajorEq (ArgList exps) (ArgList exps_) = exps == exps_ johnMajorEq (Dim exp) (Dim exp_) = exp == exp_ johnMajorEq (Ecdouble jDouble) (Ecdouble jDouble_) = jDouble == jDouble_ johnMajorEq (Ecfloat jFloat) (Ecfloat jFloat_) = jFloat == jFloat_ johnMajorEq (Echar jChar) (Echar jChar_) = jChar == jChar_ johnMajorEq (Eclongdouble jLongDouble) (Eclongdouble jLongDouble_) = jLongDouble == jLongDouble_ johnMajorEq (Edouble d) (Edouble d_) = d == d_ johnMajorEq Efalse Efalse = P.True johnMajorEq (Efloat d) (Efloat d_) = d == d_ johnMajorEq (Ehexadec hexadecimal) (Ehexadec hexadecimal_) = hexadecimal == hexadecimal_ johnMajorEq (Ehexalong hexLong) (Ehexalong hexLong_) = hexLong == hexLong_ johnMajorEq (Ehexaunsign hexUnsigned) (Ehexaunsign hexUnsigned_) = hexUnsigned == hexUnsigned_ johnMajorEq (Ehexaunslong hexUnsLong) (Ehexaunslong hexUnsLong_) = hexUnsLong == hexUnsLong_ johnMajorEq (Eint n) (Eint n_) = n == n_ johnMajorEq (Elong long) (Elong long_) = long == long_ johnMajorEq (Elonger n) (Elonger n_) = n == n_ johnMajorEq (Eoctal octal) (Eoctal octal_) = octal == octal_ johnMajorEq (Eoctallong octalLong) (Eoctallong octalLong_) = octalLong == octalLong_ johnMajorEq (Eoctalunsign octalUnsigned) (Eoctalunsign octalUnsigned_) = octalUnsigned == octalUnsigned_ johnMajorEq (Eoctalunslong octalUnsLong) (Eoctalunslong octalUnsLong_) = octalUnsLong == octalUnsLong_ johnMajorEq Etrue Etrue = P.True johnMajorEq (Eunicode unicodeChar) (Eunicode unicodeChar_) = unicodeChar == unicodeChar_ johnMajorEq (Eunsigned unsigned) (Eunsigned unsigned_) = unsigned == unsigned_ johnMajorEq (Eunsignlong unsignedLong) (Eunsignlong unsignedLong_) = unsignedLong == unsignedLong_ johnMajorEq Complement Complement = P.True johnMajorEq Logicalneg Logicalneg = P.True johnMajorEq Negative Negative = P.True johnMajorEq Plus Plus = P.True johnMajorEq Assign Assign = P.True johnMajorEq AssignAdd AssignAdd = P.True johnMajorEq AssignAnd AssignAnd = P.True johnMajorEq AssignDiv AssignDiv = P.True johnMajorEq AssignLeft AssignLeft = P.True johnMajorEq AssignMod AssignMod = P.True johnMajorEq AssignMul AssignMul = P.True johnMajorEq AssignOr AssignOr = P.True johnMajorEq AssignRight AssignRight = P.True johnMajorEq AssignSub AssignSub = P.True johnMajorEq AssignTrip AssignTrip = P.True johnMajorEq AssignXor AssignXor = P.True johnMajorEq Sem1 Sem1 = P.True johnMajorEq (Ident str) (Ident str_) = str == str_ johnMajorEq (Unsigned str) (Unsigned str_) = str == str_ johnMajorEq (Long str) (Long str_) = str == str_ johnMajorEq (UnsignedLong str) (UnsignedLong str_) = str == str_ johnMajorEq (Hexadecimal str) (Hexadecimal str_) = str == str_ johnMajorEq (HexUnsigned str) (HexUnsigned str_) = str == str_ johnMajorEq (HexLong str) (HexLong str_) = str == str_ johnMajorEq (HexUnsLong str) (HexUnsLong str_) = str == str_ johnMajorEq (Octal str) (Octal str_) = str == str_ johnMajorEq (OctalUnsigned str) (OctalUnsigned str_) = str == str_ johnMajorEq (OctalLong str) (OctalLong str_) = str == str_ johnMajorEq (OctalUnsLong str) (OctalUnsLong str_) = str == str_ johnMajorEq (JDouble str) (JDouble str_) = str == str_ johnMajorEq (JFloat str) (JFloat str_) = str == str_ johnMajorEq (JLongDouble str) (JLongDouble str_) = str == str_ johnMajorEq (UnicodeChar str) (UnicodeChar str_) = str == str_ johnMajorEq (JChar str) (JChar str_) = str == str_ johnMajorEq _ _ = P.False compareSame :: Tree c -> Tree c -> P.Ordering compareSame (ProgF imports typeDeclarations) (ProgF imports_ typeDeclarations_) = P.mappend (P.compare imports imports_) (P.compare typeDeclarations typeDeclarations_) compareSame (Prpkg idents semis imports typeDeclarations) (Prpkg idents_ semis_ imports_ typeDeclarations_) = P.mappend (P.compare idents idents_) (P.mappend (P.compare semis semis_) (P.mappend (P.compare imports imports_) (P.compare typeDeclarations typeDeclarations_))) compareSame (ImportA idents semis) (ImportA idents_ semis_) = P.mappend (P.compare idents idents_) (P.compare semis semis_) compareSame (ImportN idents semis) (ImportN idents_ semis_) = P.mappend (P.compare idents idents_) (P.compare semis semis_) compareSame (TypeDecl classHeader fieldDeclarations) (TypeDecl classHeader_ fieldDeclarations_) = P.mappend (P.compare classHeader classHeader_) (P.compare fieldDeclarations fieldDeclarations_) compareSame (ClassDec modifiers x) (ClassDec modifiers_ x_) = P.mappend (P.compare modifiers modifiers_) (P.compare x x_) compareSame (ClassDecE modifiers x typeNames) (ClassDecE modifiers_ x_ typeNames_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare x x_) (P.compare typeNames typeNames_)) compareSame (ClassDecEI modifiers x typeNames1 typeNames2) (ClassDecEI modifiers_ x_ typeNames1_ typeNames2_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare x x_) (P.mappend (P.compare typeNames1 typeNames1_) (P.compare typeNames2 typeNames2_))) compareSame (ClassDecI modifiers x typeNames) (ClassDecI modifiers_ x_ typeNames_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare x x_) (P.compare typeNames typeNames_)) compareSame (InterDec modifiers x) (InterDec modifiers_ x_) = P.mappend (P.compare modifiers modifiers_) (P.compare x x_) compareSame (InterDecE modifiers x typeNames) (InterDecE modifiers_ x_ typeNames_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare x x_) (P.compare typeNames typeNames_)) compareSame (InterDecEI modifiers x typeNames1 typeNames2) (InterDecEI modifiers_ x_ typeNames1_ typeNames2_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare x x_) (P.mappend (P.compare typeNames1 typeNames1_) (P.compare typeNames2 typeNames2_))) compareSame (InterDecI modifiers x typeNames) (InterDecI modifiers_ x_ typeNames_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare x x_) (P.compare typeNames typeNames_)) compareSame (Dblk body) (Dblk body_) = P.compare body body_ compareSame (Dconst modifiers x parameters body) (Dconst modifiers_ x_ parameters_ body_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare x x_) (P.mappend (P.compare parameters parameters_) (P.compare body body_))) compareSame (Dconstt modifiers x parameters typeNames body) (Dconstt modifiers_ x_ parameters_ typeNames_ body_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare x x_) (P.mappend (P.compare parameters parameters_) (P.mappend (P.compare typeNames typeNames_) (P.compare body body_)))) compareSame (Dinnerclass typeDeclaration) (Dinnerclass typeDeclaration_) = P.compare typeDeclaration typeDeclaration_ compareSame (Dmth modifiers typeSpec methodDecl methodBody) (Dmth modifiers_ typeSpec_ methodDecl_ methodBody_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare typeSpec typeSpec_) (P.mappend (P.compare methodDecl methodDecl_) (P.compare methodBody methodBody_))) compareSame (Dmthth modifiers typeSpec methodDecl typeNames methodBody) (Dmthth modifiers_ typeSpec_ methodDecl_ typeNames_ methodBody_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare typeSpec typeSpec_) (P.mappend (P.compare methodDecl methodDecl_) (P.mappend (P.compare typeNames typeNames_) (P.compare methodBody methodBody_)))) compareSame (Dvar modifiers typeSpec varDecls) (Dvar modifiers_ typeSpec_ varDecls_) = P.mappend (P.compare modifiers modifiers_) (P.mappend (P.compare typeSpec typeSpec_) (P.compare varDecls varDecls_)) compareSame IBody IBody = P.EQ compareSame (MBody body) (MBody body_) = P.compare body body_ compareSame (LVar typeSpec varDecls) (LVar typeSpec_ varDecls_) = P.mappend (P.compare typeSpec typeSpec_) (P.compare varDecls varDecls_) compareSame (LVarf typeSpec varDecls) (LVarf typeSpec_ varDecls_) = P.mappend (P.compare typeSpec typeSpec_) (P.compare varDecls varDecls_) compareSame (Statem stm) (Statem stm_) = P.compare stm stm_ compareSame (BodyImpl lVarStatements) (BodyImpl lVarStatements_) = P.compare lVarStatements lVarStatements_ compareSame (Case exp) (Case exp_) = P.compare exp exp_ compareSame Dflt Dflt = P.EQ compareSame (Exps exp) (Exps exp_) = P.compare exp exp_ compareSame (Grd guardStm) (Grd guardStm_) = P.compare guardStm guardStm_ compareSame (Iter iterStm) (Iter iterStm_) = P.compare iterStm iterStm_ compareSame (Jmp jumpStm) (Jmp jumpStm_) = P.compare jumpStm jumpStm_ compareSame (LV lVarStatements) (LV lVarStatements_) = P.compare lVarStatements lVarStatements_ compareSame (Lbl x) (Lbl x_) = P.compare x x_ compareSame (Sel selectionStm) (Sel selectionStm_) = P.compare selectionStm selectionStm_ compareSame Sem Sem = P.EQ compareSame (DeclArray x bracketsOpts) (DeclArray x_ bracketsOpts_) = P.mappend (P.compare x x_) (P.compare bracketsOpts bracketsOpts_) compareSame (DeclName x) (DeclName x_) = P.compare x x_ compareSame (VDecl x) (VDecl x_) = P.compare x x_ compareSame (VDeclAssign declaratorName variableInits) (VDeclAssign declaratorName_ variableInits_) = P.mappend (P.compare declaratorName declaratorName_) (P.compare variableInits variableInits_) compareSame (IArri arrayInits) (IArri arrayInits_) = P.compare arrayInits arrayInits_ compareSame IEmpt IEmpt = P.EQ compareSame (IExp exp) (IExp exp_) = P.compare exp exp_ compareSame (Vai arrayInits variableInits) (Vai arrayInits_ variableInits_) = P.mappend (P.compare arrayInits arrayInits_) (P.compare variableInits variableInits_) compareSame (Vainit variableInits) (Vainit variableInits_) = P.compare variableInits variableInits_ compareSame (Vais arrayInits) (Vais arrayInits_) = P.compare arrayInits arrayInits_ compareSame (Mth declaratorName parameters) (Mth declaratorName_ parameters_) = P.mappend (P.compare declaratorName declaratorName_) (P.compare parameters parameters_) compareSame (MthdArr methodDecl bracketsOpt) (MthdArr methodDecl_ bracketsOpt_) = P.mappend (P.compare methodDecl methodDecl_) (P.compare bracketsOpt bracketsOpt_) compareSame (Param typeSpec declaratorName) (Param typeSpec_ declaratorName_) = P.mappend (P.compare typeSpec typeSpec_) (P.compare declaratorName declaratorName_) compareSame (Pfinal typeSpec declaratorName) (Pfinal typeSpec_ declaratorName_) = P.mappend (P.compare typeSpec typeSpec_) (P.compare declaratorName declaratorName_) compareSame (If exp stm1 elseIfStms stm2) (If exp_ stm1_ elseIfStms_ stm2_) = P.mappend (P.compare exp exp_) (P.mappend (P.compare stm1 stm1_) (P.mappend (P.compare elseIfStms elseIfStms_) (P.compare stm2 stm2_))) compareSame (Ifone exp stm elseIfStms) (Ifone exp_ stm_ elseIfStms_) = P.mappend (P.compare exp exp_) (P.mappend (P.compare stm stm_) (P.compare elseIfStms elseIfStms_)) compareSame (Switch exp body) (Switch exp_ body_) = P.mappend (P.compare exp exp_) (P.compare body body_) compareSame (Elseif exp stm) (Elseif exp_ stm_) = P.mappend (P.compare exp exp_) (P.compare stm stm_) compareSame Break Break = P.EQ compareSame (Brlabel x) (Brlabel x_) = P.compare x x_ compareSame Continue Continue = P.EQ compareSame (Continuelabel x) (Continuelabel x_) = P.compare x x_ compareSame Return Return = P.EQ compareSame (ReturnExp exp) (ReturnExp exp_) = P.compare exp exp_ compareSame (Throw exp) (Throw exp_) = P.compare exp exp_ compareSame (Synchronized exp body) (Synchronized exp_ body_) = P.mappend (P.compare exp exp_) (P.compare body body_) compareSame (Try body catchs) (Try body_ catchs_) = P.mappend (P.compare body body_) (P.compare catchs catchs_) compareSame (Tryfinally body1 catchs body2) (Tryfinally body1_ catchs_ body2_) = P.mappend (P.compare body1 body1_) (P.mappend (P.compare catchs catchs_) (P.compare body2 body2_)) compareSame (Catch1 typeSpec x body) (Catch1 typeSpec_ x_ body_) = P.mappend (P.compare typeSpec typeSpec_) (P.mappend (P.compare x x_) (P.compare body body_)) compareSame (Catch2 typeSpec body) (Catch2 typeSpec_ body_) = P.mappend (P.compare typeSpec typeSpec_) (P.compare body body_) compareSame (Do stm exp) (Do stm_ exp_) = P.mappend (P.compare stm stm_) (P.compare exp exp_) compareSame (For forInit exps1 exps2 stm) (For forInit_ exps1_ exps2_ stm_) = P.mappend (P.compare forInit forInit_) (P.mappend (P.compare exps1 exps1_) (P.mappend (P.compare exps2 exps2_) (P.compare stm stm_))) compareSame (While exp stm) (While exp_ stm_) = P.mappend (P.compare exp exp_) (P.compare stm stm_) compareSame (DeclVar typeSpec varDecls) (DeclVar typeSpec_ varDecls_) = P.mappend (P.compare typeSpec typeSpec_) (P.compare varDecls varDecls_) compareSame (DeclVarFinal typeSpec varDecls) (DeclVarFinal typeSpec_ varDecls_) = P.mappend (P.compare typeSpec typeSpec_) (P.compare varDecls varDecls_) compareSame (Exprs1 exps) (Exprs1 exps_) = P.compare exps exps_ compareSame Mabstract Mabstract = P.EQ compareSame Mfinal Mfinal = P.EQ compareSame Mnative Mnative = P.EQ compareSame Mprivate Mprivate = P.EQ compareSame Mprotected Mprotected = P.EQ compareSame Mpublic Mpublic = P.EQ compareSame Mstatic Mstatic = P.EQ compareSame Msync Msync = P.EQ compareSame Mtransient Mtransient = P.EQ compareSame Mvolatile Mvolatile = P.EQ compareSame Tboolean Tboolean = P.EQ compareSame Tbyte Tbyte = P.EQ compareSame Tchar Tchar = P.EQ compareSame Tdouble Tdouble = P.EQ compareSame Tfloat Tfloat = P.EQ compareSame Tint Tint = P.EQ compareSame Tlong Tlong = P.EQ compareSame Tshort Tshort = P.EQ compareSame (ArrayType typeName bracketsOpts) (ArrayType typeName_ bracketsOpts_) = P.mappend (P.compare typeName typeName_) (P.compare bracketsOpts bracketsOpts_) compareSame (NamedType typeName) (NamedType typeName_) = P.compare typeName typeName_ compareSame (BuiltIn basicType) (BuiltIn basicType_) = P.compare basicType basicType_ compareSame (ClassType idents) (ClassType idents_) = P.compare idents idents_ compareSame BracketsEmpty BracketsEmpty = P.EQ compareSame (Earr arrAcc) (Earr arrAcc_) = P.compare arrAcc arrAcc_ compareSame (Earrcoercion idents bracketsOpts exp) (Earrcoercion idents_ bracketsOpts_ exp_) = P.mappend (P.compare idents idents_) (P.mappend (P.compare bracketsOpts bracketsOpts_) (P.compare exp exp_)) compareSame (Eassign exp1 assignment_op exp2) (Eassign exp1_ assignment_op_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare assignment_op assignment_op_) (P.compare exp2 exp2_)) compareSame (Ebcoercion basicType exp) (Ebcoercion basicType_ exp_) = P.mappend (P.compare basicType basicType_) (P.compare exp exp_) compareSame (Ebitand exp1 exp2) (Ebitand exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Ebitexor exp1 exp2) (Ebitexor exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Ebitor exp1 exp2) (Ebitor exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Econdition exp1 exp2 exp3) (Econdition exp1_ exp2_ exp3_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare exp2 exp2_) (P.compare exp3 exp3_)) compareSame (Econst constant) (Econst constant_) = P.compare constant constant_ compareSame (Ediv exp1 exp2) (Ediv exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Eeq exp1 exp2) (Eeq exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Eexpcoercion exp1 exp2) (Eexpcoercion exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Efld fieldAcc) (Efld fieldAcc_) = P.compare fieldAcc fieldAcc_ compareSame (Ege exp1 exp2) (Ege exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Egrthen exp1 exp2) (Egrthen exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Eland exp1 exp2) (Eland exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Ele exp1 exp2) (Ele exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Eleft exp1 exp2) (Eleft exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Elor exp1 exp2) (Elor exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Elthen exp1 exp2) (Elthen exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Eminus exp1 exp2) (Eminus exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Emod exp1 exp2) (Emod exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Emth mthCall) (Emth mthCall_) = P.compare mthCall mthCall_ compareSame (Eneq exp1 exp2) (Eneq exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Enewalloc newAlloc) (Enewalloc newAlloc_) = P.compare newAlloc newAlloc_ compareSame (Eplus exp1 exp2) (Eplus exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Epostdec exp) (Epostdec exp_) = P.compare exp exp_ compareSame (Epostinc exp) (Epostinc exp_) = P.compare exp exp_ compareSame (Epredec exp) (Epredec exp_) = P.compare exp exp_ compareSame (Epreinc exp) (Epreinc exp_) = P.compare exp exp_ compareSame (Epreop unary_operator exp) (Epreop unary_operator_ exp_) = P.mappend (P.compare unary_operator unary_operator_) (P.compare exp exp_) compareSame (Eright exp1 exp2) (Eright exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Especname specName) (Especname specName_) = P.compare specName specName_ compareSame (Estring str) (Estring str_) = P.compare str str_ compareSame (Etimes exp1 exp2) (Etimes exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Etrip exp1 exp2) (Etrip exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Etype exp typeName) (Etype exp_ typeName_) = P.mappend (P.compare exp exp_) (P.compare typeName typeName_) compareSame (Evar idents) (Evar idents_) = P.compare idents idents_ compareSame SSnull SSnull = P.EQ compareSame SSsuper SSsuper = P.EQ compareSame SSthis SSthis = P.EQ compareSame (Anewarray typeName dimExprs) (Anewarray typeName_ dimExprs_) = P.mappend (P.compare typeName typeName_) (P.compare dimExprs dimExprs_) compareSame (Anewarriempty typeName dimExprs) (Anewarriempty typeName_ dimExprs_) = P.mappend (P.compare typeName typeName_) (P.compare dimExprs dimExprs_) compareSame (Anewarrinits typeName dimExprs arrayInits) (Anewarrinits typeName_ dimExprs_ arrayInits_) = P.mappend (P.compare typeName typeName_) (P.mappend (P.compare dimExprs dimExprs_) (P.compare arrayInits arrayInits_)) compareSame (Anewclass typeName args) (Anewclass typeName_ args_) = P.mappend (P.compare typeName typeName_) (P.compare args args_) compareSame (Anewinnerclass typeName args fieldDeclarations) (Anewinnerclass typeName_ args_ fieldDeclarations_) = P.mappend (P.compare typeName typeName_) (P.mappend (P.compare args args_) (P.compare fieldDeclarations fieldDeclarations_)) compareSame (Aarr idents exp) (Aarr idents_ exp_) = P.mappend (P.compare idents idents_) (P.compare exp exp_) compareSame (Aarr1 specExp exp) (Aarr1 specExp_ exp_) = P.mappend (P.compare specExp specExp_) (P.compare exp exp_) compareSame (Cep exp) (Cep exp_) = P.compare exp exp_ compareSame (Cnp specExpNP) (Cnp specExpNP_) = P.compare specExpNP specExpNP_ compareSame (Cthis specName) (Cthis specName_) = P.compare specName specName_ compareSame (CNLit constant) (CNLit constant_) = P.compare constant constant_ compareSame (CNParr arrAcc) (CNParr arrAcc_) = P.compare arrAcc arrAcc_ compareSame (CNPfld fieldAcc) (CNPfld fieldAcc_) = P.compare fieldAcc fieldAcc_ compareSame (CNPmth mthCall) (CNPmth mthCall_) = P.compare mthCall mthCall_ compareSame (Mmth idents args) (Mmth idents_ args_) = P.mappend (P.compare idents idents_) (P.compare args args_) compareSame (Mmth1 specExpNP args) (Mmth1 specExpNP_ args_) = P.mappend (P.compare specExpNP specExpNP_) (P.compare args args_) compareSame (Mmthspec specName args) (Mmthspec specName_ args_) = P.mappend (P.compare specName specName_) (P.compare args args_) compareSame (Fclass idents) (Fclass idents_) = P.compare idents idents_ compareSame (Ffclass2 basicType) (Ffclass2 basicType_) = P.compare basicType basicType_ compareSame (Ffthis idents) (Ffthis idents_) = P.compare idents idents_ compareSame (Ffvar specExp x) (Ffvar specExp_ x_) = P.mappend (P.compare specExp specExp_) (P.compare x x_) compareSame (Ffvar1 newAlloc x) (Ffvar1 newAlloc_ x_) = P.mappend (P.compare newAlloc newAlloc_) (P.compare x x_) compareSame (ArgList exps) (ArgList exps_) = P.compare exps exps_ compareSame (Dim exp) (Dim exp_) = P.compare exp exp_ compareSame (Ecdouble jDouble) (Ecdouble jDouble_) = P.compare jDouble jDouble_ compareSame (Ecfloat jFloat) (Ecfloat jFloat_) = P.compare jFloat jFloat_ compareSame (Echar jChar) (Echar jChar_) = P.compare jChar jChar_ compareSame (Eclongdouble jLongDouble) (Eclongdouble jLongDouble_) = P.compare jLongDouble jLongDouble_ compareSame (Edouble d) (Edouble d_) = P.compare d d_ compareSame Efalse Efalse = P.EQ compareSame (Efloat d) (Efloat d_) = P.compare d d_ compareSame (Ehexadec hexadecimal) (Ehexadec hexadecimal_) = P.compare hexadecimal hexadecimal_ compareSame (Ehexalong hexLong) (Ehexalong hexLong_) = P.compare hexLong hexLong_ compareSame (Ehexaunsign hexUnsigned) (Ehexaunsign hexUnsigned_) = P.compare hexUnsigned hexUnsigned_ compareSame (Ehexaunslong hexUnsLong) (Ehexaunslong hexUnsLong_) = P.compare hexUnsLong hexUnsLong_ compareSame (Eint n) (Eint n_) = P.compare n n_ compareSame (Elong long) (Elong long_) = P.compare long long_ compareSame (Elonger n) (Elonger n_) = P.compare n n_ compareSame (Eoctal octal) (Eoctal octal_) = P.compare octal octal_ compareSame (Eoctallong octalLong) (Eoctallong octalLong_) = P.compare octalLong octalLong_ compareSame (Eoctalunsign octalUnsigned) (Eoctalunsign octalUnsigned_) = P.compare octalUnsigned octalUnsigned_ compareSame (Eoctalunslong octalUnsLong) (Eoctalunslong octalUnsLong_) = P.compare octalUnsLong octalUnsLong_ compareSame Etrue Etrue = P.EQ compareSame (Eunicode unicodeChar) (Eunicode unicodeChar_) = P.compare unicodeChar unicodeChar_ compareSame (Eunsigned unsigned) (Eunsigned unsigned_) = P.compare unsigned unsigned_ compareSame (Eunsignlong unsignedLong) (Eunsignlong unsignedLong_) = P.compare unsignedLong unsignedLong_ compareSame Complement Complement = P.EQ compareSame Logicalneg Logicalneg = P.EQ compareSame Negative Negative = P.EQ compareSame Plus Plus = P.EQ compareSame Assign Assign = P.EQ compareSame AssignAdd AssignAdd = P.EQ compareSame AssignAnd AssignAnd = P.EQ compareSame AssignDiv AssignDiv = P.EQ compareSame AssignLeft AssignLeft = P.EQ compareSame AssignMod AssignMod = P.EQ compareSame AssignMul AssignMul = P.EQ compareSame AssignOr AssignOr = P.EQ compareSame AssignRight AssignRight = P.EQ compareSame AssignSub AssignSub = P.EQ compareSame AssignTrip AssignTrip = P.EQ compareSame AssignXor AssignXor = P.EQ compareSame Sem1 Sem1 = P.EQ compareSame (Ident str) (Ident str_) = P.compare str str_ compareSame (Unsigned str) (Unsigned str_) = P.compare str str_ compareSame (Long str) (Long str_) = P.compare str str_ compareSame (UnsignedLong str) (UnsignedLong str_) = P.compare str str_ compareSame (Hexadecimal str) (Hexadecimal str_) = P.compare str str_ compareSame (HexUnsigned str) (HexUnsigned str_) = P.compare str str_ compareSame (HexLong str) (HexLong str_) = P.compare str str_ compareSame (HexUnsLong str) (HexUnsLong str_) = P.compare str str_ compareSame (Octal str) (Octal str_) = P.compare str str_ compareSame (OctalUnsigned str) (OctalUnsigned str_) = P.compare str str_ compareSame (OctalLong str) (OctalLong str_) = P.compare str str_ compareSame (OctalUnsLong str) (OctalUnsLong str_) = P.compare str str_ compareSame (JDouble str) (JDouble str_) = P.compare str str_ compareSame (JFloat str) (JFloat str_) = P.compare str str_ compareSame (JLongDouble str) (JLongDouble str_) = P.compare str str_ compareSame (UnicodeChar str) (UnicodeChar str_) = P.compare str str_ compareSame (JChar str) (JChar str_) = P.compare str str_ compareSame _ _ = P.error "BNFC error: compareSame"