-- 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 AbsOCL ( Tree(..) , OCLfile , OCLPackage , PackageName , OCLExpressions , Constrnt , ConstrBody , ContextDeclaration , ClassifierContext , OperationContext , Stereotype , OperationName , FormalParameter , TypeSpecifier , CollectionType , ReturnType , OCLExpression , LetExpression , IfExpression , Expression , MessageArg , PropertyCall , PathName , PName , PossQualifiers , Qualifiers , PossTimeExpression , PossPropCallParam , Declarator , DeclaratorVarList , PropertyCallParameters , PCPHelper , OCLLiteral , SimpleTypeSpecifier , LiteralCollection , CollectionItem , OCLNumber , LogicalOperator , CollectionKind , EqualityOperator , RelationalOperator , AddOperator , MultiplyOperator , UnaryOperator , PostfixOperator , Ident , johnMajorEq , module ComposOpOCL ) where import Prelude ((.), (>), (&&), (==)) import Prelude ((.), (>), (&&), (==)) import qualified Prelude as P import ComposOpOCL data Tag = OCLfile_ | OCLPackage_ | PackageName_ | OCLExpressions_ | Constrnt_ | ConstrBody_ | ContextDeclaration_ | ClassifierContext_ | OperationContext_ | Stereotype_ | OperationName_ | FormalParameter_ | TypeSpecifier_ | CollectionType_ | ReturnType_ | OCLExpression_ | LetExpression_ | IfExpression_ | Expression_ | MessageArg_ | PropertyCall_ | PathName_ | PName_ | PossQualifiers_ | Qualifiers_ | PossTimeExpression_ | PossPropCallParam_ | Declarator_ | DeclaratorVarList_ | PropertyCallParameters_ | PCPHelper_ | OCLLiteral_ | SimpleTypeSpecifier_ | LiteralCollection_ | CollectionItem_ | OCLNumber_ | LogicalOperator_ | CollectionKind_ | EqualityOperator_ | RelationalOperator_ | AddOperator_ | MultiplyOperator_ | UnaryOperator_ | PostfixOperator_ | Ident_ type OCLfile = Tree 'OCLfile_ type OCLPackage = Tree 'OCLPackage_ type PackageName = Tree 'PackageName_ type OCLExpressions = Tree 'OCLExpressions_ type Constrnt = Tree 'Constrnt_ type ConstrBody = Tree 'ConstrBody_ type ContextDeclaration = Tree 'ContextDeclaration_ type ClassifierContext = Tree 'ClassifierContext_ type OperationContext = Tree 'OperationContext_ type Stereotype = Tree 'Stereotype_ type OperationName = Tree 'OperationName_ type FormalParameter = Tree 'FormalParameter_ type TypeSpecifier = Tree 'TypeSpecifier_ type CollectionType = Tree 'CollectionType_ type ReturnType = Tree 'ReturnType_ type OCLExpression = Tree 'OCLExpression_ type LetExpression = Tree 'LetExpression_ type IfExpression = Tree 'IfExpression_ type Expression = Tree 'Expression_ type MessageArg = Tree 'MessageArg_ type PropertyCall = Tree 'PropertyCall_ type PathName = Tree 'PathName_ type PName = Tree 'PName_ type PossQualifiers = Tree 'PossQualifiers_ type Qualifiers = Tree 'Qualifiers_ type PossTimeExpression = Tree 'PossTimeExpression_ type PossPropCallParam = Tree 'PossPropCallParam_ type Declarator = Tree 'Declarator_ type DeclaratorVarList = Tree 'DeclaratorVarList_ type PropertyCallParameters = Tree 'PropertyCallParameters_ type PCPHelper = Tree 'PCPHelper_ type OCLLiteral = Tree 'OCLLiteral_ type SimpleTypeSpecifier = Tree 'SimpleTypeSpecifier_ type LiteralCollection = Tree 'LiteralCollection_ type CollectionItem = Tree 'CollectionItem_ type OCLNumber = Tree 'OCLNumber_ type LogicalOperator = Tree 'LogicalOperator_ type CollectionKind = Tree 'CollectionKind_ type EqualityOperator = Tree 'EqualityOperator_ type RelationalOperator = Tree 'RelationalOperator_ type AddOperator = Tree 'AddOperator_ type MultiplyOperator = Tree 'MultiplyOperator_ type UnaryOperator = Tree 'UnaryOperator_ type PostfixOperator = Tree 'PostfixOperator_ type Ident = Tree 'Ident_ data Tree (a :: Tag) where OCLf :: [OCLPackage] -> Tree 'OCLfile_ Pack :: PackageName -> OCLExpressions -> Tree 'OCLPackage_ PackName :: PathName -> Tree 'PackageName_ Constraints :: [Constrnt] -> Tree 'OCLExpressions_ Constr :: ContextDeclaration -> [ConstrBody] -> Tree 'Constrnt_ CB :: Stereotype -> OCLExpression -> Tree 'ConstrBody_ CBDef :: [LetExpression] -> Tree 'ConstrBody_ CBDefNamed :: Ident -> [LetExpression] -> Tree 'ConstrBody_ CBNamed :: Stereotype -> Ident -> OCLExpression -> Tree 'ConstrBody_ CDClassif :: ClassifierContext -> Tree 'ContextDeclaration_ CDOper :: OperationContext -> Tree 'ContextDeclaration_ CC :: Ident -> Tree 'ClassifierContext_ CCType :: Ident -> Ident -> Tree 'ClassifierContext_ OpC :: Ident -> OperationName -> [FormalParameter] -> Tree 'OperationContext_ OpCRT :: Ident -> OperationName -> [FormalParameter] -> ReturnType -> Tree 'OperationContext_ Inv :: Tree 'Stereotype_ Post :: Tree 'Stereotype_ Pre :: Tree 'Stereotype_ Add :: Tree 'OperationName_ And :: Tree 'OperationName_ Div :: Tree 'OperationName_ Eq :: Tree 'OperationName_ GRT :: Tree 'OperationName_ GRTE :: Tree 'OperationName_ Impl :: Tree 'OperationName_ LST :: Tree 'OperationName_ LSTE :: Tree 'OperationName_ Mult :: Tree 'OperationName_ NEq :: Tree 'OperationName_ Not :: Tree 'OperationName_ OpName :: Ident -> Tree 'OperationName_ Or :: Tree 'OperationName_ Sub :: Tree 'OperationName_ Xor :: Tree 'OperationName_ FP :: Ident -> TypeSpecifier -> Tree 'FormalParameter_ TScoll :: CollectionType -> Tree 'TypeSpecifier_ TSsimple :: SimpleTypeSpecifier -> Tree 'TypeSpecifier_ CT :: CollectionKind -> SimpleTypeSpecifier -> Tree 'CollectionType_ RT :: TypeSpecifier -> Tree 'ReturnType_ OCLExp :: Expression -> Tree 'OCLExpression_ OCLExpLet :: [LetExpression] -> Expression -> Tree 'OCLExpression_ LE :: Ident -> [FormalParameter] -> Expression -> Tree 'LetExpression_ LENoParam :: Ident -> Expression -> Tree 'LetExpression_ LENoParamType :: Ident -> TypeSpecifier -> Expression -> Tree 'LetExpression_ LEType :: Ident -> [FormalParameter] -> TypeSpecifier -> Expression -> Tree 'LetExpression_ IfExp :: Expression -> Expression -> Expression -> Tree 'IfExpression_ EExplPropCall :: Expression -> PostfixOperator -> PropertyCall -> Tree 'Expression_ EIfExp :: IfExpression -> Tree 'Expression_ EImplPropCall :: PropertyCall -> Tree 'Expression_ ELit :: OCLLiteral -> Tree 'Expression_ ELitColl :: LiteralCollection -> Tree 'Expression_ EMessage :: Expression -> PathName -> [MessageArg] -> Tree 'Expression_ ENull :: Tree 'Expression_ EOpAdd :: Expression -> AddOperator -> Expression -> Tree 'Expression_ EOpEq :: Expression -> EqualityOperator -> Expression -> Tree 'Expression_ EOpImpl :: Expression -> Expression -> Tree 'Expression_ EOpLog :: Expression -> LogicalOperator -> Expression -> Tree 'Expression_ EOpMul :: Expression -> MultiplyOperator -> Expression -> Tree 'Expression_ EOpRel :: Expression -> RelationalOperator -> Expression -> Tree 'Expression_ EOpUn :: UnaryOperator -> Expression -> Tree 'Expression_ MAExpr :: Expression -> Tree 'MessageArg_ MAUnspec :: Tree 'MessageArg_ MAUnspecTyped :: TypeSpecifier -> Tree 'MessageArg_ PCall :: PathName -> PossTimeExpression -> PossQualifiers -> PossPropCallParam -> Tree 'PropertyCall_ PathN :: [PName] -> Tree 'PathName_ PN :: Ident -> Tree 'PName_ NoQual :: Tree 'PossQualifiers_ Qual :: Qualifiers -> Tree 'PossQualifiers_ Quals :: [Expression] -> Tree 'Qualifiers_ AtPre :: Tree 'PossTimeExpression_ NoTE :: Tree 'PossTimeExpression_ NoPCP :: Tree 'PossPropCallParam_ PCPs :: PropertyCallParameters -> Tree 'PossPropCallParam_ Decl :: DeclaratorVarList -> Tree 'Declarator_ DeclAcc :: DeclaratorVarList -> Ident -> TypeSpecifier -> Expression -> Tree 'Declarator_ DVL :: [Ident] -> Tree 'DeclaratorVarList_ DVLType :: [Ident] -> SimpleTypeSpecifier -> Tree 'DeclaratorVarList_ PCP :: [Expression] -> Tree 'PropertyCallParameters_ PCPConcrete :: Expression -> [PCPHelper] -> Tree 'PropertyCallParameters_ PCPDecl :: Declarator -> [Expression] -> Tree 'PropertyCallParameters_ PCPNoDeclNoParam :: Tree 'PropertyCallParameters_ PCPBar :: Expression -> Tree 'PCPHelper_ PCPColon :: SimpleTypeSpecifier -> Tree 'PCPHelper_ PCPComma :: Expression -> Tree 'PCPHelper_ PCPIterate :: Ident -> TypeSpecifier -> Expression -> Tree 'PCPHelper_ LitBoolFalse :: Tree 'OCLLiteral_ LitBoolTrue :: Tree 'OCLLiteral_ LitNum :: OCLNumber -> Tree 'OCLLiteral_ LitStr :: P.String -> Tree 'OCLLiteral_ STSpec :: PathName -> Tree 'SimpleTypeSpecifier_ LCollection :: CollectionKind -> [CollectionItem] -> Tree 'LiteralCollection_ LCollectionEmpty :: CollectionKind -> Tree 'LiteralCollection_ CI :: Expression -> Tree 'CollectionItem_ CIRange :: Expression -> Expression -> Tree 'CollectionItem_ NumDouble :: P.Double -> Tree 'OCLNumber_ NumInt :: P.Integer -> Tree 'OCLNumber_ LAnd :: Tree 'LogicalOperator_ LOr :: Tree 'LogicalOperator_ LXor :: Tree 'LogicalOperator_ Bag :: Tree 'CollectionKind_ Collection :: Tree 'CollectionKind_ Sequence :: Tree 'CollectionKind_ Set :: Tree 'CollectionKind_ EEq :: Tree 'EqualityOperator_ ENEq :: Tree 'EqualityOperator_ RGT :: Tree 'RelationalOperator_ RGTE :: Tree 'RelationalOperator_ RLT :: Tree 'RelationalOperator_ RLTE :: Tree 'RelationalOperator_ AAdd :: Tree 'AddOperator_ ASub :: Tree 'AddOperator_ MDiv :: Tree 'MultiplyOperator_ MMult :: Tree 'MultiplyOperator_ UMin :: Tree 'UnaryOperator_ UNot :: Tree 'UnaryOperator_ PArrow :: Tree 'PostfixOperator_ PDot :: Tree 'PostfixOperator_ Ident ::P.String -> Tree 'Ident_ instance Compos Tree where compos r a f = \case OCLf oCLPackages -> r OCLf `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) oCLPackages Pack packageName oCLExpressions -> r Pack `a` f packageName `a` f oCLExpressions PackName pathName -> r PackName `a` f pathName Constraints constrnts -> r Constraints `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) constrnts Constr contextDeclaration constrBodys -> r Constr `a` f contextDeclaration `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) constrBodys CB stereotype oCLExpression -> r CB `a` f stereotype `a` f oCLExpression CBDef letExpressions -> r CBDef `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) letExpressions CBDefNamed x letExpressions -> r CBDefNamed `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) letExpressions CBNamed stereotype x oCLExpression -> r CBNamed `a` f stereotype `a` f x `a` f oCLExpression CDClassif classifierContext -> r CDClassif `a` f classifierContext CDOper operationContext -> r CDOper `a` f operationContext CC x -> r CC `a` f x CCType x1 x2 -> r CCType `a` f x1 `a` f x2 OpC x operationName formalParameters -> r OpC `a` f x `a` f operationName `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) formalParameters OpCRT x operationName formalParameters returnType -> r OpCRT `a` f x `a` f operationName `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) formalParameters `a` f returnType OpName x -> r OpName `a` f x FP x typeSpecifier -> r FP `a` f x `a` f typeSpecifier TScoll collectionType -> r TScoll `a` f collectionType TSsimple simpleTypeSpecifier -> r TSsimple `a` f simpleTypeSpecifier CT collectionKind simpleTypeSpecifier -> r CT `a` f collectionKind `a` f simpleTypeSpecifier RT typeSpecifier -> r RT `a` f typeSpecifier OCLExp expression -> r OCLExp `a` f expression OCLExpLet letExpressions expression -> r OCLExpLet `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) letExpressions `a` f expression LE x formalParameters expression -> r LE `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) formalParameters `a` f expression LENoParam x expression -> r LENoParam `a` f x `a` f expression LENoParamType x typeSpecifier expression -> r LENoParamType `a` f x `a` f typeSpecifier `a` f expression LEType x formalParameters typeSpecifier expression -> r LEType `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) formalParameters `a` f typeSpecifier `a` f expression IfExp expression1 expression2 expression3 -> r IfExp `a` f expression1 `a` f expression2 `a` f expression3 EExplPropCall expression postfixOperator propertyCall -> r EExplPropCall `a` f expression `a` f postfixOperator `a` f propertyCall EIfExp ifExpression -> r EIfExp `a` f ifExpression EImplPropCall propertyCall -> r EImplPropCall `a` f propertyCall ELit oCLLiteral -> r ELit `a` f oCLLiteral ELitColl literalCollection -> r ELitColl `a` f literalCollection EMessage expression pathName messageArgs -> r EMessage `a` f expression `a` f pathName `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) messageArgs EOpAdd expression1 addOperator expression2 -> r EOpAdd `a` f expression1 `a` f addOperator `a` f expression2 EOpEq expression1 equalityOperator expression2 -> r EOpEq `a` f expression1 `a` f equalityOperator `a` f expression2 EOpImpl expression1 expression2 -> r EOpImpl `a` f expression1 `a` f expression2 EOpLog expression1 logicalOperator expression2 -> r EOpLog `a` f expression1 `a` f logicalOperator `a` f expression2 EOpMul expression1 multiplyOperator expression2 -> r EOpMul `a` f expression1 `a` f multiplyOperator `a` f expression2 EOpRel expression1 relationalOperator expression2 -> r EOpRel `a` f expression1 `a` f relationalOperator `a` f expression2 EOpUn unaryOperator expression -> r EOpUn `a` f unaryOperator `a` f expression MAExpr expression -> r MAExpr `a` f expression MAUnspecTyped typeSpecifier -> r MAUnspecTyped `a` f typeSpecifier PCall pathName possTimeExpression possQualifiers possPropCallParam -> r PCall `a` f pathName `a` f possTimeExpression `a` f possQualifiers `a` f possPropCallParam PathN pNames -> r PathN `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) pNames PN x -> r PN `a` f x Qual qualifiers -> r Qual `a` f qualifiers Quals expressions -> r Quals `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) expressions PCPs propertyCallParameters -> r PCPs `a` f propertyCallParameters Decl declaratorVarList -> r Decl `a` f declaratorVarList DeclAcc declaratorVarList x typeSpecifier expression -> r DeclAcc `a` f declaratorVarList `a` f x `a` f typeSpecifier `a` f expression DVL idents -> r DVL `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents DVLType idents simpleTypeSpecifier -> r DVLType `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents `a` f simpleTypeSpecifier PCP expressions -> r PCP `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) expressions PCPConcrete expression pCPHelpers -> r PCPConcrete `a` f expression `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) pCPHelpers PCPDecl declarator expressions -> r PCPDecl `a` f declarator `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) expressions PCPBar expression -> r PCPBar `a` f expression PCPColon simpleTypeSpecifier -> r PCPColon `a` f simpleTypeSpecifier PCPComma expression -> r PCPComma `a` f expression PCPIterate x typeSpecifier expression -> r PCPIterate `a` f x `a` f typeSpecifier `a` f expression LitNum oCLNumber -> r LitNum `a` f oCLNumber STSpec pathName -> r STSpec `a` f pathName LCollection collectionKind collectionItems -> r LCollection `a` f collectionKind `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) collectionItems LCollectionEmpty collectionKind -> r LCollectionEmpty `a` f collectionKind CI expression -> r CI `a` f expression CIRange expression1 expression2 -> r CIRange `a` f expression1 `a` f expression2 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 OCLf oCLPackages -> opar . P.showString "OCLf" . P.showChar ' ' . P.showsPrec 1 oCLPackages . cpar Pack packageName oCLExpressions -> opar . P.showString "Pack" . P.showChar ' ' . P.showsPrec 1 packageName . P.showChar ' ' . P.showsPrec 1 oCLExpressions . cpar PackName pathName -> opar . P.showString "PackName" . P.showChar ' ' . P.showsPrec 1 pathName . cpar Constraints constrnts -> opar . P.showString "Constraints" . P.showChar ' ' . P.showsPrec 1 constrnts . cpar Constr contextDeclaration constrBodys -> opar . P.showString "Constr" . P.showChar ' ' . P.showsPrec 1 contextDeclaration . P.showChar ' ' . P.showsPrec 1 constrBodys . cpar CB stereotype oCLExpression -> opar . P.showString "CB" . P.showChar ' ' . P.showsPrec 1 stereotype . P.showChar ' ' . P.showsPrec 1 oCLExpression . cpar CBDef letExpressions -> opar . P.showString "CBDef" . P.showChar ' ' . P.showsPrec 1 letExpressions . cpar CBDefNamed x letExpressions -> opar . P.showString "CBDefNamed" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 letExpressions . cpar CBNamed stereotype x oCLExpression -> opar . P.showString "CBNamed" . P.showChar ' ' . P.showsPrec 1 stereotype . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 oCLExpression . cpar CDClassif classifierContext -> opar . P.showString "CDClassif" . P.showChar ' ' . P.showsPrec 1 classifierContext . cpar CDOper operationContext -> opar . P.showString "CDOper" . P.showChar ' ' . P.showsPrec 1 operationContext . cpar CC x -> opar . P.showString "CC" . P.showChar ' ' . P.showsPrec 1 x . cpar CCType x1 x2 -> opar . P.showString "CCType" . P.showChar ' ' . P.showsPrec 1 x1 . P.showChar ' ' . P.showsPrec 1 x2 . cpar OpC x operationName formalParameters -> opar . P.showString "OpC" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 operationName . P.showChar ' ' . P.showsPrec 1 formalParameters . cpar OpCRT x operationName formalParameters returnType -> opar . P.showString "OpCRT" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 operationName . P.showChar ' ' . P.showsPrec 1 formalParameters . P.showChar ' ' . P.showsPrec 1 returnType . cpar Inv -> P.showString "Inv" Post -> P.showString "Post" Pre -> P.showString "Pre" Add -> P.showString "Add" And -> P.showString "And" Div -> P.showString "Div" Eq -> P.showString "Eq" GRT -> P.showString "GRT" GRTE -> P.showString "GRTE" Impl -> P.showString "Impl" LST -> P.showString "LST" LSTE -> P.showString "LSTE" Mult -> P.showString "Mult" NEq -> P.showString "NEq" Not -> P.showString "Not" OpName x -> opar . P.showString "OpName" . P.showChar ' ' . P.showsPrec 1 x . cpar Or -> P.showString "Or" Sub -> P.showString "Sub" Xor -> P.showString "Xor" FP x typeSpecifier -> opar . P.showString "FP" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeSpecifier . cpar TScoll collectionType -> opar . P.showString "TScoll" . P.showChar ' ' . P.showsPrec 1 collectionType . cpar TSsimple simpleTypeSpecifier -> opar . P.showString "TSsimple" . P.showChar ' ' . P.showsPrec 1 simpleTypeSpecifier . cpar CT collectionKind simpleTypeSpecifier -> opar . P.showString "CT" . P.showChar ' ' . P.showsPrec 1 collectionKind . P.showChar ' ' . P.showsPrec 1 simpleTypeSpecifier . cpar RT typeSpecifier -> opar . P.showString "RT" . P.showChar ' ' . P.showsPrec 1 typeSpecifier . cpar OCLExp expression -> opar . P.showString "OCLExp" . P.showChar ' ' . P.showsPrec 1 expression . cpar OCLExpLet letExpressions expression -> opar . P.showString "OCLExpLet" . P.showChar ' ' . P.showsPrec 1 letExpressions . P.showChar ' ' . P.showsPrec 1 expression . cpar LE x formalParameters expression -> opar . P.showString "LE" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 formalParameters . P.showChar ' ' . P.showsPrec 1 expression . cpar LENoParam x expression -> opar . P.showString "LENoParam" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 expression . cpar LENoParamType x typeSpecifier expression -> opar . P.showString "LENoParamType" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeSpecifier . P.showChar ' ' . P.showsPrec 1 expression . cpar LEType x formalParameters typeSpecifier expression -> opar . P.showString "LEType" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 formalParameters . P.showChar ' ' . P.showsPrec 1 typeSpecifier . P.showChar ' ' . P.showsPrec 1 expression . cpar IfExp expression1 expression2 expression3 -> opar . P.showString "IfExp" . P.showChar ' ' . P.showsPrec 1 expression1 . P.showChar ' ' . P.showsPrec 1 expression2 . P.showChar ' ' . P.showsPrec 1 expression3 . cpar EExplPropCall expression postfixOperator propertyCall -> opar . P.showString "EExplPropCall" . P.showChar ' ' . P.showsPrec 1 expression . P.showChar ' ' . P.showsPrec 1 postfixOperator . P.showChar ' ' . P.showsPrec 1 propertyCall . cpar EIfExp ifExpression -> opar . P.showString "EIfExp" . P.showChar ' ' . P.showsPrec 1 ifExpression . cpar EImplPropCall propertyCall -> opar . P.showString "EImplPropCall" . P.showChar ' ' . P.showsPrec 1 propertyCall . cpar ELit oCLLiteral -> opar . P.showString "ELit" . P.showChar ' ' . P.showsPrec 1 oCLLiteral . cpar ELitColl literalCollection -> opar . P.showString "ELitColl" . P.showChar ' ' . P.showsPrec 1 literalCollection . cpar EMessage expression pathName messageArgs -> opar . P.showString "EMessage" . P.showChar ' ' . P.showsPrec 1 expression . P.showChar ' ' . P.showsPrec 1 pathName . P.showChar ' ' . P.showsPrec 1 messageArgs . cpar ENull -> P.showString "ENull" EOpAdd expression1 addOperator expression2 -> opar . P.showString "EOpAdd" . P.showChar ' ' . P.showsPrec 1 expression1 . P.showChar ' ' . P.showsPrec 1 addOperator . P.showChar ' ' . P.showsPrec 1 expression2 . cpar EOpEq expression1 equalityOperator expression2 -> opar . P.showString "EOpEq" . P.showChar ' ' . P.showsPrec 1 expression1 . P.showChar ' ' . P.showsPrec 1 equalityOperator . P.showChar ' ' . P.showsPrec 1 expression2 . cpar EOpImpl expression1 expression2 -> opar . P.showString "EOpImpl" . P.showChar ' ' . P.showsPrec 1 expression1 . P.showChar ' ' . P.showsPrec 1 expression2 . cpar EOpLog expression1 logicalOperator expression2 -> opar . P.showString "EOpLog" . P.showChar ' ' . P.showsPrec 1 expression1 . P.showChar ' ' . P.showsPrec 1 logicalOperator . P.showChar ' ' . P.showsPrec 1 expression2 . cpar EOpMul expression1 multiplyOperator expression2 -> opar . P.showString "EOpMul" . P.showChar ' ' . P.showsPrec 1 expression1 . P.showChar ' ' . P.showsPrec 1 multiplyOperator . P.showChar ' ' . P.showsPrec 1 expression2 . cpar EOpRel expression1 relationalOperator expression2 -> opar . P.showString "EOpRel" . P.showChar ' ' . P.showsPrec 1 expression1 . P.showChar ' ' . P.showsPrec 1 relationalOperator . P.showChar ' ' . P.showsPrec 1 expression2 . cpar EOpUn unaryOperator expression -> opar . P.showString "EOpUn" . P.showChar ' ' . P.showsPrec 1 unaryOperator . P.showChar ' ' . P.showsPrec 1 expression . cpar MAExpr expression -> opar . P.showString "MAExpr" . P.showChar ' ' . P.showsPrec 1 expression . cpar MAUnspec -> P.showString "MAUnspec" MAUnspecTyped typeSpecifier -> opar . P.showString "MAUnspecTyped" . P.showChar ' ' . P.showsPrec 1 typeSpecifier . cpar PCall pathName possTimeExpression possQualifiers possPropCallParam -> opar . P.showString "PCall" . P.showChar ' ' . P.showsPrec 1 pathName . P.showChar ' ' . P.showsPrec 1 possTimeExpression . P.showChar ' ' . P.showsPrec 1 possQualifiers . P.showChar ' ' . P.showsPrec 1 possPropCallParam . cpar PathN pNames -> opar . P.showString "PathN" . P.showChar ' ' . P.showsPrec 1 pNames . cpar PN x -> opar . P.showString "PN" . P.showChar ' ' . P.showsPrec 1 x . cpar NoQual -> P.showString "NoQual" Qual qualifiers -> opar . P.showString "Qual" . P.showChar ' ' . P.showsPrec 1 qualifiers . cpar Quals expressions -> opar . P.showString "Quals" . P.showChar ' ' . P.showsPrec 1 expressions . cpar AtPre -> P.showString "AtPre" NoTE -> P.showString "NoTE" NoPCP -> P.showString "NoPCP" PCPs propertyCallParameters -> opar . P.showString "PCPs" . P.showChar ' ' . P.showsPrec 1 propertyCallParameters . cpar Decl declaratorVarList -> opar . P.showString "Decl" . P.showChar ' ' . P.showsPrec 1 declaratorVarList . cpar DeclAcc declaratorVarList x typeSpecifier expression -> opar . P.showString "DeclAcc" . P.showChar ' ' . P.showsPrec 1 declaratorVarList . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeSpecifier . P.showChar ' ' . P.showsPrec 1 expression . cpar DVL idents -> opar . P.showString "DVL" . P.showChar ' ' . P.showsPrec 1 idents . cpar DVLType idents simpleTypeSpecifier -> opar . P.showString "DVLType" . P.showChar ' ' . P.showsPrec 1 idents . P.showChar ' ' . P.showsPrec 1 simpleTypeSpecifier . cpar PCP expressions -> opar . P.showString "PCP" . P.showChar ' ' . P.showsPrec 1 expressions . cpar PCPConcrete expression pCPHelpers -> opar . P.showString "PCPConcrete" . P.showChar ' ' . P.showsPrec 1 expression . P.showChar ' ' . P.showsPrec 1 pCPHelpers . cpar PCPDecl declarator expressions -> opar . P.showString "PCPDecl" . P.showChar ' ' . P.showsPrec 1 declarator . P.showChar ' ' . P.showsPrec 1 expressions . cpar PCPNoDeclNoParam -> P.showString "PCPNoDeclNoParam" PCPBar expression -> opar . P.showString "PCPBar" . P.showChar ' ' . P.showsPrec 1 expression . cpar PCPColon simpleTypeSpecifier -> opar . P.showString "PCPColon" . P.showChar ' ' . P.showsPrec 1 simpleTypeSpecifier . cpar PCPComma expression -> opar . P.showString "PCPComma" . P.showChar ' ' . P.showsPrec 1 expression . cpar PCPIterate x typeSpecifier expression -> opar . P.showString "PCPIterate" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 typeSpecifier . P.showChar ' ' . P.showsPrec 1 expression . cpar LitBoolFalse -> P.showString "LitBoolFalse" LitBoolTrue -> P.showString "LitBoolTrue" LitNum oCLNumber -> opar . P.showString "LitNum" . P.showChar ' ' . P.showsPrec 1 oCLNumber . cpar LitStr str -> opar . P.showString "LitStr" . P.showChar ' ' . P.showsPrec 1 str . cpar STSpec pathName -> opar . P.showString "STSpec" . P.showChar ' ' . P.showsPrec 1 pathName . cpar LCollection collectionKind collectionItems -> opar . P.showString "LCollection" . P.showChar ' ' . P.showsPrec 1 collectionKind . P.showChar ' ' . P.showsPrec 1 collectionItems . cpar LCollectionEmpty collectionKind -> opar . P.showString "LCollectionEmpty" . P.showChar ' ' . P.showsPrec 1 collectionKind . cpar CI expression -> opar . P.showString "CI" . P.showChar ' ' . P.showsPrec 1 expression . cpar CIRange expression1 expression2 -> opar . P.showString "CIRange" . P.showChar ' ' . P.showsPrec 1 expression1 . P.showChar ' ' . P.showsPrec 1 expression2 . cpar NumDouble d -> opar . P.showString "NumDouble" . P.showChar ' ' . P.showsPrec 1 d . cpar NumInt n -> opar . P.showString "NumInt" . P.showChar ' ' . P.showsPrec 1 n . cpar LAnd -> P.showString "LAnd" LOr -> P.showString "LOr" LXor -> P.showString "LXor" Bag -> P.showString "Bag" Collection -> P.showString "Collection" Sequence -> P.showString "Sequence" Set -> P.showString "Set" EEq -> P.showString "EEq" ENEq -> P.showString "ENEq" RGT -> P.showString "RGT" RGTE -> P.showString "RGTE" RLT -> P.showString "RLT" RLTE -> P.showString "RLTE" AAdd -> P.showString "AAdd" ASub -> P.showString "ASub" MDiv -> P.showString "MDiv" MMult -> P.showString "MMult" UMin -> P.showString "UMin" UNot -> P.showString "UNot" PArrow -> P.showString "PArrow" PDot -> P.showString "PDot" 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 (OCLf _) = 1 index (Pack _ _) = 2 index (PackName _) = 3 index (Constraints _) = 4 index (Constr _ _) = 5 index (CB _ _) = 6 index (CBDef _) = 7 index (CBDefNamed _ _) = 8 index (CBNamed _ _ _) = 9 index (CDClassif _) = 10 index (CDOper _) = 11 index (CC _) = 12 index (CCType _ _) = 13 index (OpC _ _ _) = 14 index (OpCRT _ _ _ _) = 15 index (Inv ) = 16 index (Post ) = 17 index (Pre ) = 18 index (Add ) = 19 index (And ) = 20 index (Div ) = 21 index (Eq ) = 22 index (GRT ) = 23 index (GRTE ) = 24 index (Impl ) = 25 index (LST ) = 26 index (LSTE ) = 27 index (Mult ) = 28 index (NEq ) = 29 index (Not ) = 30 index (OpName _) = 31 index (Or ) = 32 index (Sub ) = 33 index (Xor ) = 34 index (FP _ _) = 35 index (TScoll _) = 36 index (TSsimple _) = 37 index (CT _ _) = 38 index (RT _) = 39 index (OCLExp _) = 40 index (OCLExpLet _ _) = 41 index (LE _ _ _) = 42 index (LENoParam _ _) = 43 index (LENoParamType _ _ _) = 44 index (LEType _ _ _ _) = 45 index (IfExp _ _ _) = 46 index (EExplPropCall _ _ _) = 47 index (EIfExp _) = 48 index (EImplPropCall _) = 49 index (ELit _) = 50 index (ELitColl _) = 51 index (EMessage _ _ _) = 52 index (ENull ) = 53 index (EOpAdd _ _ _) = 54 index (EOpEq _ _ _) = 55 index (EOpImpl _ _) = 56 index (EOpLog _ _ _) = 57 index (EOpMul _ _ _) = 58 index (EOpRel _ _ _) = 59 index (EOpUn _ _) = 60 index (MAExpr _) = 61 index (MAUnspec ) = 62 index (MAUnspecTyped _) = 63 index (PCall _ _ _ _) = 64 index (PathN _) = 65 index (PN _) = 66 index (NoQual ) = 67 index (Qual _) = 68 index (Quals _) = 69 index (AtPre ) = 70 index (NoTE ) = 71 index (NoPCP ) = 72 index (PCPs _) = 73 index (Decl _) = 74 index (DeclAcc _ _ _ _) = 75 index (DVL _) = 76 index (DVLType _ _) = 77 index (PCP _) = 78 index (PCPConcrete _ _) = 79 index (PCPDecl _ _) = 80 index (PCPNoDeclNoParam ) = 81 index (PCPBar _) = 82 index (PCPColon _) = 83 index (PCPComma _) = 84 index (PCPIterate _ _ _) = 85 index (LitBoolFalse ) = 86 index (LitBoolTrue ) = 87 index (LitNum _) = 88 index (LitStr _) = 89 index (STSpec _) = 90 index (LCollection _ _) = 91 index (LCollectionEmpty _) = 92 index (CI _) = 93 index (CIRange _ _) = 94 index (NumDouble _) = 95 index (NumInt _) = 96 index (LAnd ) = 97 index (LOr ) = 98 index (LXor ) = 99 index (Bag ) = 100 index (Collection ) = 101 index (Sequence ) = 102 index (Set ) = 103 index (EEq ) = 104 index (ENEq ) = 105 index (RGT ) = 106 index (RGTE ) = 107 index (RLT ) = 108 index (RLTE ) = 109 index (AAdd ) = 110 index (ASub ) = 111 index (MDiv ) = 112 index (MMult ) = 113 index (UMin ) = 114 index (UNot ) = 115 index (PArrow ) = 116 index (PDot ) = 117 index (Ident _) = 118 johnMajorEq :: Tree a -> Tree b -> P.Bool johnMajorEq (OCLf oCLPackages) (OCLf oCLPackages_) = oCLPackages == oCLPackages_ johnMajorEq (Pack packageName oCLExpressions) (Pack packageName_ oCLExpressions_) = packageName == packageName_ && oCLExpressions == oCLExpressions_ johnMajorEq (PackName pathName) (PackName pathName_) = pathName == pathName_ johnMajorEq (Constraints constrnts) (Constraints constrnts_) = constrnts == constrnts_ johnMajorEq (Constr contextDeclaration constrBodys) (Constr contextDeclaration_ constrBodys_) = contextDeclaration == contextDeclaration_ && constrBodys == constrBodys_ johnMajorEq (CB stereotype oCLExpression) (CB stereotype_ oCLExpression_) = stereotype == stereotype_ && oCLExpression == oCLExpression_ johnMajorEq (CBDef letExpressions) (CBDef letExpressions_) = letExpressions == letExpressions_ johnMajorEq (CBDefNamed x letExpressions) (CBDefNamed x_ letExpressions_) = x == x_ && letExpressions == letExpressions_ johnMajorEq (CBNamed stereotype x oCLExpression) (CBNamed stereotype_ x_ oCLExpression_) = stereotype == stereotype_ && x == x_ && oCLExpression == oCLExpression_ johnMajorEq (CDClassif classifierContext) (CDClassif classifierContext_) = classifierContext == classifierContext_ johnMajorEq (CDOper operationContext) (CDOper operationContext_) = operationContext == operationContext_ johnMajorEq (CC x) (CC x_) = x == x_ johnMajorEq (CCType x1 x2) (CCType x1_ x2_) = x1 == x1_ && x2 == x2_ johnMajorEq (OpC x operationName formalParameters) (OpC x_ operationName_ formalParameters_) = x == x_ && operationName == operationName_ && formalParameters == formalParameters_ johnMajorEq (OpCRT x operationName formalParameters returnType) (OpCRT x_ operationName_ formalParameters_ returnType_) = x == x_ && operationName == operationName_ && formalParameters == formalParameters_ && returnType == returnType_ johnMajorEq Inv Inv = P.True johnMajorEq Post Post = P.True johnMajorEq Pre Pre = P.True johnMajorEq Add Add = P.True johnMajorEq And And = P.True johnMajorEq Div Div = P.True johnMajorEq Eq Eq = P.True johnMajorEq GRT GRT = P.True johnMajorEq GRTE GRTE = P.True johnMajorEq Impl Impl = P.True johnMajorEq LST LST = P.True johnMajorEq LSTE LSTE = P.True johnMajorEq Mult Mult = P.True johnMajorEq NEq NEq = P.True johnMajorEq Not Not = P.True johnMajorEq (OpName x) (OpName x_) = x == x_ johnMajorEq Or Or = P.True johnMajorEq Sub Sub = P.True johnMajorEq Xor Xor = P.True johnMajorEq (FP x typeSpecifier) (FP x_ typeSpecifier_) = x == x_ && typeSpecifier == typeSpecifier_ johnMajorEq (TScoll collectionType) (TScoll collectionType_) = collectionType == collectionType_ johnMajorEq (TSsimple simpleTypeSpecifier) (TSsimple simpleTypeSpecifier_) = simpleTypeSpecifier == simpleTypeSpecifier_ johnMajorEq (CT collectionKind simpleTypeSpecifier) (CT collectionKind_ simpleTypeSpecifier_) = collectionKind == collectionKind_ && simpleTypeSpecifier == simpleTypeSpecifier_ johnMajorEq (RT typeSpecifier) (RT typeSpecifier_) = typeSpecifier == typeSpecifier_ johnMajorEq (OCLExp expression) (OCLExp expression_) = expression == expression_ johnMajorEq (OCLExpLet letExpressions expression) (OCLExpLet letExpressions_ expression_) = letExpressions == letExpressions_ && expression == expression_ johnMajorEq (LE x formalParameters expression) (LE x_ formalParameters_ expression_) = x == x_ && formalParameters == formalParameters_ && expression == expression_ johnMajorEq (LENoParam x expression) (LENoParam x_ expression_) = x == x_ && expression == expression_ johnMajorEq (LENoParamType x typeSpecifier expression) (LENoParamType x_ typeSpecifier_ expression_) = x == x_ && typeSpecifier == typeSpecifier_ && expression == expression_ johnMajorEq (LEType x formalParameters typeSpecifier expression) (LEType x_ formalParameters_ typeSpecifier_ expression_) = x == x_ && formalParameters == formalParameters_ && typeSpecifier == typeSpecifier_ && expression == expression_ johnMajorEq (IfExp expression1 expression2 expression3) (IfExp expression1_ expression2_ expression3_) = expression1 == expression1_ && expression2 == expression2_ && expression3 == expression3_ johnMajorEq (EExplPropCall expression postfixOperator propertyCall) (EExplPropCall expression_ postfixOperator_ propertyCall_) = expression == expression_ && postfixOperator == postfixOperator_ && propertyCall == propertyCall_ johnMajorEq (EIfExp ifExpression) (EIfExp ifExpression_) = ifExpression == ifExpression_ johnMajorEq (EImplPropCall propertyCall) (EImplPropCall propertyCall_) = propertyCall == propertyCall_ johnMajorEq (ELit oCLLiteral) (ELit oCLLiteral_) = oCLLiteral == oCLLiteral_ johnMajorEq (ELitColl literalCollection) (ELitColl literalCollection_) = literalCollection == literalCollection_ johnMajorEq (EMessage expression pathName messageArgs) (EMessage expression_ pathName_ messageArgs_) = expression == expression_ && pathName == pathName_ && messageArgs == messageArgs_ johnMajorEq ENull ENull = P.True johnMajorEq (EOpAdd expression1 addOperator expression2) (EOpAdd expression1_ addOperator_ expression2_) = expression1 == expression1_ && addOperator == addOperator_ && expression2 == expression2_ johnMajorEq (EOpEq expression1 equalityOperator expression2) (EOpEq expression1_ equalityOperator_ expression2_) = expression1 == expression1_ && equalityOperator == equalityOperator_ && expression2 == expression2_ johnMajorEq (EOpImpl expression1 expression2) (EOpImpl expression1_ expression2_) = expression1 == expression1_ && expression2 == expression2_ johnMajorEq (EOpLog expression1 logicalOperator expression2) (EOpLog expression1_ logicalOperator_ expression2_) = expression1 == expression1_ && logicalOperator == logicalOperator_ && expression2 == expression2_ johnMajorEq (EOpMul expression1 multiplyOperator expression2) (EOpMul expression1_ multiplyOperator_ expression2_) = expression1 == expression1_ && multiplyOperator == multiplyOperator_ && expression2 == expression2_ johnMajorEq (EOpRel expression1 relationalOperator expression2) (EOpRel expression1_ relationalOperator_ expression2_) = expression1 == expression1_ && relationalOperator == relationalOperator_ && expression2 == expression2_ johnMajorEq (EOpUn unaryOperator expression) (EOpUn unaryOperator_ expression_) = unaryOperator == unaryOperator_ && expression == expression_ johnMajorEq (MAExpr expression) (MAExpr expression_) = expression == expression_ johnMajorEq MAUnspec MAUnspec = P.True johnMajorEq (MAUnspecTyped typeSpecifier) (MAUnspecTyped typeSpecifier_) = typeSpecifier == typeSpecifier_ johnMajorEq (PCall pathName possTimeExpression possQualifiers possPropCallParam) (PCall pathName_ possTimeExpression_ possQualifiers_ possPropCallParam_) = pathName == pathName_ && possTimeExpression == possTimeExpression_ && possQualifiers == possQualifiers_ && possPropCallParam == possPropCallParam_ johnMajorEq (PathN pNames) (PathN pNames_) = pNames == pNames_ johnMajorEq (PN x) (PN x_) = x == x_ johnMajorEq NoQual NoQual = P.True johnMajorEq (Qual qualifiers) (Qual qualifiers_) = qualifiers == qualifiers_ johnMajorEq (Quals expressions) (Quals expressions_) = expressions == expressions_ johnMajorEq AtPre AtPre = P.True johnMajorEq NoTE NoTE = P.True johnMajorEq NoPCP NoPCP = P.True johnMajorEq (PCPs propertyCallParameters) (PCPs propertyCallParameters_) = propertyCallParameters == propertyCallParameters_ johnMajorEq (Decl declaratorVarList) (Decl declaratorVarList_) = declaratorVarList == declaratorVarList_ johnMajorEq (DeclAcc declaratorVarList x typeSpecifier expression) (DeclAcc declaratorVarList_ x_ typeSpecifier_ expression_) = declaratorVarList == declaratorVarList_ && x == x_ && typeSpecifier == typeSpecifier_ && expression == expression_ johnMajorEq (DVL idents) (DVL idents_) = idents == idents_ johnMajorEq (DVLType idents simpleTypeSpecifier) (DVLType idents_ simpleTypeSpecifier_) = idents == idents_ && simpleTypeSpecifier == simpleTypeSpecifier_ johnMajorEq (PCP expressions) (PCP expressions_) = expressions == expressions_ johnMajorEq (PCPConcrete expression pCPHelpers) (PCPConcrete expression_ pCPHelpers_) = expression == expression_ && pCPHelpers == pCPHelpers_ johnMajorEq (PCPDecl declarator expressions) (PCPDecl declarator_ expressions_) = declarator == declarator_ && expressions == expressions_ johnMajorEq PCPNoDeclNoParam PCPNoDeclNoParam = P.True johnMajorEq (PCPBar expression) (PCPBar expression_) = expression == expression_ johnMajorEq (PCPColon simpleTypeSpecifier) (PCPColon simpleTypeSpecifier_) = simpleTypeSpecifier == simpleTypeSpecifier_ johnMajorEq (PCPComma expression) (PCPComma expression_) = expression == expression_ johnMajorEq (PCPIterate x typeSpecifier expression) (PCPIterate x_ typeSpecifier_ expression_) = x == x_ && typeSpecifier == typeSpecifier_ && expression == expression_ johnMajorEq LitBoolFalse LitBoolFalse = P.True johnMajorEq LitBoolTrue LitBoolTrue = P.True johnMajorEq (LitNum oCLNumber) (LitNum oCLNumber_) = oCLNumber == oCLNumber_ johnMajorEq (LitStr str) (LitStr str_) = str == str_ johnMajorEq (STSpec pathName) (STSpec pathName_) = pathName == pathName_ johnMajorEq (LCollection collectionKind collectionItems) (LCollection collectionKind_ collectionItems_) = collectionKind == collectionKind_ && collectionItems == collectionItems_ johnMajorEq (LCollectionEmpty collectionKind) (LCollectionEmpty collectionKind_) = collectionKind == collectionKind_ johnMajorEq (CI expression) (CI expression_) = expression == expression_ johnMajorEq (CIRange expression1 expression2) (CIRange expression1_ expression2_) = expression1 == expression1_ && expression2 == expression2_ johnMajorEq (NumDouble d) (NumDouble d_) = d == d_ johnMajorEq (NumInt n) (NumInt n_) = n == n_ johnMajorEq LAnd LAnd = P.True johnMajorEq LOr LOr = P.True johnMajorEq LXor LXor = P.True johnMajorEq Bag Bag = P.True johnMajorEq Collection Collection = P.True johnMajorEq Sequence Sequence = P.True johnMajorEq Set Set = P.True johnMajorEq EEq EEq = P.True johnMajorEq ENEq ENEq = P.True johnMajorEq RGT RGT = P.True johnMajorEq RGTE RGTE = P.True johnMajorEq RLT RLT = P.True johnMajorEq RLTE RLTE = P.True johnMajorEq AAdd AAdd = P.True johnMajorEq ASub ASub = P.True johnMajorEq MDiv MDiv = P.True johnMajorEq MMult MMult = P.True johnMajorEq UMin UMin = P.True johnMajorEq UNot UNot = P.True johnMajorEq PArrow PArrow = P.True johnMajorEq PDot PDot = P.True johnMajorEq (Ident str) (Ident str_) = str == str_ johnMajorEq _ _ = P.False compareSame :: Tree c -> Tree c -> P.Ordering compareSame (OCLf oCLPackages) (OCLf oCLPackages_) = P.compare oCLPackages oCLPackages_ compareSame (Pack packageName oCLExpressions) (Pack packageName_ oCLExpressions_) = P.mappend (P.compare packageName packageName_) (P.compare oCLExpressions oCLExpressions_) compareSame (PackName pathName) (PackName pathName_) = P.compare pathName pathName_ compareSame (Constraints constrnts) (Constraints constrnts_) = P.compare constrnts constrnts_ compareSame (Constr contextDeclaration constrBodys) (Constr contextDeclaration_ constrBodys_) = P.mappend (P.compare contextDeclaration contextDeclaration_) (P.compare constrBodys constrBodys_) compareSame (CB stereotype oCLExpression) (CB stereotype_ oCLExpression_) = P.mappend (P.compare stereotype stereotype_) (P.compare oCLExpression oCLExpression_) compareSame (CBDef letExpressions) (CBDef letExpressions_) = P.compare letExpressions letExpressions_ compareSame (CBDefNamed x letExpressions) (CBDefNamed x_ letExpressions_) = P.mappend (P.compare x x_) (P.compare letExpressions letExpressions_) compareSame (CBNamed stereotype x oCLExpression) (CBNamed stereotype_ x_ oCLExpression_) = P.mappend (P.compare stereotype stereotype_) (P.mappend (P.compare x x_) (P.compare oCLExpression oCLExpression_)) compareSame (CDClassif classifierContext) (CDClassif classifierContext_) = P.compare classifierContext classifierContext_ compareSame (CDOper operationContext) (CDOper operationContext_) = P.compare operationContext operationContext_ compareSame (CC x) (CC x_) = P.compare x x_ compareSame (CCType x1 x2) (CCType x1_ x2_) = P.mappend (P.compare x1 x1_) (P.compare x2 x2_) compareSame (OpC x operationName formalParameters) (OpC x_ operationName_ formalParameters_) = P.mappend (P.compare x x_) (P.mappend (P.compare operationName operationName_) (P.compare formalParameters formalParameters_)) compareSame (OpCRT x operationName formalParameters returnType) (OpCRT x_ operationName_ formalParameters_ returnType_) = P.mappend (P.compare x x_) (P.mappend (P.compare operationName operationName_) (P.mappend (P.compare formalParameters formalParameters_) (P.compare returnType returnType_))) compareSame Inv Inv = P.EQ compareSame Post Post = P.EQ compareSame Pre Pre = P.EQ compareSame Add Add = P.EQ compareSame And And = P.EQ compareSame Div Div = P.EQ compareSame Eq Eq = P.EQ compareSame GRT GRT = P.EQ compareSame GRTE GRTE = P.EQ compareSame Impl Impl = P.EQ compareSame LST LST = P.EQ compareSame LSTE LSTE = P.EQ compareSame Mult Mult = P.EQ compareSame NEq NEq = P.EQ compareSame Not Not = P.EQ compareSame (OpName x) (OpName x_) = P.compare x x_ compareSame Or Or = P.EQ compareSame Sub Sub = P.EQ compareSame Xor Xor = P.EQ compareSame (FP x typeSpecifier) (FP x_ typeSpecifier_) = P.mappend (P.compare x x_) (P.compare typeSpecifier typeSpecifier_) compareSame (TScoll collectionType) (TScoll collectionType_) = P.compare collectionType collectionType_ compareSame (TSsimple simpleTypeSpecifier) (TSsimple simpleTypeSpecifier_) = P.compare simpleTypeSpecifier simpleTypeSpecifier_ compareSame (CT collectionKind simpleTypeSpecifier) (CT collectionKind_ simpleTypeSpecifier_) = P.mappend (P.compare collectionKind collectionKind_) (P.compare simpleTypeSpecifier simpleTypeSpecifier_) compareSame (RT typeSpecifier) (RT typeSpecifier_) = P.compare typeSpecifier typeSpecifier_ compareSame (OCLExp expression) (OCLExp expression_) = P.compare expression expression_ compareSame (OCLExpLet letExpressions expression) (OCLExpLet letExpressions_ expression_) = P.mappend (P.compare letExpressions letExpressions_) (P.compare expression expression_) compareSame (LE x formalParameters expression) (LE x_ formalParameters_ expression_) = P.mappend (P.compare x x_) (P.mappend (P.compare formalParameters formalParameters_) (P.compare expression expression_)) compareSame (LENoParam x expression) (LENoParam x_ expression_) = P.mappend (P.compare x x_) (P.compare expression expression_) compareSame (LENoParamType x typeSpecifier expression) (LENoParamType x_ typeSpecifier_ expression_) = P.mappend (P.compare x x_) (P.mappend (P.compare typeSpecifier typeSpecifier_) (P.compare expression expression_)) compareSame (LEType x formalParameters typeSpecifier expression) (LEType x_ formalParameters_ typeSpecifier_ expression_) = P.mappend (P.compare x x_) (P.mappend (P.compare formalParameters formalParameters_) (P.mappend (P.compare typeSpecifier typeSpecifier_) (P.compare expression expression_))) compareSame (IfExp expression1 expression2 expression3) (IfExp expression1_ expression2_ expression3_) = P.mappend (P.compare expression1 expression1_) (P.mappend (P.compare expression2 expression2_) (P.compare expression3 expression3_)) compareSame (EExplPropCall expression postfixOperator propertyCall) (EExplPropCall expression_ postfixOperator_ propertyCall_) = P.mappend (P.compare expression expression_) (P.mappend (P.compare postfixOperator postfixOperator_) (P.compare propertyCall propertyCall_)) compareSame (EIfExp ifExpression) (EIfExp ifExpression_) = P.compare ifExpression ifExpression_ compareSame (EImplPropCall propertyCall) (EImplPropCall propertyCall_) = P.compare propertyCall propertyCall_ compareSame (ELit oCLLiteral) (ELit oCLLiteral_) = P.compare oCLLiteral oCLLiteral_ compareSame (ELitColl literalCollection) (ELitColl literalCollection_) = P.compare literalCollection literalCollection_ compareSame (EMessage expression pathName messageArgs) (EMessage expression_ pathName_ messageArgs_) = P.mappend (P.compare expression expression_) (P.mappend (P.compare pathName pathName_) (P.compare messageArgs messageArgs_)) compareSame ENull ENull = P.EQ compareSame (EOpAdd expression1 addOperator expression2) (EOpAdd expression1_ addOperator_ expression2_) = P.mappend (P.compare expression1 expression1_) (P.mappend (P.compare addOperator addOperator_) (P.compare expression2 expression2_)) compareSame (EOpEq expression1 equalityOperator expression2) (EOpEq expression1_ equalityOperator_ expression2_) = P.mappend (P.compare expression1 expression1_) (P.mappend (P.compare equalityOperator equalityOperator_) (P.compare expression2 expression2_)) compareSame (EOpImpl expression1 expression2) (EOpImpl expression1_ expression2_) = P.mappend (P.compare expression1 expression1_) (P.compare expression2 expression2_) compareSame (EOpLog expression1 logicalOperator expression2) (EOpLog expression1_ logicalOperator_ expression2_) = P.mappend (P.compare expression1 expression1_) (P.mappend (P.compare logicalOperator logicalOperator_) (P.compare expression2 expression2_)) compareSame (EOpMul expression1 multiplyOperator expression2) (EOpMul expression1_ multiplyOperator_ expression2_) = P.mappend (P.compare expression1 expression1_) (P.mappend (P.compare multiplyOperator multiplyOperator_) (P.compare expression2 expression2_)) compareSame (EOpRel expression1 relationalOperator expression2) (EOpRel expression1_ relationalOperator_ expression2_) = P.mappend (P.compare expression1 expression1_) (P.mappend (P.compare relationalOperator relationalOperator_) (P.compare expression2 expression2_)) compareSame (EOpUn unaryOperator expression) (EOpUn unaryOperator_ expression_) = P.mappend (P.compare unaryOperator unaryOperator_) (P.compare expression expression_) compareSame (MAExpr expression) (MAExpr expression_) = P.compare expression expression_ compareSame MAUnspec MAUnspec = P.EQ compareSame (MAUnspecTyped typeSpecifier) (MAUnspecTyped typeSpecifier_) = P.compare typeSpecifier typeSpecifier_ compareSame (PCall pathName possTimeExpression possQualifiers possPropCallParam) (PCall pathName_ possTimeExpression_ possQualifiers_ possPropCallParam_) = P.mappend (P.compare pathName pathName_) (P.mappend (P.compare possTimeExpression possTimeExpression_) (P.mappend (P.compare possQualifiers possQualifiers_) (P.compare possPropCallParam possPropCallParam_))) compareSame (PathN pNames) (PathN pNames_) = P.compare pNames pNames_ compareSame (PN x) (PN x_) = P.compare x x_ compareSame NoQual NoQual = P.EQ compareSame (Qual qualifiers) (Qual qualifiers_) = P.compare qualifiers qualifiers_ compareSame (Quals expressions) (Quals expressions_) = P.compare expressions expressions_ compareSame AtPre AtPre = P.EQ compareSame NoTE NoTE = P.EQ compareSame NoPCP NoPCP = P.EQ compareSame (PCPs propertyCallParameters) (PCPs propertyCallParameters_) = P.compare propertyCallParameters propertyCallParameters_ compareSame (Decl declaratorVarList) (Decl declaratorVarList_) = P.compare declaratorVarList declaratorVarList_ compareSame (DeclAcc declaratorVarList x typeSpecifier expression) (DeclAcc declaratorVarList_ x_ typeSpecifier_ expression_) = P.mappend (P.compare declaratorVarList declaratorVarList_) (P.mappend (P.compare x x_) (P.mappend (P.compare typeSpecifier typeSpecifier_) (P.compare expression expression_))) compareSame (DVL idents) (DVL idents_) = P.compare idents idents_ compareSame (DVLType idents simpleTypeSpecifier) (DVLType idents_ simpleTypeSpecifier_) = P.mappend (P.compare idents idents_) (P.compare simpleTypeSpecifier simpleTypeSpecifier_) compareSame (PCP expressions) (PCP expressions_) = P.compare expressions expressions_ compareSame (PCPConcrete expression pCPHelpers) (PCPConcrete expression_ pCPHelpers_) = P.mappend (P.compare expression expression_) (P.compare pCPHelpers pCPHelpers_) compareSame (PCPDecl declarator expressions) (PCPDecl declarator_ expressions_) = P.mappend (P.compare declarator declarator_) (P.compare expressions expressions_) compareSame PCPNoDeclNoParam PCPNoDeclNoParam = P.EQ compareSame (PCPBar expression) (PCPBar expression_) = P.compare expression expression_ compareSame (PCPColon simpleTypeSpecifier) (PCPColon simpleTypeSpecifier_) = P.compare simpleTypeSpecifier simpleTypeSpecifier_ compareSame (PCPComma expression) (PCPComma expression_) = P.compare expression expression_ compareSame (PCPIterate x typeSpecifier expression) (PCPIterate x_ typeSpecifier_ expression_) = P.mappend (P.compare x x_) (P.mappend (P.compare typeSpecifier typeSpecifier_) (P.compare expression expression_)) compareSame LitBoolFalse LitBoolFalse = P.EQ compareSame LitBoolTrue LitBoolTrue = P.EQ compareSame (LitNum oCLNumber) (LitNum oCLNumber_) = P.compare oCLNumber oCLNumber_ compareSame (LitStr str) (LitStr str_) = P.compare str str_ compareSame (STSpec pathName) (STSpec pathName_) = P.compare pathName pathName_ compareSame (LCollection collectionKind collectionItems) (LCollection collectionKind_ collectionItems_) = P.mappend (P.compare collectionKind collectionKind_) (P.compare collectionItems collectionItems_) compareSame (LCollectionEmpty collectionKind) (LCollectionEmpty collectionKind_) = P.compare collectionKind collectionKind_ compareSame (CI expression) (CI expression_) = P.compare expression expression_ compareSame (CIRange expression1 expression2) (CIRange expression1_ expression2_) = P.mappend (P.compare expression1 expression1_) (P.compare expression2 expression2_) compareSame (NumDouble d) (NumDouble d_) = P.compare d d_ compareSame (NumInt n) (NumInt n_) = P.compare n n_ compareSame LAnd LAnd = P.EQ compareSame LOr LOr = P.EQ compareSame LXor LXor = P.EQ compareSame Bag Bag = P.EQ compareSame Collection Collection = P.EQ compareSame Sequence Sequence = P.EQ compareSame Set Set = P.EQ compareSame EEq EEq = P.EQ compareSame ENEq ENEq = P.EQ compareSame RGT RGT = P.EQ compareSame RGTE RGTE = P.EQ compareSame RLT RLT = P.EQ compareSame RLTE RLTE = P.EQ compareSame AAdd AAdd = P.EQ compareSame ASub ASub = P.EQ compareSame MDiv MDiv = P.EQ compareSame MMult MMult = P.EQ compareSame UMin UMin = P.EQ compareSame UNot UNot = P.EQ compareSame PArrow PArrow = P.EQ compareSame PDot PDot = P.EQ compareSame (Ident str) (Ident str_) = P.compare str str_ compareSame _ _ = P.error "BNFC error: compareSame"