-- 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 AbsC ( Tree(..) , Program , External_declaration , Function_def , Dec , Declaration_specifier , Init_declarator , Type_specifier , Storage_class_specifier , Type_qualifier , Struct_or_union_spec , Struct_or_union , Struct_dec , Spec_qual , Struct_declarator , Enum_specifier , Enumerator , Declarator , Direct_declarator , Pointer , Parameter_type , Parameter_declarations , Parameter_declaration , Initializer , Initializers , Type_name , Abstract_declarator , Dir_abs_dec , Stm , Labeled_stm , Compound_stm , Expression_stm , Selection_stm , Iter_stm , Jump_stm , Exp , Constant , Constant_expression , Unary_operator , Assignment_op , Ident , Unsigned , Long , UnsignedLong , Hexadecimal , HexUnsigned , HexLong , HexUnsLong , Octal , OctalUnsigned , OctalLong , OctalUnsLong , CDouble , CFloat , CLongDouble , johnMajorEq , module ComposOpC ) where import Prelude ((.), (>), (&&), (==)) import Prelude ((.), (>), (&&), (==)) import qualified Prelude as P import ComposOpC data Tag = Program_ | External_declaration_ | Function_def_ | Dec_ | Declaration_specifier_ | Init_declarator_ | Type_specifier_ | Storage_class_specifier_ | Type_qualifier_ | Struct_or_union_spec_ | Struct_or_union_ | Struct_dec_ | Spec_qual_ | Struct_declarator_ | Enum_specifier_ | Enumerator_ | Declarator_ | Direct_declarator_ | Pointer_ | Parameter_type_ | Parameter_declarations_ | Parameter_declaration_ | Initializer_ | Initializers_ | Type_name_ | Abstract_declarator_ | Dir_abs_dec_ | Stm_ | Labeled_stm_ | Compound_stm_ | Expression_stm_ | Selection_stm_ | Iter_stm_ | Jump_stm_ | Exp_ | Constant_ | Constant_expression_ | Unary_operator_ | Assignment_op_ | Ident_ | Unsigned_ | Long_ | UnsignedLong_ | Hexadecimal_ | HexUnsigned_ | HexLong_ | HexUnsLong_ | Octal_ | OctalUnsigned_ | OctalLong_ | OctalUnsLong_ | CDouble_ | CFloat_ | CLongDouble_ type Program = Tree 'Program_ type External_declaration = Tree 'External_declaration_ type Function_def = Tree 'Function_def_ type Dec = Tree 'Dec_ type Declaration_specifier = Tree 'Declaration_specifier_ type Init_declarator = Tree 'Init_declarator_ type Type_specifier = Tree 'Type_specifier_ type Storage_class_specifier = Tree 'Storage_class_specifier_ type Type_qualifier = Tree 'Type_qualifier_ type Struct_or_union_spec = Tree 'Struct_or_union_spec_ type Struct_or_union = Tree 'Struct_or_union_ type Struct_dec = Tree 'Struct_dec_ type Spec_qual = Tree 'Spec_qual_ type Struct_declarator = Tree 'Struct_declarator_ type Enum_specifier = Tree 'Enum_specifier_ type Enumerator = Tree 'Enumerator_ type Declarator = Tree 'Declarator_ type Direct_declarator = Tree 'Direct_declarator_ type Pointer = Tree 'Pointer_ type Parameter_type = Tree 'Parameter_type_ type Parameter_declarations = Tree 'Parameter_declarations_ type Parameter_declaration = Tree 'Parameter_declaration_ type Initializer = Tree 'Initializer_ type Initializers = Tree 'Initializers_ type Type_name = Tree 'Type_name_ type Abstract_declarator = Tree 'Abstract_declarator_ type Dir_abs_dec = Tree 'Dir_abs_dec_ type Stm = Tree 'Stm_ type Labeled_stm = Tree 'Labeled_stm_ type Compound_stm = Tree 'Compound_stm_ type Expression_stm = Tree 'Expression_stm_ type Selection_stm = Tree 'Selection_stm_ type Iter_stm = Tree 'Iter_stm_ type Jump_stm = Tree 'Jump_stm_ type Exp = Tree 'Exp_ type Constant = Tree 'Constant_ type Constant_expression = Tree 'Constant_expression_ type Unary_operator = Tree 'Unary_operator_ type Assignment_op = Tree 'Assignment_op_ 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 CDouble = Tree 'CDouble_ type CFloat = Tree 'CFloat_ type CLongDouble = Tree 'CLongDouble_ data Tree (a :: Tag) where Progr :: [External_declaration] -> Tree 'Program_ Afunc :: Function_def -> Tree 'External_declaration_ Global :: Dec -> Tree 'External_declaration_ NewFunc :: [Declaration_specifier] -> Declarator -> Compound_stm -> Tree 'Function_def_ NewFuncInt :: Declarator -> Compound_stm -> Tree 'Function_def_ OldFunc :: [Declaration_specifier] -> Declarator -> [Dec] -> Compound_stm -> Tree 'Function_def_ OldFuncInt :: Declarator -> [Dec] -> Compound_stm -> Tree 'Function_def_ Declarators :: [Declaration_specifier] -> [Init_declarator] -> Tree 'Dec_ NoDeclarator :: [Declaration_specifier] -> Tree 'Dec_ SpecProp :: Type_qualifier -> Tree 'Declaration_specifier_ Storage :: Storage_class_specifier -> Tree 'Declaration_specifier_ Type :: Type_specifier -> Tree 'Declaration_specifier_ InitDecl :: Declarator -> Initializer -> Tree 'Init_declarator_ OnlyDecl :: Declarator -> Tree 'Init_declarator_ Tchar :: Tree 'Type_specifier_ Tdouble :: Tree 'Type_specifier_ Tenum :: Enum_specifier -> Tree 'Type_specifier_ Tfloat :: Tree 'Type_specifier_ Tint :: Tree 'Type_specifier_ Tlong :: Tree 'Type_specifier_ Tname :: Tree 'Type_specifier_ Tshort :: Tree 'Type_specifier_ Tsigned :: Tree 'Type_specifier_ Tstruct :: Struct_or_union_spec -> Tree 'Type_specifier_ Tunsigned :: Tree 'Type_specifier_ Tvoid :: Tree 'Type_specifier_ GlobalPrograms :: Tree 'Storage_class_specifier_ LocalBlock :: Tree 'Storage_class_specifier_ LocalProgram :: Tree 'Storage_class_specifier_ LocalReg :: Tree 'Storage_class_specifier_ MyType :: Tree 'Storage_class_specifier_ Const :: Tree 'Type_qualifier_ NoOptim :: Tree 'Type_qualifier_ Tag :: Struct_or_union -> Ident -> [Struct_dec] -> Tree 'Struct_or_union_spec_ TagType :: Struct_or_union -> Ident -> Tree 'Struct_or_union_spec_ Unique :: Struct_or_union -> [Struct_dec] -> Tree 'Struct_or_union_spec_ Struct :: Tree 'Struct_or_union_ Union :: Tree 'Struct_or_union_ Structen :: [Spec_qual] -> [Struct_declarator] -> Tree 'Struct_dec_ QualSpec :: Type_qualifier -> Tree 'Spec_qual_ TypeSpec :: Type_specifier -> Tree 'Spec_qual_ DecField :: Declarator -> Constant_expression -> Tree 'Struct_declarator_ Decl :: Declarator -> Tree 'Struct_declarator_ Field :: Constant_expression -> Tree 'Struct_declarator_ EnumDec :: [Enumerator] -> Tree 'Enum_specifier_ EnumName :: Ident -> [Enumerator] -> Tree 'Enum_specifier_ EnumVar :: Ident -> Tree 'Enum_specifier_ EnumInit :: Ident -> Constant_expression -> Tree 'Enumerator_ Plain :: Ident -> Tree 'Enumerator_ BeginPointer :: Pointer -> Direct_declarator -> Tree 'Declarator_ NoPointer :: Direct_declarator -> Tree 'Declarator_ Incomplete :: Direct_declarator -> Tree 'Direct_declarator_ InnitArray :: Direct_declarator -> Constant_expression -> Tree 'Direct_declarator_ Name :: Ident -> Tree 'Direct_declarator_ NewFuncDec :: Direct_declarator -> Parameter_type -> Tree 'Direct_declarator_ OldFuncDec :: Direct_declarator -> Tree 'Direct_declarator_ OldFuncDef :: Direct_declarator -> [Ident] -> Tree 'Direct_declarator_ ParenDecl :: Declarator -> Tree 'Direct_declarator_ Point :: Tree 'Pointer_ PointPoint :: Pointer -> Tree 'Pointer_ PointQual :: [Type_qualifier] -> Tree 'Pointer_ PointQualPoint :: [Type_qualifier] -> Pointer -> Tree 'Pointer_ AllSpec :: Parameter_declarations -> Tree 'Parameter_type_ More :: Parameter_declarations -> Tree 'Parameter_type_ MoreParamDec :: Parameter_declarations -> Parameter_declaration -> Tree 'Parameter_declarations_ ParamDec :: Parameter_declaration -> Tree 'Parameter_declarations_ Abstract :: [Declaration_specifier] -> Abstract_declarator -> Tree 'Parameter_declaration_ OnlyType :: [Declaration_specifier] -> Tree 'Parameter_declaration_ TypeAndParam :: [Declaration_specifier] -> Declarator -> Tree 'Parameter_declaration_ InitExpr :: Exp -> Tree 'Initializer_ InitListOne :: Initializers -> Tree 'Initializer_ InitListTwo :: Initializers -> Tree 'Initializer_ AnInit :: Initializer -> Tree 'Initializers_ MoreInit :: Initializers -> Initializer -> Tree 'Initializers_ ExtendedType :: [Spec_qual] -> Abstract_declarator -> Tree 'Type_name_ PlainType :: [Spec_qual] -> Tree 'Type_name_ Advanced :: Dir_abs_dec -> Tree 'Abstract_declarator_ PointAdvanced :: Pointer -> Dir_abs_dec -> Tree 'Abstract_declarator_ PointerStart :: Pointer -> Tree 'Abstract_declarator_ Array :: Tree 'Dir_abs_dec_ Initiated :: Dir_abs_dec -> Constant_expression -> Tree 'Dir_abs_dec_ InitiatedArray :: Constant_expression -> Tree 'Dir_abs_dec_ NewFuncExpr :: Dir_abs_dec -> Parameter_type -> Tree 'Dir_abs_dec_ NewFunction :: Parameter_type -> Tree 'Dir_abs_dec_ OldFuncExpr :: Dir_abs_dec -> Tree 'Dir_abs_dec_ OldFunction :: Tree 'Dir_abs_dec_ UnInitiated :: Dir_abs_dec -> Tree 'Dir_abs_dec_ WithinParentes :: Abstract_declarator -> Tree 'Dir_abs_dec_ CompS :: Compound_stm -> Tree 'Stm_ ExprS :: Expression_stm -> Tree 'Stm_ IterS :: Iter_stm -> Tree 'Stm_ JumpS :: Jump_stm -> Tree 'Stm_ LabelS :: Labeled_stm -> Tree 'Stm_ SelS :: Selection_stm -> Tree 'Stm_ SlabelOne :: Ident -> Stm -> Tree 'Labeled_stm_ SlabelThree :: Stm -> Tree 'Labeled_stm_ SlabelTwo :: Constant_expression -> Stm -> Tree 'Labeled_stm_ ScompFour :: [Dec] -> [Stm] -> Tree 'Compound_stm_ ScompOne :: Tree 'Compound_stm_ ScompThree :: [Dec] -> Tree 'Compound_stm_ ScompTwo :: [Stm] -> Tree 'Compound_stm_ SexprOne :: Tree 'Expression_stm_ SexprTwo :: Exp -> Tree 'Expression_stm_ SselOne :: Exp -> Stm -> Tree 'Selection_stm_ SselThree :: Exp -> Stm -> Tree 'Selection_stm_ SselTwo :: Exp -> Stm -> Stm -> Tree 'Selection_stm_ SiterFour :: Expression_stm -> Expression_stm -> Exp -> Stm -> Tree 'Iter_stm_ SiterOne :: Exp -> Stm -> Tree 'Iter_stm_ SiterThree :: Expression_stm -> Expression_stm -> Stm -> Tree 'Iter_stm_ SiterTwo :: Stm -> Exp -> Tree 'Iter_stm_ SjumpFive :: Exp -> Tree 'Jump_stm_ SjumpFour :: Tree 'Jump_stm_ SjumpOne :: Ident -> Tree 'Jump_stm_ SjumpThree :: Tree 'Jump_stm_ SjumpTwo :: Tree 'Jump_stm_ Earray :: Exp -> Exp -> Tree 'Exp_ Eassign :: Exp -> Assignment_op -> Exp -> Tree 'Exp_ Ebitand :: Exp -> Exp -> Tree 'Exp_ Ebitexor :: Exp -> Exp -> Tree 'Exp_ Ebitor :: Exp -> Exp -> Tree 'Exp_ Ebytesexpr :: Exp -> Tree 'Exp_ Ebytestype :: Type_name -> Tree 'Exp_ Ecomma :: Exp -> Exp -> Tree 'Exp_ Econdition :: Exp -> Exp -> Exp -> Tree 'Exp_ Econst :: Constant -> Tree 'Exp_ Ediv :: Exp -> Exp -> Tree 'Exp_ Eeq :: Exp -> Exp -> Tree 'Exp_ Efunk :: Exp -> Tree 'Exp_ Efunkpar :: Exp -> [Exp] -> 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_ Eneq :: Exp -> Exp -> Tree 'Exp_ Eplus :: Exp -> Exp -> Tree 'Exp_ Epoint :: Exp -> Ident -> 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_ Eselect :: Exp -> Ident -> Tree 'Exp_ Estring :: P.String -> Tree 'Exp_ Etimes :: Exp -> Exp -> Tree 'Exp_ Etypeconv :: Type_name -> Exp -> Tree 'Exp_ Evar :: Ident -> Tree 'Exp_ Ecdouble :: CDouble -> Tree 'Constant_ Ecfloat :: CFloat -> Tree 'Constant_ Echar :: P.Char -> Tree 'Constant_ Eclongdouble :: CLongDouble -> Tree 'Constant_ Edouble :: P.Double -> 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_ Eunsigned :: Unsigned -> Tree 'Constant_ Eunsignlong :: UnsignedLong -> Tree 'Constant_ Especial :: Exp -> Tree 'Constant_expression_ Address :: Tree 'Unary_operator_ Complement :: Tree 'Unary_operator_ Indirection :: 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_ AssignXor :: Tree 'Assignment_op_ 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_ CDouble ::P.String -> Tree 'CDouble_ CFloat ::P.String -> Tree 'CFloat_ CLongDouble ::P.String -> Tree 'CLongDouble_ instance Compos Tree where compos r a f = \case Progr external_declarations -> r Progr `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) external_declarations Afunc function_def -> r Afunc `a` f function_def Global dec -> r Global `a` f dec NewFunc declaration_specifiers declarator compound_stm -> r NewFunc `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) declaration_specifiers `a` f declarator `a` f compound_stm NewFuncInt declarator compound_stm -> r NewFuncInt `a` f declarator `a` f compound_stm OldFunc declaration_specifiers declarator decs compound_stm -> r OldFunc `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) declaration_specifiers `a` f declarator `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) decs `a` f compound_stm OldFuncInt declarator decs compound_stm -> r OldFuncInt `a` f declarator `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) decs `a` f compound_stm Declarators declaration_specifiers init_declarators -> r Declarators `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) declaration_specifiers `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) init_declarators NoDeclarator declaration_specifiers -> r NoDeclarator `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) declaration_specifiers SpecProp type_qualifier -> r SpecProp `a` f type_qualifier Storage storage_class_specifier -> r Storage `a` f storage_class_specifier Type type_specifier -> r Type `a` f type_specifier InitDecl declarator initializer -> r InitDecl `a` f declarator `a` f initializer OnlyDecl declarator -> r OnlyDecl `a` f declarator Tenum enum_specifier -> r Tenum `a` f enum_specifier Tstruct struct_or_union_spec -> r Tstruct `a` f struct_or_union_spec Tag struct_or_union x struct_decs -> r Tag `a` f struct_or_union `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) struct_decs TagType struct_or_union x -> r TagType `a` f struct_or_union `a` f x Unique struct_or_union struct_decs -> r Unique `a` f struct_or_union `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) struct_decs Structen spec_quals struct_declarators -> r Structen `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) spec_quals `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) struct_declarators QualSpec type_qualifier -> r QualSpec `a` f type_qualifier TypeSpec type_specifier -> r TypeSpec `a` f type_specifier DecField declarator constant_expression -> r DecField `a` f declarator `a` f constant_expression Decl declarator -> r Decl `a` f declarator Field constant_expression -> r Field `a` f constant_expression EnumDec enumerators -> r EnumDec `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) enumerators EnumName x enumerators -> r EnumName `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) enumerators EnumVar x -> r EnumVar `a` f x EnumInit x constant_expression -> r EnumInit `a` f x `a` f constant_expression Plain x -> r Plain `a` f x BeginPointer pointer direct_declarator -> r BeginPointer `a` f pointer `a` f direct_declarator NoPointer direct_declarator -> r NoPointer `a` f direct_declarator Incomplete direct_declarator -> r Incomplete `a` f direct_declarator InnitArray direct_declarator constant_expression -> r InnitArray `a` f direct_declarator `a` f constant_expression Name x -> r Name `a` f x NewFuncDec direct_declarator parameter_type -> r NewFuncDec `a` f direct_declarator `a` f parameter_type OldFuncDec direct_declarator -> r OldFuncDec `a` f direct_declarator OldFuncDef direct_declarator idents -> r OldFuncDef `a` f direct_declarator `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents ParenDecl declarator -> r ParenDecl `a` f declarator PointPoint pointer -> r PointPoint `a` f pointer PointQual type_qualifiers -> r PointQual `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) type_qualifiers PointQualPoint type_qualifiers pointer -> r PointQualPoint `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) type_qualifiers `a` f pointer AllSpec parameter_declarations -> r AllSpec `a` f parameter_declarations More parameter_declarations -> r More `a` f parameter_declarations MoreParamDec parameter_declarations parameter_declaration -> r MoreParamDec `a` f parameter_declarations `a` f parameter_declaration ParamDec parameter_declaration -> r ParamDec `a` f parameter_declaration Abstract declaration_specifiers abstract_declarator -> r Abstract `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) declaration_specifiers `a` f abstract_declarator OnlyType declaration_specifiers -> r OnlyType `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) declaration_specifiers TypeAndParam declaration_specifiers declarator -> r TypeAndParam `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) declaration_specifiers `a` f declarator InitExpr exp -> r InitExpr `a` f exp InitListOne initializers -> r InitListOne `a` f initializers InitListTwo initializers -> r InitListTwo `a` f initializers AnInit initializer -> r AnInit `a` f initializer MoreInit initializers initializer -> r MoreInit `a` f initializers `a` f initializer ExtendedType spec_quals abstract_declarator -> r ExtendedType `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) spec_quals `a` f abstract_declarator PlainType spec_quals -> r PlainType `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) spec_quals Advanced dir_abs_dec -> r Advanced `a` f dir_abs_dec PointAdvanced pointer dir_abs_dec -> r PointAdvanced `a` f pointer `a` f dir_abs_dec PointerStart pointer -> r PointerStart `a` f pointer Initiated dir_abs_dec constant_expression -> r Initiated `a` f dir_abs_dec `a` f constant_expression InitiatedArray constant_expression -> r InitiatedArray `a` f constant_expression NewFuncExpr dir_abs_dec parameter_type -> r NewFuncExpr `a` f dir_abs_dec `a` f parameter_type NewFunction parameter_type -> r NewFunction `a` f parameter_type OldFuncExpr dir_abs_dec -> r OldFuncExpr `a` f dir_abs_dec UnInitiated dir_abs_dec -> r UnInitiated `a` f dir_abs_dec WithinParentes abstract_declarator -> r WithinParentes `a` f abstract_declarator CompS compound_stm -> r CompS `a` f compound_stm ExprS expression_stm -> r ExprS `a` f expression_stm IterS iter_stm -> r IterS `a` f iter_stm JumpS jump_stm -> r JumpS `a` f jump_stm LabelS labeled_stm -> r LabelS `a` f labeled_stm SelS selection_stm -> r SelS `a` f selection_stm SlabelOne x stm -> r SlabelOne `a` f x `a` f stm SlabelThree stm -> r SlabelThree `a` f stm SlabelTwo constant_expression stm -> r SlabelTwo `a` f constant_expression `a` f stm ScompFour decs stms -> r ScompFour `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) decs `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) stms ScompThree decs -> r ScompThree `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) decs ScompTwo stms -> r ScompTwo `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) stms SexprTwo exp -> r SexprTwo `a` f exp SselOne exp stm -> r SselOne `a` f exp `a` f stm SselThree exp stm -> r SselThree `a` f exp `a` f stm SselTwo exp stm1 stm2 -> r SselTwo `a` f exp `a` f stm1 `a` f stm2 SiterFour expression_stm1 expression_stm2 exp stm -> r SiterFour `a` f expression_stm1 `a` f expression_stm2 `a` f exp `a` f stm SiterOne exp stm -> r SiterOne `a` f exp `a` f stm SiterThree expression_stm1 expression_stm2 stm -> r SiterThree `a` f expression_stm1 `a` f expression_stm2 `a` f stm SiterTwo stm exp -> r SiterTwo `a` f stm `a` f exp SjumpFive exp -> r SjumpFive `a` f exp SjumpOne x -> r SjumpOne `a` f x Earray exp1 exp2 -> r Earray `a` f exp1 `a` f exp2 Eassign exp1 assignment_op exp2 -> r Eassign `a` f exp1 `a` f assignment_op `a` f exp2 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 Ebytesexpr exp -> r Ebytesexpr `a` f exp Ebytestype type_name -> r Ebytestype `a` f type_name Ecomma exp1 exp2 -> r Ecomma `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 Efunk exp -> r Efunk `a` f exp Efunkpar exp exps -> r Efunkpar `a` f exp `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) exps 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 Eneq exp1 exp2 -> r Eneq `a` f exp1 `a` f exp2 Eplus exp1 exp2 -> r Eplus `a` f exp1 `a` f exp2 Epoint exp x -> r Epoint `a` f exp `a` f x 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 Eselect exp x -> r Eselect `a` f exp `a` f x Etimes exp1 exp2 -> r Etimes `a` f exp1 `a` f exp2 Etypeconv type_name exp -> r Etypeconv `a` f type_name `a` f exp Evar x -> r Evar `a` f x Ecdouble cDouble -> r Ecdouble `a` f cDouble Ecfloat cFloat -> r Ecfloat `a` f cFloat Eclongdouble cLongDouble -> r Eclongdouble `a` f cLongDouble 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 Eunsigned unsigned -> r Eunsigned `a` f unsigned Eunsignlong unsignedLong -> r Eunsignlong `a` f unsignedLong Especial exp -> r Especial `a` f exp 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 CDouble str -> opar . P.showString "CDouble" . P.showChar ' ' . P.showsPrec 1 str . cpar CFloat str -> opar . P.showString "CFloat" . P.showChar ' ' . P.showsPrec 1 str . cpar CLongDouble str -> opar . P.showString "CLongDouble" . P.showChar ' ' . P.showsPrec 1 str . cpar Progr external_declarations -> opar . P.showString "Progr" . P.showChar ' ' . P.showsPrec 1 external_declarations . cpar Afunc function_def -> opar . P.showString "Afunc" . P.showChar ' ' . P.showsPrec 1 function_def . cpar Global dec -> opar . P.showString "Global" . P.showChar ' ' . P.showsPrec 1 dec . cpar NewFunc declaration_specifiers declarator compound_stm -> opar . P.showString "NewFunc" . P.showChar ' ' . P.showsPrec 1 declaration_specifiers . P.showChar ' ' . P.showsPrec 1 declarator . P.showChar ' ' . P.showsPrec 1 compound_stm . cpar NewFuncInt declarator compound_stm -> opar . P.showString "NewFuncInt" . P.showChar ' ' . P.showsPrec 1 declarator . P.showChar ' ' . P.showsPrec 1 compound_stm . cpar OldFunc declaration_specifiers declarator decs compound_stm -> opar . P.showString "OldFunc" . P.showChar ' ' . P.showsPrec 1 declaration_specifiers . P.showChar ' ' . P.showsPrec 1 declarator . P.showChar ' ' . P.showsPrec 1 decs . P.showChar ' ' . P.showsPrec 1 compound_stm . cpar OldFuncInt declarator decs compound_stm -> opar . P.showString "OldFuncInt" . P.showChar ' ' . P.showsPrec 1 declarator . P.showChar ' ' . P.showsPrec 1 decs . P.showChar ' ' . P.showsPrec 1 compound_stm . cpar Declarators declaration_specifiers init_declarators -> opar . P.showString "Declarators" . P.showChar ' ' . P.showsPrec 1 declaration_specifiers . P.showChar ' ' . P.showsPrec 1 init_declarators . cpar NoDeclarator declaration_specifiers -> opar . P.showString "NoDeclarator" . P.showChar ' ' . P.showsPrec 1 declaration_specifiers . cpar SpecProp type_qualifier -> opar . P.showString "SpecProp" . P.showChar ' ' . P.showsPrec 1 type_qualifier . cpar Storage storage_class_specifier -> opar . P.showString "Storage" . P.showChar ' ' . P.showsPrec 1 storage_class_specifier . cpar Type type_specifier -> opar . P.showString "Type" . P.showChar ' ' . P.showsPrec 1 type_specifier . cpar InitDecl declarator initializer -> opar . P.showString "InitDecl" . P.showChar ' ' . P.showsPrec 1 declarator . P.showChar ' ' . P.showsPrec 1 initializer . cpar OnlyDecl declarator -> opar . P.showString "OnlyDecl" . P.showChar ' ' . P.showsPrec 1 declarator . cpar Tchar -> P.showString "Tchar" Tdouble -> P.showString "Tdouble" Tenum enum_specifier -> opar . P.showString "Tenum" . P.showChar ' ' . P.showsPrec 1 enum_specifier . cpar Tfloat -> P.showString "Tfloat" Tint -> P.showString "Tint" Tlong -> P.showString "Tlong" Tname -> P.showString "Tname" Tshort -> P.showString "Tshort" Tsigned -> P.showString "Tsigned" Tstruct struct_or_union_spec -> opar . P.showString "Tstruct" . P.showChar ' ' . P.showsPrec 1 struct_or_union_spec . cpar Tunsigned -> P.showString "Tunsigned" Tvoid -> P.showString "Tvoid" GlobalPrograms -> P.showString "GlobalPrograms" LocalBlock -> P.showString "LocalBlock" LocalProgram -> P.showString "LocalProgram" LocalReg -> P.showString "LocalReg" MyType -> P.showString "MyType" Const -> P.showString "Const" NoOptim -> P.showString "NoOptim" Tag struct_or_union x struct_decs -> opar . P.showString "Tag" . P.showChar ' ' . P.showsPrec 1 struct_or_union . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 struct_decs . cpar TagType struct_or_union x -> opar . P.showString "TagType" . P.showChar ' ' . P.showsPrec 1 struct_or_union . P.showChar ' ' . P.showsPrec 1 x . cpar Unique struct_or_union struct_decs -> opar . P.showString "Unique" . P.showChar ' ' . P.showsPrec 1 struct_or_union . P.showChar ' ' . P.showsPrec 1 struct_decs . cpar Struct -> P.showString "Struct" Union -> P.showString "Union" Structen spec_quals struct_declarators -> opar . P.showString "Structen" . P.showChar ' ' . P.showsPrec 1 spec_quals . P.showChar ' ' . P.showsPrec 1 struct_declarators . cpar QualSpec type_qualifier -> opar . P.showString "QualSpec" . P.showChar ' ' . P.showsPrec 1 type_qualifier . cpar TypeSpec type_specifier -> opar . P.showString "TypeSpec" . P.showChar ' ' . P.showsPrec 1 type_specifier . cpar DecField declarator constant_expression -> opar . P.showString "DecField" . P.showChar ' ' . P.showsPrec 1 declarator . P.showChar ' ' . P.showsPrec 1 constant_expression . cpar Decl declarator -> opar . P.showString "Decl" . P.showChar ' ' . P.showsPrec 1 declarator . cpar Field constant_expression -> opar . P.showString "Field" . P.showChar ' ' . P.showsPrec 1 constant_expression . cpar EnumDec enumerators -> opar . P.showString "EnumDec" . P.showChar ' ' . P.showsPrec 1 enumerators . cpar EnumName x enumerators -> opar . P.showString "EnumName" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 enumerators . cpar EnumVar x -> opar . P.showString "EnumVar" . P.showChar ' ' . P.showsPrec 1 x . cpar EnumInit x constant_expression -> opar . P.showString "EnumInit" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 constant_expression . cpar Plain x -> opar . P.showString "Plain" . P.showChar ' ' . P.showsPrec 1 x . cpar BeginPointer pointer direct_declarator -> opar . P.showString "BeginPointer" . P.showChar ' ' . P.showsPrec 1 pointer . P.showChar ' ' . P.showsPrec 1 direct_declarator . cpar NoPointer direct_declarator -> opar . P.showString "NoPointer" . P.showChar ' ' . P.showsPrec 1 direct_declarator . cpar Incomplete direct_declarator -> opar . P.showString "Incomplete" . P.showChar ' ' . P.showsPrec 1 direct_declarator . cpar InnitArray direct_declarator constant_expression -> opar . P.showString "InnitArray" . P.showChar ' ' . P.showsPrec 1 direct_declarator . P.showChar ' ' . P.showsPrec 1 constant_expression . cpar Name x -> opar . P.showString "Name" . P.showChar ' ' . P.showsPrec 1 x . cpar NewFuncDec direct_declarator parameter_type -> opar . P.showString "NewFuncDec" . P.showChar ' ' . P.showsPrec 1 direct_declarator . P.showChar ' ' . P.showsPrec 1 parameter_type . cpar OldFuncDec direct_declarator -> opar . P.showString "OldFuncDec" . P.showChar ' ' . P.showsPrec 1 direct_declarator . cpar OldFuncDef direct_declarator idents -> opar . P.showString "OldFuncDef" . P.showChar ' ' . P.showsPrec 1 direct_declarator . P.showChar ' ' . P.showsPrec 1 idents . cpar ParenDecl declarator -> opar . P.showString "ParenDecl" . P.showChar ' ' . P.showsPrec 1 declarator . cpar Point -> P.showString "Point" PointPoint pointer -> opar . P.showString "PointPoint" . P.showChar ' ' . P.showsPrec 1 pointer . cpar PointQual type_qualifiers -> opar . P.showString "PointQual" . P.showChar ' ' . P.showsPrec 1 type_qualifiers . cpar PointQualPoint type_qualifiers pointer -> opar . P.showString "PointQualPoint" . P.showChar ' ' . P.showsPrec 1 type_qualifiers . P.showChar ' ' . P.showsPrec 1 pointer . cpar AllSpec parameter_declarations -> opar . P.showString "AllSpec" . P.showChar ' ' . P.showsPrec 1 parameter_declarations . cpar More parameter_declarations -> opar . P.showString "More" . P.showChar ' ' . P.showsPrec 1 parameter_declarations . cpar MoreParamDec parameter_declarations parameter_declaration -> opar . P.showString "MoreParamDec" . P.showChar ' ' . P.showsPrec 1 parameter_declarations . P.showChar ' ' . P.showsPrec 1 parameter_declaration . cpar ParamDec parameter_declaration -> opar . P.showString "ParamDec" . P.showChar ' ' . P.showsPrec 1 parameter_declaration . cpar Abstract declaration_specifiers abstract_declarator -> opar . P.showString "Abstract" . P.showChar ' ' . P.showsPrec 1 declaration_specifiers . P.showChar ' ' . P.showsPrec 1 abstract_declarator . cpar OnlyType declaration_specifiers -> opar . P.showString "OnlyType" . P.showChar ' ' . P.showsPrec 1 declaration_specifiers . cpar TypeAndParam declaration_specifiers declarator -> opar . P.showString "TypeAndParam" . P.showChar ' ' . P.showsPrec 1 declaration_specifiers . P.showChar ' ' . P.showsPrec 1 declarator . cpar InitExpr exp -> opar . P.showString "InitExpr" . P.showChar ' ' . P.showsPrec 1 exp . cpar InitListOne initializers -> opar . P.showString "InitListOne" . P.showChar ' ' . P.showsPrec 1 initializers . cpar InitListTwo initializers -> opar . P.showString "InitListTwo" . P.showChar ' ' . P.showsPrec 1 initializers . cpar AnInit initializer -> opar . P.showString "AnInit" . P.showChar ' ' . P.showsPrec 1 initializer . cpar MoreInit initializers initializer -> opar . P.showString "MoreInit" . P.showChar ' ' . P.showsPrec 1 initializers . P.showChar ' ' . P.showsPrec 1 initializer . cpar ExtendedType spec_quals abstract_declarator -> opar . P.showString "ExtendedType" . P.showChar ' ' . P.showsPrec 1 spec_quals . P.showChar ' ' . P.showsPrec 1 abstract_declarator . cpar PlainType spec_quals -> opar . P.showString "PlainType" . P.showChar ' ' . P.showsPrec 1 spec_quals . cpar Advanced dir_abs_dec -> opar . P.showString "Advanced" . P.showChar ' ' . P.showsPrec 1 dir_abs_dec . cpar PointAdvanced pointer dir_abs_dec -> opar . P.showString "PointAdvanced" . P.showChar ' ' . P.showsPrec 1 pointer . P.showChar ' ' . P.showsPrec 1 dir_abs_dec . cpar PointerStart pointer -> opar . P.showString "PointerStart" . P.showChar ' ' . P.showsPrec 1 pointer . cpar Array -> P.showString "Array" Initiated dir_abs_dec constant_expression -> opar . P.showString "Initiated" . P.showChar ' ' . P.showsPrec 1 dir_abs_dec . P.showChar ' ' . P.showsPrec 1 constant_expression . cpar InitiatedArray constant_expression -> opar . P.showString "InitiatedArray" . P.showChar ' ' . P.showsPrec 1 constant_expression . cpar NewFuncExpr dir_abs_dec parameter_type -> opar . P.showString "NewFuncExpr" . P.showChar ' ' . P.showsPrec 1 dir_abs_dec . P.showChar ' ' . P.showsPrec 1 parameter_type . cpar NewFunction parameter_type -> opar . P.showString "NewFunction" . P.showChar ' ' . P.showsPrec 1 parameter_type . cpar OldFuncExpr dir_abs_dec -> opar . P.showString "OldFuncExpr" . P.showChar ' ' . P.showsPrec 1 dir_abs_dec . cpar OldFunction -> P.showString "OldFunction" UnInitiated dir_abs_dec -> opar . P.showString "UnInitiated" . P.showChar ' ' . P.showsPrec 1 dir_abs_dec . cpar WithinParentes abstract_declarator -> opar . P.showString "WithinParentes" . P.showChar ' ' . P.showsPrec 1 abstract_declarator . cpar CompS compound_stm -> opar . P.showString "CompS" . P.showChar ' ' . P.showsPrec 1 compound_stm . cpar ExprS expression_stm -> opar . P.showString "ExprS" . P.showChar ' ' . P.showsPrec 1 expression_stm . cpar IterS iter_stm -> opar . P.showString "IterS" . P.showChar ' ' . P.showsPrec 1 iter_stm . cpar JumpS jump_stm -> opar . P.showString "JumpS" . P.showChar ' ' . P.showsPrec 1 jump_stm . cpar LabelS labeled_stm -> opar . P.showString "LabelS" . P.showChar ' ' . P.showsPrec 1 labeled_stm . cpar SelS selection_stm -> opar . P.showString "SelS" . P.showChar ' ' . P.showsPrec 1 selection_stm . cpar SlabelOne x stm -> opar . P.showString "SlabelOne" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 stm . cpar SlabelThree stm -> opar . P.showString "SlabelThree" . P.showChar ' ' . P.showsPrec 1 stm . cpar SlabelTwo constant_expression stm -> opar . P.showString "SlabelTwo" . P.showChar ' ' . P.showsPrec 1 constant_expression . P.showChar ' ' . P.showsPrec 1 stm . cpar ScompFour decs stms -> opar . P.showString "ScompFour" . P.showChar ' ' . P.showsPrec 1 decs . P.showChar ' ' . P.showsPrec 1 stms . cpar ScompOne -> P.showString "ScompOne" ScompThree decs -> opar . P.showString "ScompThree" . P.showChar ' ' . P.showsPrec 1 decs . cpar ScompTwo stms -> opar . P.showString "ScompTwo" . P.showChar ' ' . P.showsPrec 1 stms . cpar SexprOne -> P.showString "SexprOne" SexprTwo exp -> opar . P.showString "SexprTwo" . P.showChar ' ' . P.showsPrec 1 exp . cpar SselOne exp stm -> opar . P.showString "SselOne" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm . cpar SselThree exp stm -> opar . P.showString "SselThree" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm . cpar SselTwo exp stm1 stm2 -> opar . P.showString "SselTwo" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm1 . P.showChar ' ' . P.showsPrec 1 stm2 . cpar SiterFour expression_stm1 expression_stm2 exp stm -> opar . P.showString "SiterFour" . P.showChar ' ' . P.showsPrec 1 expression_stm1 . P.showChar ' ' . P.showsPrec 1 expression_stm2 . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm . cpar SiterOne exp stm -> opar . P.showString "SiterOne" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm . cpar SiterThree expression_stm1 expression_stm2 stm -> opar . P.showString "SiterThree" . P.showChar ' ' . P.showsPrec 1 expression_stm1 . P.showChar ' ' . P.showsPrec 1 expression_stm2 . P.showChar ' ' . P.showsPrec 1 stm . cpar SiterTwo stm exp -> opar . P.showString "SiterTwo" . P.showChar ' ' . P.showsPrec 1 stm . P.showChar ' ' . P.showsPrec 1 exp . cpar SjumpFive exp -> opar . P.showString "SjumpFive" . P.showChar ' ' . P.showsPrec 1 exp . cpar SjumpFour -> P.showString "SjumpFour" SjumpOne x -> opar . P.showString "SjumpOne" . P.showChar ' ' . P.showsPrec 1 x . cpar SjumpThree -> P.showString "SjumpThree" SjumpTwo -> P.showString "SjumpTwo" Earray exp1 exp2 -> opar . P.showString "Earray" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . 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 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 Ebytesexpr exp -> opar . P.showString "Ebytesexpr" . P.showChar ' ' . P.showsPrec 1 exp . cpar Ebytestype type_name -> opar . P.showString "Ebytestype" . P.showChar ' ' . P.showsPrec 1 type_name . cpar Ecomma exp1 exp2 -> opar . P.showString "Ecomma" . 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 Efunk exp -> opar . P.showString "Efunk" . P.showChar ' ' . P.showsPrec 1 exp . cpar Efunkpar exp exps -> opar . P.showString "Efunkpar" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 exps . 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 Eneq exp1 exp2 -> opar . P.showString "Eneq" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Eplus exp1 exp2 -> opar . P.showString "Eplus" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar Epoint exp x -> opar . P.showString "Epoint" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 x . 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 Eselect exp x -> opar . P.showString "Eselect" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 x . 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 Etypeconv type_name exp -> opar . P.showString "Etypeconv" . P.showChar ' ' . P.showsPrec 1 type_name . P.showChar ' ' . P.showsPrec 1 exp . cpar Evar x -> opar . P.showString "Evar" . P.showChar ' ' . P.showsPrec 1 x . cpar Ecdouble cDouble -> opar . P.showString "Ecdouble" . P.showChar ' ' . P.showsPrec 1 cDouble . cpar Ecfloat cFloat -> opar . P.showString "Ecfloat" . P.showChar ' ' . P.showsPrec 1 cFloat . cpar Echar c -> opar . P.showString "Echar" . P.showChar ' ' . P.showsPrec 1 c . cpar Eclongdouble cLongDouble -> opar . P.showString "Eclongdouble" . P.showChar ' ' . P.showsPrec 1 cLongDouble . cpar Edouble d -> opar . P.showString "Edouble" . P.showChar ' ' . P.showsPrec 1 d . cpar 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 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 Especial exp -> opar . P.showString "Especial" . P.showChar ' ' . P.showsPrec 1 exp . cpar Address -> P.showString "Address" Complement -> P.showString "Complement" Indirection -> P.showString "Indirection" 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" AssignXor -> P.showString "AssignXor" 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 (Progr _) = 1 index (Afunc _) = 2 index (Global _) = 3 index (NewFunc _ _ _) = 4 index (NewFuncInt _ _) = 5 index (OldFunc _ _ _ _) = 6 index (OldFuncInt _ _ _) = 7 index (Declarators _ _) = 8 index (NoDeclarator _) = 9 index (SpecProp _) = 10 index (Storage _) = 11 index (Type _) = 12 index (InitDecl _ _) = 13 index (OnlyDecl _) = 14 index (Tchar ) = 15 index (Tdouble ) = 16 index (Tenum _) = 17 index (Tfloat ) = 18 index (Tint ) = 19 index (Tlong ) = 20 index (Tname ) = 21 index (Tshort ) = 22 index (Tsigned ) = 23 index (Tstruct _) = 24 index (Tunsigned ) = 25 index (Tvoid ) = 26 index (GlobalPrograms ) = 27 index (LocalBlock ) = 28 index (LocalProgram ) = 29 index (LocalReg ) = 30 index (MyType ) = 31 index (Const ) = 32 index (NoOptim ) = 33 index (Tag _ _ _) = 34 index (TagType _ _) = 35 index (Unique _ _) = 36 index (Struct ) = 37 index (Union ) = 38 index (Structen _ _) = 39 index (QualSpec _) = 40 index (TypeSpec _) = 41 index (DecField _ _) = 42 index (Decl _) = 43 index (Field _) = 44 index (EnumDec _) = 45 index (EnumName _ _) = 46 index (EnumVar _) = 47 index (EnumInit _ _) = 48 index (Plain _) = 49 index (BeginPointer _ _) = 50 index (NoPointer _) = 51 index (Incomplete _) = 52 index (InnitArray _ _) = 53 index (Name _) = 54 index (NewFuncDec _ _) = 55 index (OldFuncDec _) = 56 index (OldFuncDef _ _) = 57 index (ParenDecl _) = 58 index (Point ) = 59 index (PointPoint _) = 60 index (PointQual _) = 61 index (PointQualPoint _ _) = 62 index (AllSpec _) = 63 index (More _) = 64 index (MoreParamDec _ _) = 65 index (ParamDec _) = 66 index (Abstract _ _) = 67 index (OnlyType _) = 68 index (TypeAndParam _ _) = 69 index (InitExpr _) = 70 index (InitListOne _) = 71 index (InitListTwo _) = 72 index (AnInit _) = 73 index (MoreInit _ _) = 74 index (ExtendedType _ _) = 75 index (PlainType _) = 76 index (Advanced _) = 77 index (PointAdvanced _ _) = 78 index (PointerStart _) = 79 index (Array ) = 80 index (Initiated _ _) = 81 index (InitiatedArray _) = 82 index (NewFuncExpr _ _) = 83 index (NewFunction _) = 84 index (OldFuncExpr _) = 85 index (OldFunction ) = 86 index (UnInitiated _) = 87 index (WithinParentes _) = 88 index (CompS _) = 89 index (ExprS _) = 90 index (IterS _) = 91 index (JumpS _) = 92 index (LabelS _) = 93 index (SelS _) = 94 index (SlabelOne _ _) = 95 index (SlabelThree _) = 96 index (SlabelTwo _ _) = 97 index (ScompFour _ _) = 98 index (ScompOne ) = 99 index (ScompThree _) = 100 index (ScompTwo _) = 101 index (SexprOne ) = 102 index (SexprTwo _) = 103 index (SselOne _ _) = 104 index (SselThree _ _) = 105 index (SselTwo _ _ _) = 106 index (SiterFour _ _ _ _) = 107 index (SiterOne _ _) = 108 index (SiterThree _ _ _) = 109 index (SiterTwo _ _) = 110 index (SjumpFive _) = 111 index (SjumpFour ) = 112 index (SjumpOne _) = 113 index (SjumpThree ) = 114 index (SjumpTwo ) = 115 index (Earray _ _) = 116 index (Eassign _ _ _) = 117 index (Ebitand _ _) = 118 index (Ebitexor _ _) = 119 index (Ebitor _ _) = 120 index (Ebytesexpr _) = 121 index (Ebytestype _) = 122 index (Ecomma _ _) = 123 index (Econdition _ _ _) = 124 index (Econst _) = 125 index (Ediv _ _) = 126 index (Eeq _ _) = 127 index (Efunk _) = 128 index (Efunkpar _ _) = 129 index (Ege _ _) = 130 index (Egrthen _ _) = 131 index (Eland _ _) = 132 index (Ele _ _) = 133 index (Eleft _ _) = 134 index (Elor _ _) = 135 index (Elthen _ _) = 136 index (Eminus _ _) = 137 index (Emod _ _) = 138 index (Eneq _ _) = 139 index (Eplus _ _) = 140 index (Epoint _ _) = 141 index (Epostdec _) = 142 index (Epostinc _) = 143 index (Epredec _) = 144 index (Epreinc _) = 145 index (Epreop _ _) = 146 index (Eright _ _) = 147 index (Eselect _ _) = 148 index (Estring _) = 149 index (Etimes _ _) = 150 index (Etypeconv _ _) = 151 index (Evar _) = 152 index (Ecdouble _) = 153 index (Ecfloat _) = 154 index (Echar _) = 155 index (Eclongdouble _) = 156 index (Edouble _) = 157 index (Efloat _) = 158 index (Ehexadec _) = 159 index (Ehexalong _) = 160 index (Ehexaunsign _) = 161 index (Ehexaunslong _) = 162 index (Eint _) = 163 index (Elong _) = 164 index (Elonger _) = 165 index (Eoctal _) = 166 index (Eoctallong _) = 167 index (Eoctalunsign _) = 168 index (Eoctalunslong _) = 169 index (Eunsigned _) = 170 index (Eunsignlong _) = 171 index (Especial _) = 172 index (Address ) = 173 index (Complement ) = 174 index (Indirection ) = 175 index (Logicalneg ) = 176 index (Negative ) = 177 index (Plus ) = 178 index (Assign ) = 179 index (AssignAdd ) = 180 index (AssignAnd ) = 181 index (AssignDiv ) = 182 index (AssignLeft ) = 183 index (AssignMod ) = 184 index (AssignMul ) = 185 index (AssignOr ) = 186 index (AssignRight ) = 187 index (AssignSub ) = 188 index (AssignXor ) = 189 index (Ident _) = 190 index (Unsigned _) = 191 index (Long _) = 192 index (UnsignedLong _) = 193 index (Hexadecimal _) = 194 index (HexUnsigned _) = 195 index (HexLong _) = 196 index (HexUnsLong _) = 197 index (Octal _) = 198 index (OctalUnsigned _) = 199 index (OctalLong _) = 200 index (OctalUnsLong _) = 201 index (CDouble _) = 202 index (CFloat _) = 203 index (CLongDouble _) = 204 johnMajorEq :: Tree a -> Tree b -> P.Bool johnMajorEq (Progr external_declarations) (Progr external_declarations_) = external_declarations == external_declarations_ johnMajorEq (Afunc function_def) (Afunc function_def_) = function_def == function_def_ johnMajorEq (Global dec) (Global dec_) = dec == dec_ johnMajorEq (NewFunc declaration_specifiers declarator compound_stm) (NewFunc declaration_specifiers_ declarator_ compound_stm_) = declaration_specifiers == declaration_specifiers_ && declarator == declarator_ && compound_stm == compound_stm_ johnMajorEq (NewFuncInt declarator compound_stm) (NewFuncInt declarator_ compound_stm_) = declarator == declarator_ && compound_stm == compound_stm_ johnMajorEq (OldFunc declaration_specifiers declarator decs compound_stm) (OldFunc declaration_specifiers_ declarator_ decs_ compound_stm_) = declaration_specifiers == declaration_specifiers_ && declarator == declarator_ && decs == decs_ && compound_stm == compound_stm_ johnMajorEq (OldFuncInt declarator decs compound_stm) (OldFuncInt declarator_ decs_ compound_stm_) = declarator == declarator_ && decs == decs_ && compound_stm == compound_stm_ johnMajorEq (Declarators declaration_specifiers init_declarators) (Declarators declaration_specifiers_ init_declarators_) = declaration_specifiers == declaration_specifiers_ && init_declarators == init_declarators_ johnMajorEq (NoDeclarator declaration_specifiers) (NoDeclarator declaration_specifiers_) = declaration_specifiers == declaration_specifiers_ johnMajorEq (SpecProp type_qualifier) (SpecProp type_qualifier_) = type_qualifier == type_qualifier_ johnMajorEq (Storage storage_class_specifier) (Storage storage_class_specifier_) = storage_class_specifier == storage_class_specifier_ johnMajorEq (Type type_specifier) (Type type_specifier_) = type_specifier == type_specifier_ johnMajorEq (InitDecl declarator initializer) (InitDecl declarator_ initializer_) = declarator == declarator_ && initializer == initializer_ johnMajorEq (OnlyDecl declarator) (OnlyDecl declarator_) = declarator == declarator_ johnMajorEq Tchar Tchar = P.True johnMajorEq Tdouble Tdouble = P.True johnMajorEq (Tenum enum_specifier) (Tenum enum_specifier_) = enum_specifier == enum_specifier_ johnMajorEq Tfloat Tfloat = P.True johnMajorEq Tint Tint = P.True johnMajorEq Tlong Tlong = P.True johnMajorEq Tname Tname = P.True johnMajorEq Tshort Tshort = P.True johnMajorEq Tsigned Tsigned = P.True johnMajorEq (Tstruct struct_or_union_spec) (Tstruct struct_or_union_spec_) = struct_or_union_spec == struct_or_union_spec_ johnMajorEq Tunsigned Tunsigned = P.True johnMajorEq Tvoid Tvoid = P.True johnMajorEq GlobalPrograms GlobalPrograms = P.True johnMajorEq LocalBlock LocalBlock = P.True johnMajorEq LocalProgram LocalProgram = P.True johnMajorEq LocalReg LocalReg = P.True johnMajorEq MyType MyType = P.True johnMajorEq Const Const = P.True johnMajorEq NoOptim NoOptim = P.True johnMajorEq (Tag struct_or_union x struct_decs) (Tag struct_or_union_ x_ struct_decs_) = struct_or_union == struct_or_union_ && x == x_ && struct_decs == struct_decs_ johnMajorEq (TagType struct_or_union x) (TagType struct_or_union_ x_) = struct_or_union == struct_or_union_ && x == x_ johnMajorEq (Unique struct_or_union struct_decs) (Unique struct_or_union_ struct_decs_) = struct_or_union == struct_or_union_ && struct_decs == struct_decs_ johnMajorEq Struct Struct = P.True johnMajorEq Union Union = P.True johnMajorEq (Structen spec_quals struct_declarators) (Structen spec_quals_ struct_declarators_) = spec_quals == spec_quals_ && struct_declarators == struct_declarators_ johnMajorEq (QualSpec type_qualifier) (QualSpec type_qualifier_) = type_qualifier == type_qualifier_ johnMajorEq (TypeSpec type_specifier) (TypeSpec type_specifier_) = type_specifier == type_specifier_ johnMajorEq (DecField declarator constant_expression) (DecField declarator_ constant_expression_) = declarator == declarator_ && constant_expression == constant_expression_ johnMajorEq (Decl declarator) (Decl declarator_) = declarator == declarator_ johnMajorEq (Field constant_expression) (Field constant_expression_) = constant_expression == constant_expression_ johnMajorEq (EnumDec enumerators) (EnumDec enumerators_) = enumerators == enumerators_ johnMajorEq (EnumName x enumerators) (EnumName x_ enumerators_) = x == x_ && enumerators == enumerators_ johnMajorEq (EnumVar x) (EnumVar x_) = x == x_ johnMajorEq (EnumInit x constant_expression) (EnumInit x_ constant_expression_) = x == x_ && constant_expression == constant_expression_ johnMajorEq (Plain x) (Plain x_) = x == x_ johnMajorEq (BeginPointer pointer direct_declarator) (BeginPointer pointer_ direct_declarator_) = pointer == pointer_ && direct_declarator == direct_declarator_ johnMajorEq (NoPointer direct_declarator) (NoPointer direct_declarator_) = direct_declarator == direct_declarator_ johnMajorEq (Incomplete direct_declarator) (Incomplete direct_declarator_) = direct_declarator == direct_declarator_ johnMajorEq (InnitArray direct_declarator constant_expression) (InnitArray direct_declarator_ constant_expression_) = direct_declarator == direct_declarator_ && constant_expression == constant_expression_ johnMajorEq (Name x) (Name x_) = x == x_ johnMajorEq (NewFuncDec direct_declarator parameter_type) (NewFuncDec direct_declarator_ parameter_type_) = direct_declarator == direct_declarator_ && parameter_type == parameter_type_ johnMajorEq (OldFuncDec direct_declarator) (OldFuncDec direct_declarator_) = direct_declarator == direct_declarator_ johnMajorEq (OldFuncDef direct_declarator idents) (OldFuncDef direct_declarator_ idents_) = direct_declarator == direct_declarator_ && idents == idents_ johnMajorEq (ParenDecl declarator) (ParenDecl declarator_) = declarator == declarator_ johnMajorEq Point Point = P.True johnMajorEq (PointPoint pointer) (PointPoint pointer_) = pointer == pointer_ johnMajorEq (PointQual type_qualifiers) (PointQual type_qualifiers_) = type_qualifiers == type_qualifiers_ johnMajorEq (PointQualPoint type_qualifiers pointer) (PointQualPoint type_qualifiers_ pointer_) = type_qualifiers == type_qualifiers_ && pointer == pointer_ johnMajorEq (AllSpec parameter_declarations) (AllSpec parameter_declarations_) = parameter_declarations == parameter_declarations_ johnMajorEq (More parameter_declarations) (More parameter_declarations_) = parameter_declarations == parameter_declarations_ johnMajorEq (MoreParamDec parameter_declarations parameter_declaration) (MoreParamDec parameter_declarations_ parameter_declaration_) = parameter_declarations == parameter_declarations_ && parameter_declaration == parameter_declaration_ johnMajorEq (ParamDec parameter_declaration) (ParamDec parameter_declaration_) = parameter_declaration == parameter_declaration_ johnMajorEq (Abstract declaration_specifiers abstract_declarator) (Abstract declaration_specifiers_ abstract_declarator_) = declaration_specifiers == declaration_specifiers_ && abstract_declarator == abstract_declarator_ johnMajorEq (OnlyType declaration_specifiers) (OnlyType declaration_specifiers_) = declaration_specifiers == declaration_specifiers_ johnMajorEq (TypeAndParam declaration_specifiers declarator) (TypeAndParam declaration_specifiers_ declarator_) = declaration_specifiers == declaration_specifiers_ && declarator == declarator_ johnMajorEq (InitExpr exp) (InitExpr exp_) = exp == exp_ johnMajorEq (InitListOne initializers) (InitListOne initializers_) = initializers == initializers_ johnMajorEq (InitListTwo initializers) (InitListTwo initializers_) = initializers == initializers_ johnMajorEq (AnInit initializer) (AnInit initializer_) = initializer == initializer_ johnMajorEq (MoreInit initializers initializer) (MoreInit initializers_ initializer_) = initializers == initializers_ && initializer == initializer_ johnMajorEq (ExtendedType spec_quals abstract_declarator) (ExtendedType spec_quals_ abstract_declarator_) = spec_quals == spec_quals_ && abstract_declarator == abstract_declarator_ johnMajorEq (PlainType spec_quals) (PlainType spec_quals_) = spec_quals == spec_quals_ johnMajorEq (Advanced dir_abs_dec) (Advanced dir_abs_dec_) = dir_abs_dec == dir_abs_dec_ johnMajorEq (PointAdvanced pointer dir_abs_dec) (PointAdvanced pointer_ dir_abs_dec_) = pointer == pointer_ && dir_abs_dec == dir_abs_dec_ johnMajorEq (PointerStart pointer) (PointerStart pointer_) = pointer == pointer_ johnMajorEq Array Array = P.True johnMajorEq (Initiated dir_abs_dec constant_expression) (Initiated dir_abs_dec_ constant_expression_) = dir_abs_dec == dir_abs_dec_ && constant_expression == constant_expression_ johnMajorEq (InitiatedArray constant_expression) (InitiatedArray constant_expression_) = constant_expression == constant_expression_ johnMajorEq (NewFuncExpr dir_abs_dec parameter_type) (NewFuncExpr dir_abs_dec_ parameter_type_) = dir_abs_dec == dir_abs_dec_ && parameter_type == parameter_type_ johnMajorEq (NewFunction parameter_type) (NewFunction parameter_type_) = parameter_type == parameter_type_ johnMajorEq (OldFuncExpr dir_abs_dec) (OldFuncExpr dir_abs_dec_) = dir_abs_dec == dir_abs_dec_ johnMajorEq OldFunction OldFunction = P.True johnMajorEq (UnInitiated dir_abs_dec) (UnInitiated dir_abs_dec_) = dir_abs_dec == dir_abs_dec_ johnMajorEq (WithinParentes abstract_declarator) (WithinParentes abstract_declarator_) = abstract_declarator == abstract_declarator_ johnMajorEq (CompS compound_stm) (CompS compound_stm_) = compound_stm == compound_stm_ johnMajorEq (ExprS expression_stm) (ExprS expression_stm_) = expression_stm == expression_stm_ johnMajorEq (IterS iter_stm) (IterS iter_stm_) = iter_stm == iter_stm_ johnMajorEq (JumpS jump_stm) (JumpS jump_stm_) = jump_stm == jump_stm_ johnMajorEq (LabelS labeled_stm) (LabelS labeled_stm_) = labeled_stm == labeled_stm_ johnMajorEq (SelS selection_stm) (SelS selection_stm_) = selection_stm == selection_stm_ johnMajorEq (SlabelOne x stm) (SlabelOne x_ stm_) = x == x_ && stm == stm_ johnMajorEq (SlabelThree stm) (SlabelThree stm_) = stm == stm_ johnMajorEq (SlabelTwo constant_expression stm) (SlabelTwo constant_expression_ stm_) = constant_expression == constant_expression_ && stm == stm_ johnMajorEq (ScompFour decs stms) (ScompFour decs_ stms_) = decs == decs_ && stms == stms_ johnMajorEq ScompOne ScompOne = P.True johnMajorEq (ScompThree decs) (ScompThree decs_) = decs == decs_ johnMajorEq (ScompTwo stms) (ScompTwo stms_) = stms == stms_ johnMajorEq SexprOne SexprOne = P.True johnMajorEq (SexprTwo exp) (SexprTwo exp_) = exp == exp_ johnMajorEq (SselOne exp stm) (SselOne exp_ stm_) = exp == exp_ && stm == stm_ johnMajorEq (SselThree exp stm) (SselThree exp_ stm_) = exp == exp_ && stm == stm_ johnMajorEq (SselTwo exp stm1 stm2) (SselTwo exp_ stm1_ stm2_) = exp == exp_ && stm1 == stm1_ && stm2 == stm2_ johnMajorEq (SiterFour expression_stm1 expression_stm2 exp stm) (SiterFour expression_stm1_ expression_stm2_ exp_ stm_) = expression_stm1 == expression_stm1_ && expression_stm2 == expression_stm2_ && exp == exp_ && stm == stm_ johnMajorEq (SiterOne exp stm) (SiterOne exp_ stm_) = exp == exp_ && stm == stm_ johnMajorEq (SiterThree expression_stm1 expression_stm2 stm) (SiterThree expression_stm1_ expression_stm2_ stm_) = expression_stm1 == expression_stm1_ && expression_stm2 == expression_stm2_ && stm == stm_ johnMajorEq (SiterTwo stm exp) (SiterTwo stm_ exp_) = stm == stm_ && exp == exp_ johnMajorEq (SjumpFive exp) (SjumpFive exp_) = exp == exp_ johnMajorEq SjumpFour SjumpFour = P.True johnMajorEq (SjumpOne x) (SjumpOne x_) = x == x_ johnMajorEq SjumpThree SjumpThree = P.True johnMajorEq SjumpTwo SjumpTwo = P.True johnMajorEq (Earray exp1 exp2) (Earray exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Eassign exp1 assignment_op exp2) (Eassign exp1_ assignment_op_ exp2_) = exp1 == exp1_ && assignment_op == assignment_op_ && exp2 == exp2_ 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 (Ebytesexpr exp) (Ebytesexpr exp_) = exp == exp_ johnMajorEq (Ebytestype type_name) (Ebytestype type_name_) = type_name == type_name_ johnMajorEq (Ecomma exp1 exp2) (Ecomma 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 (Efunk exp) (Efunk exp_) = exp == exp_ johnMajorEq (Efunkpar exp exps) (Efunkpar exp_ exps_) = exp == exp_ && exps == exps_ 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 (Eneq exp1 exp2) (Eneq exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Eplus exp1 exp2) (Eplus exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Epoint exp x) (Epoint exp_ x_) = exp == exp_ && x == x_ 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 (Eselect exp x) (Eselect exp_ x_) = exp == exp_ && x == x_ johnMajorEq (Estring str) (Estring str_) = str == str_ johnMajorEq (Etimes exp1 exp2) (Etimes exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_ johnMajorEq (Etypeconv type_name exp) (Etypeconv type_name_ exp_) = type_name == type_name_ && exp == exp_ johnMajorEq (Evar x) (Evar x_) = x == x_ johnMajorEq (Ecdouble cDouble) (Ecdouble cDouble_) = cDouble == cDouble_ johnMajorEq (Ecfloat cFloat) (Ecfloat cFloat_) = cFloat == cFloat_ johnMajorEq (Echar c) (Echar c_) = c == c_ johnMajorEq (Eclongdouble cLongDouble) (Eclongdouble cLongDouble_) = cLongDouble == cLongDouble_ johnMajorEq (Edouble d) (Edouble d_) = d == d_ 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 (Eunsigned unsigned) (Eunsigned unsigned_) = unsigned == unsigned_ johnMajorEq (Eunsignlong unsignedLong) (Eunsignlong unsignedLong_) = unsignedLong == unsignedLong_ johnMajorEq (Especial exp) (Especial exp_) = exp == exp_ johnMajorEq Address Address = P.True johnMajorEq Complement Complement = P.True johnMajorEq Indirection Indirection = 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 AssignXor AssignXor = 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 (CDouble str) (CDouble str_) = str == str_ johnMajorEq (CFloat str) (CFloat str_) = str == str_ johnMajorEq (CLongDouble str) (CLongDouble str_) = str == str_ johnMajorEq _ _ = P.False compareSame :: Tree c -> Tree c -> P.Ordering compareSame (Progr external_declarations) (Progr external_declarations_) = P.compare external_declarations external_declarations_ compareSame (Afunc function_def) (Afunc function_def_) = P.compare function_def function_def_ compareSame (Global dec) (Global dec_) = P.compare dec dec_ compareSame (NewFunc declaration_specifiers declarator compound_stm) (NewFunc declaration_specifiers_ declarator_ compound_stm_) = P.mappend (P.compare declaration_specifiers declaration_specifiers_) (P.mappend (P.compare declarator declarator_) (P.compare compound_stm compound_stm_)) compareSame (NewFuncInt declarator compound_stm) (NewFuncInt declarator_ compound_stm_) = P.mappend (P.compare declarator declarator_) (P.compare compound_stm compound_stm_) compareSame (OldFunc declaration_specifiers declarator decs compound_stm) (OldFunc declaration_specifiers_ declarator_ decs_ compound_stm_) = P.mappend (P.compare declaration_specifiers declaration_specifiers_) (P.mappend (P.compare declarator declarator_) (P.mappend (P.compare decs decs_) (P.compare compound_stm compound_stm_))) compareSame (OldFuncInt declarator decs compound_stm) (OldFuncInt declarator_ decs_ compound_stm_) = P.mappend (P.compare declarator declarator_) (P.mappend (P.compare decs decs_) (P.compare compound_stm compound_stm_)) compareSame (Declarators declaration_specifiers init_declarators) (Declarators declaration_specifiers_ init_declarators_) = P.mappend (P.compare declaration_specifiers declaration_specifiers_) (P.compare init_declarators init_declarators_) compareSame (NoDeclarator declaration_specifiers) (NoDeclarator declaration_specifiers_) = P.compare declaration_specifiers declaration_specifiers_ compareSame (SpecProp type_qualifier) (SpecProp type_qualifier_) = P.compare type_qualifier type_qualifier_ compareSame (Storage storage_class_specifier) (Storage storage_class_specifier_) = P.compare storage_class_specifier storage_class_specifier_ compareSame (Type type_specifier) (Type type_specifier_) = P.compare type_specifier type_specifier_ compareSame (InitDecl declarator initializer) (InitDecl declarator_ initializer_) = P.mappend (P.compare declarator declarator_) (P.compare initializer initializer_) compareSame (OnlyDecl declarator) (OnlyDecl declarator_) = P.compare declarator declarator_ compareSame Tchar Tchar = P.EQ compareSame Tdouble Tdouble = P.EQ compareSame (Tenum enum_specifier) (Tenum enum_specifier_) = P.compare enum_specifier enum_specifier_ compareSame Tfloat Tfloat = P.EQ compareSame Tint Tint = P.EQ compareSame Tlong Tlong = P.EQ compareSame Tname Tname = P.EQ compareSame Tshort Tshort = P.EQ compareSame Tsigned Tsigned = P.EQ compareSame (Tstruct struct_or_union_spec) (Tstruct struct_or_union_spec_) = P.compare struct_or_union_spec struct_or_union_spec_ compareSame Tunsigned Tunsigned = P.EQ compareSame Tvoid Tvoid = P.EQ compareSame GlobalPrograms GlobalPrograms = P.EQ compareSame LocalBlock LocalBlock = P.EQ compareSame LocalProgram LocalProgram = P.EQ compareSame LocalReg LocalReg = P.EQ compareSame MyType MyType = P.EQ compareSame Const Const = P.EQ compareSame NoOptim NoOptim = P.EQ compareSame (Tag struct_or_union x struct_decs) (Tag struct_or_union_ x_ struct_decs_) = P.mappend (P.compare struct_or_union struct_or_union_) (P.mappend (P.compare x x_) (P.compare struct_decs struct_decs_)) compareSame (TagType struct_or_union x) (TagType struct_or_union_ x_) = P.mappend (P.compare struct_or_union struct_or_union_) (P.compare x x_) compareSame (Unique struct_or_union struct_decs) (Unique struct_or_union_ struct_decs_) = P.mappend (P.compare struct_or_union struct_or_union_) (P.compare struct_decs struct_decs_) compareSame Struct Struct = P.EQ compareSame Union Union = P.EQ compareSame (Structen spec_quals struct_declarators) (Structen spec_quals_ struct_declarators_) = P.mappend (P.compare spec_quals spec_quals_) (P.compare struct_declarators struct_declarators_) compareSame (QualSpec type_qualifier) (QualSpec type_qualifier_) = P.compare type_qualifier type_qualifier_ compareSame (TypeSpec type_specifier) (TypeSpec type_specifier_) = P.compare type_specifier type_specifier_ compareSame (DecField declarator constant_expression) (DecField declarator_ constant_expression_) = P.mappend (P.compare declarator declarator_) (P.compare constant_expression constant_expression_) compareSame (Decl declarator) (Decl declarator_) = P.compare declarator declarator_ compareSame (Field constant_expression) (Field constant_expression_) = P.compare constant_expression constant_expression_ compareSame (EnumDec enumerators) (EnumDec enumerators_) = P.compare enumerators enumerators_ compareSame (EnumName x enumerators) (EnumName x_ enumerators_) = P.mappend (P.compare x x_) (P.compare enumerators enumerators_) compareSame (EnumVar x) (EnumVar x_) = P.compare x x_ compareSame (EnumInit x constant_expression) (EnumInit x_ constant_expression_) = P.mappend (P.compare x x_) (P.compare constant_expression constant_expression_) compareSame (Plain x) (Plain x_) = P.compare x x_ compareSame (BeginPointer pointer direct_declarator) (BeginPointer pointer_ direct_declarator_) = P.mappend (P.compare pointer pointer_) (P.compare direct_declarator direct_declarator_) compareSame (NoPointer direct_declarator) (NoPointer direct_declarator_) = P.compare direct_declarator direct_declarator_ compareSame (Incomplete direct_declarator) (Incomplete direct_declarator_) = P.compare direct_declarator direct_declarator_ compareSame (InnitArray direct_declarator constant_expression) (InnitArray direct_declarator_ constant_expression_) = P.mappend (P.compare direct_declarator direct_declarator_) (P.compare constant_expression constant_expression_) compareSame (Name x) (Name x_) = P.compare x x_ compareSame (NewFuncDec direct_declarator parameter_type) (NewFuncDec direct_declarator_ parameter_type_) = P.mappend (P.compare direct_declarator direct_declarator_) (P.compare parameter_type parameter_type_) compareSame (OldFuncDec direct_declarator) (OldFuncDec direct_declarator_) = P.compare direct_declarator direct_declarator_ compareSame (OldFuncDef direct_declarator idents) (OldFuncDef direct_declarator_ idents_) = P.mappend (P.compare direct_declarator direct_declarator_) (P.compare idents idents_) compareSame (ParenDecl declarator) (ParenDecl declarator_) = P.compare declarator declarator_ compareSame Point Point = P.EQ compareSame (PointPoint pointer) (PointPoint pointer_) = P.compare pointer pointer_ compareSame (PointQual type_qualifiers) (PointQual type_qualifiers_) = P.compare type_qualifiers type_qualifiers_ compareSame (PointQualPoint type_qualifiers pointer) (PointQualPoint type_qualifiers_ pointer_) = P.mappend (P.compare type_qualifiers type_qualifiers_) (P.compare pointer pointer_) compareSame (AllSpec parameter_declarations) (AllSpec parameter_declarations_) = P.compare parameter_declarations parameter_declarations_ compareSame (More parameter_declarations) (More parameter_declarations_) = P.compare parameter_declarations parameter_declarations_ compareSame (MoreParamDec parameter_declarations parameter_declaration) (MoreParamDec parameter_declarations_ parameter_declaration_) = P.mappend (P.compare parameter_declarations parameter_declarations_) (P.compare parameter_declaration parameter_declaration_) compareSame (ParamDec parameter_declaration) (ParamDec parameter_declaration_) = P.compare parameter_declaration parameter_declaration_ compareSame (Abstract declaration_specifiers abstract_declarator) (Abstract declaration_specifiers_ abstract_declarator_) = P.mappend (P.compare declaration_specifiers declaration_specifiers_) (P.compare abstract_declarator abstract_declarator_) compareSame (OnlyType declaration_specifiers) (OnlyType declaration_specifiers_) = P.compare declaration_specifiers declaration_specifiers_ compareSame (TypeAndParam declaration_specifiers declarator) (TypeAndParam declaration_specifiers_ declarator_) = P.mappend (P.compare declaration_specifiers declaration_specifiers_) (P.compare declarator declarator_) compareSame (InitExpr exp) (InitExpr exp_) = P.compare exp exp_ compareSame (InitListOne initializers) (InitListOne initializers_) = P.compare initializers initializers_ compareSame (InitListTwo initializers) (InitListTwo initializers_) = P.compare initializers initializers_ compareSame (AnInit initializer) (AnInit initializer_) = P.compare initializer initializer_ compareSame (MoreInit initializers initializer) (MoreInit initializers_ initializer_) = P.mappend (P.compare initializers initializers_) (P.compare initializer initializer_) compareSame (ExtendedType spec_quals abstract_declarator) (ExtendedType spec_quals_ abstract_declarator_) = P.mappend (P.compare spec_quals spec_quals_) (P.compare abstract_declarator abstract_declarator_) compareSame (PlainType spec_quals) (PlainType spec_quals_) = P.compare spec_quals spec_quals_ compareSame (Advanced dir_abs_dec) (Advanced dir_abs_dec_) = P.compare dir_abs_dec dir_abs_dec_ compareSame (PointAdvanced pointer dir_abs_dec) (PointAdvanced pointer_ dir_abs_dec_) = P.mappend (P.compare pointer pointer_) (P.compare dir_abs_dec dir_abs_dec_) compareSame (PointerStart pointer) (PointerStart pointer_) = P.compare pointer pointer_ compareSame Array Array = P.EQ compareSame (Initiated dir_abs_dec constant_expression) (Initiated dir_abs_dec_ constant_expression_) = P.mappend (P.compare dir_abs_dec dir_abs_dec_) (P.compare constant_expression constant_expression_) compareSame (InitiatedArray constant_expression) (InitiatedArray constant_expression_) = P.compare constant_expression constant_expression_ compareSame (NewFuncExpr dir_abs_dec parameter_type) (NewFuncExpr dir_abs_dec_ parameter_type_) = P.mappend (P.compare dir_abs_dec dir_abs_dec_) (P.compare parameter_type parameter_type_) compareSame (NewFunction parameter_type) (NewFunction parameter_type_) = P.compare parameter_type parameter_type_ compareSame (OldFuncExpr dir_abs_dec) (OldFuncExpr dir_abs_dec_) = P.compare dir_abs_dec dir_abs_dec_ compareSame OldFunction OldFunction = P.EQ compareSame (UnInitiated dir_abs_dec) (UnInitiated dir_abs_dec_) = P.compare dir_abs_dec dir_abs_dec_ compareSame (WithinParentes abstract_declarator) (WithinParentes abstract_declarator_) = P.compare abstract_declarator abstract_declarator_ compareSame (CompS compound_stm) (CompS compound_stm_) = P.compare compound_stm compound_stm_ compareSame (ExprS expression_stm) (ExprS expression_stm_) = P.compare expression_stm expression_stm_ compareSame (IterS iter_stm) (IterS iter_stm_) = P.compare iter_stm iter_stm_ compareSame (JumpS jump_stm) (JumpS jump_stm_) = P.compare jump_stm jump_stm_ compareSame (LabelS labeled_stm) (LabelS labeled_stm_) = P.compare labeled_stm labeled_stm_ compareSame (SelS selection_stm) (SelS selection_stm_) = P.compare selection_stm selection_stm_ compareSame (SlabelOne x stm) (SlabelOne x_ stm_) = P.mappend (P.compare x x_) (P.compare stm stm_) compareSame (SlabelThree stm) (SlabelThree stm_) = P.compare stm stm_ compareSame (SlabelTwo constant_expression stm) (SlabelTwo constant_expression_ stm_) = P.mappend (P.compare constant_expression constant_expression_) (P.compare stm stm_) compareSame (ScompFour decs stms) (ScompFour decs_ stms_) = P.mappend (P.compare decs decs_) (P.compare stms stms_) compareSame ScompOne ScompOne = P.EQ compareSame (ScompThree decs) (ScompThree decs_) = P.compare decs decs_ compareSame (ScompTwo stms) (ScompTwo stms_) = P.compare stms stms_ compareSame SexprOne SexprOne = P.EQ compareSame (SexprTwo exp) (SexprTwo exp_) = P.compare exp exp_ compareSame (SselOne exp stm) (SselOne exp_ stm_) = P.mappend (P.compare exp exp_) (P.compare stm stm_) compareSame (SselThree exp stm) (SselThree exp_ stm_) = P.mappend (P.compare exp exp_) (P.compare stm stm_) compareSame (SselTwo exp stm1 stm2) (SselTwo exp_ stm1_ stm2_) = P.mappend (P.compare exp exp_) (P.mappend (P.compare stm1 stm1_) (P.compare stm2 stm2_)) compareSame (SiterFour expression_stm1 expression_stm2 exp stm) (SiterFour expression_stm1_ expression_stm2_ exp_ stm_) = P.mappend (P.compare expression_stm1 expression_stm1_) (P.mappend (P.compare expression_stm2 expression_stm2_) (P.mappend (P.compare exp exp_) (P.compare stm stm_))) compareSame (SiterOne exp stm) (SiterOne exp_ stm_) = P.mappend (P.compare exp exp_) (P.compare stm stm_) compareSame (SiterThree expression_stm1 expression_stm2 stm) (SiterThree expression_stm1_ expression_stm2_ stm_) = P.mappend (P.compare expression_stm1 expression_stm1_) (P.mappend (P.compare expression_stm2 expression_stm2_) (P.compare stm stm_)) compareSame (SiterTwo stm exp) (SiterTwo stm_ exp_) = P.mappend (P.compare stm stm_) (P.compare exp exp_) compareSame (SjumpFive exp) (SjumpFive exp_) = P.compare exp exp_ compareSame SjumpFour SjumpFour = P.EQ compareSame (SjumpOne x) (SjumpOne x_) = P.compare x x_ compareSame SjumpThree SjumpThree = P.EQ compareSame SjumpTwo SjumpTwo = P.EQ compareSame (Earray exp1 exp2) (Earray exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) 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 (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 (Ebytesexpr exp) (Ebytesexpr exp_) = P.compare exp exp_ compareSame (Ebytestype type_name) (Ebytestype type_name_) = P.compare type_name type_name_ compareSame (Ecomma exp1 exp2) (Ecomma 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 (Efunk exp) (Efunk exp_) = P.compare exp exp_ compareSame (Efunkpar exp exps) (Efunkpar exp_ exps_) = P.mappend (P.compare exp exp_) (P.compare exps exps_) 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 (Eneq exp1 exp2) (Eneq exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Eplus exp1 exp2) (Eplus exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_) compareSame (Epoint exp x) (Epoint exp_ x_) = P.mappend (P.compare exp exp_) (P.compare x x_) 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 (Eselect exp x) (Eselect exp_ x_) = P.mappend (P.compare exp exp_) (P.compare x x_) 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 (Etypeconv type_name exp) (Etypeconv type_name_ exp_) = P.mappend (P.compare type_name type_name_) (P.compare exp exp_) compareSame (Evar x) (Evar x_) = P.compare x x_ compareSame (Ecdouble cDouble) (Ecdouble cDouble_) = P.compare cDouble cDouble_ compareSame (Ecfloat cFloat) (Ecfloat cFloat_) = P.compare cFloat cFloat_ compareSame (Echar c) (Echar c_) = P.compare c c_ compareSame (Eclongdouble cLongDouble) (Eclongdouble cLongDouble_) = P.compare cLongDouble cLongDouble_ compareSame (Edouble d) (Edouble d_) = P.compare d d_ 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 (Eunsigned unsigned) (Eunsigned unsigned_) = P.compare unsigned unsigned_ compareSame (Eunsignlong unsignedLong) (Eunsignlong unsignedLong_) = P.compare unsignedLong unsignedLong_ compareSame (Especial exp) (Especial exp_) = P.compare exp exp_ compareSame Address Address = P.EQ compareSame Complement Complement = P.EQ compareSame Indirection Indirection = 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 AssignXor AssignXor = 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 (CDouble str) (CDouble str_) = P.compare str str_ compareSame (CFloat str) (CFloat str_) = P.compare str str_ compareSame (CLongDouble str) (CLongDouble str_) = P.compare str str_ compareSame _ _ = P.error "BNFC error: compareSame"