{-# OPTIONS_GHC -fglasgow-exts #-}
module Transfer.Core.Abs where

import Control.Monad (ap,MonadPlus,msum,mplus,mzero)
import Data.Monoid

-- Haskell module generated by the BNF converter

data Module_
type Module = Tree Module_
data Decl_
type Decl = Tree Decl_
data ConsDecl_
type ConsDecl = Tree ConsDecl_
data Pattern_
type Pattern = Tree Pattern_
data FieldPattern_
type FieldPattern = Tree FieldPattern_
data PatternVariable_
type PatternVariable = Tree PatternVariable_
data Exp_
type Exp = Tree Exp_
data LetDef_
type LetDef = Tree LetDef_
data Case_
type Case = Tree Case_
data FieldType_
type FieldType = Tree FieldType_
data FieldValue_
type FieldValue = Tree FieldValue_
data TMeta_
type TMeta = Tree TMeta_
data CIdent_
type CIdent = Tree CIdent_

data Tree :: * -> * where
    Module :: [Decl] -> Tree Module_
    DataDecl :: CIdent -> Exp -> [ConsDecl] -> Tree Decl_
    TypeDecl :: CIdent -> Exp -> Tree Decl_
    ValueDecl :: CIdent -> Exp -> Tree Decl_
    ConsDecl :: CIdent -> Exp -> Tree ConsDecl_
    PCons :: CIdent -> [Pattern] -> Tree Pattern_
    PVar :: PatternVariable -> Tree Pattern_
    PRec :: [FieldPattern] -> Tree Pattern_
    PType :: Tree Pattern_
    PStr :: String -> Tree Pattern_
    PInt :: Integer -> Tree Pattern_
    FieldPattern :: CIdent -> Pattern -> Tree FieldPattern_
    PVVar :: CIdent -> Tree PatternVariable_
    PVWild :: Tree PatternVariable_
    ELet :: [LetDef] -> Exp -> Tree Exp_
    ECase :: Exp -> [Case] -> Tree Exp_
    EAbs :: PatternVariable -> Exp -> Tree Exp_
    EPi :: PatternVariable -> Exp -> Exp -> Tree Exp_
    EApp :: Exp -> Exp -> Tree Exp_
    EProj :: Exp -> CIdent -> Tree Exp_
    ERecType :: [FieldType] -> Tree Exp_
    ERec :: [FieldValue] -> Tree Exp_
    EVar :: CIdent -> Tree Exp_
    EType :: Tree Exp_
    EStr :: String -> Tree Exp_
    EInteger :: Integer -> Tree Exp_
    EDouble :: Double -> Tree Exp_
    EMeta :: TMeta -> Tree Exp_
    LetDef :: CIdent -> Exp -> Tree LetDef_
    Case :: Pattern -> Exp -> Exp -> Tree Case_
    FieldType :: CIdent -> Exp -> Tree FieldType_
    FieldValue :: CIdent -> Exp -> Tree FieldValue_
    TMeta :: String -> Tree TMeta_
    CIdent :: String -> Tree CIdent_

composOp :: (forall a. Tree a -> Tree a) -> Tree c -> Tree c
composOp f = head . composOpM (\x -> [f x])

composOpM_ :: Monad m => (forall a. Tree a -> m ()) -> Tree c -> m ()
composOpM_ = composOpFold (return ()) (>>)

composOpMPlus :: MonadPlus m => (forall a. Tree a -> m b) -> Tree c -> m b
composOpMPlus = composOpFold mzero mplus

composOpMonoid :: Monoid m => (forall a. Tree a -> m) -> Tree c -> m
composOpMonoid = composOpFold mempty mappend

composOpM :: Monad m => (forall a. Tree a -> m (Tree a)) -> Tree c -> m (Tree c)
composOpM f t = case t of
    Module decls -> return Module `ap` mapM f decls
    DataDecl cident exp consdecls -> return DataDecl `ap` f cident `ap` f exp `ap` mapM f consdecls
    TypeDecl cident exp -> return TypeDecl `ap` f cident `ap` f exp
    ValueDecl cident exp -> return ValueDecl `ap` f cident `ap` f exp
    ConsDecl cident exp -> return ConsDecl `ap` f cident `ap` f exp
    PCons cident patterns -> return PCons `ap` f cident `ap` mapM f patterns
    PVar patternvariable -> return PVar `ap` f patternvariable
    PRec fieldpatterns -> return PRec `ap` mapM f fieldpatterns
    FieldPattern cident pattern -> return FieldPattern `ap` f cident `ap` f pattern
    PVVar cident -> return PVVar `ap` f cident
    ELet letdefs exp -> return ELet `ap` mapM f letdefs `ap` f exp
    ECase exp cases -> return ECase `ap` f exp `ap` mapM f cases
    EAbs patternvariable exp -> return EAbs `ap` f patternvariable `ap` f exp
    EPi patternvariable exp0 exp1 -> return EPi `ap` f patternvariable `ap` f exp0 `ap` f exp1
    EApp exp0 exp1 -> return EApp `ap` f exp0 `ap` f exp1
    EProj exp cident -> return EProj `ap` f exp `ap` f cident
    ERecType fieldtypes -> return ERecType `ap` mapM f fieldtypes
    ERec fieldvalues -> return ERec `ap` mapM f fieldvalues
    EVar cident -> return EVar `ap` f cident
    EMeta tmeta -> return EMeta `ap` f tmeta
    LetDef cident exp -> return LetDef `ap` f cident `ap` f exp
    Case pattern exp0 exp1 -> return Case `ap` f pattern `ap` f exp0 `ap` f exp1
    FieldType cident exp -> return FieldType `ap` f cident `ap` f exp
    FieldValue cident exp -> return FieldValue `ap` f cident `ap` f exp
    _ -> return t

composOpFold :: b -> (b -> b -> b) -> (forall a. Tree a -> b) -> Tree c -> b
composOpFold zero combine f t = case t of
    Module decls -> foldr combine zero (map f decls)
    DataDecl cident exp consdecls -> f cident `combine` f exp `combine` foldr combine zero (map f consdecls)
    TypeDecl cident exp -> f cident `combine` f exp
    ValueDecl cident exp -> f cident `combine` f exp
    ConsDecl cident exp -> f cident `combine` f exp
    PCons cident patterns -> f cident `combine` foldr combine zero (map f patterns)
    PVar patternvariable -> f patternvariable
    PRec fieldpatterns -> foldr combine zero (map f fieldpatterns)
    FieldPattern cident pattern -> f cident `combine` f pattern
    PVVar cident -> f cident
    ELet letdefs exp -> foldr combine zero (map f letdefs) `combine` f exp
    ECase exp cases -> f exp `combine` foldr combine zero (map f cases)
    EAbs patternvariable exp -> f patternvariable `combine` f exp
    EPi patternvariable exp0 exp1 -> f patternvariable `combine` f exp0 `combine` f exp1
    EApp exp0 exp1 -> f exp0 `combine` f exp1
    EProj exp cident -> f exp `combine` f cident
    ERecType fieldtypes -> foldr combine zero (map f fieldtypes)
    ERec fieldvalues -> foldr combine zero (map f fieldvalues)
    EVar cident -> f cident
    EMeta tmeta -> f tmeta
    LetDef cident exp -> f cident `combine` f exp
    Case pattern exp0 exp1 -> f pattern `combine` f exp0 `combine` f exp1
    FieldType cident exp -> f cident `combine` f exp
    FieldValue cident exp -> f cident `combine` f exp
    _ -> zero

instance Show (Tree c) where
  showsPrec n t = case t of
    Module decls -> opar n . showString "Module" . showChar ' ' . showsPrec 1 decls . cpar n
    DataDecl cident exp consdecls -> opar n . showString "DataDecl" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 consdecls . cpar n
    TypeDecl cident exp -> opar n . showString "TypeDecl" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
    ValueDecl cident exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
    ConsDecl cident exp -> opar n . showString "ConsDecl" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
    PCons cident patterns -> opar n . showString "PCons" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 patterns . cpar n
    PVar patternvariable -> opar n . showString "PVar" . showChar ' ' . showsPrec 1 patternvariable . cpar n
    PRec fieldpatterns -> opar n . showString "PRec" . showChar ' ' . showsPrec 1 fieldpatterns . cpar n
    PType -> showString "PType"
    PStr str -> opar n . showString "PStr" . showChar ' ' . showsPrec 1 str . cpar n
    PInt n -> opar n . showString "PInt" . showChar ' ' . showsPrec 1 n . cpar n
    FieldPattern cident pattern -> opar n . showString "FieldPattern" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 pattern . cpar n
    PVVar cident -> opar n . showString "PVVar" . showChar ' ' . showsPrec 1 cident . cpar n
    PVWild -> showString "PVWild"
    ELet letdefs exp -> opar n . showString "ELet" . showChar ' ' . showsPrec 1 letdefs . showChar ' ' . showsPrec 1 exp . cpar n
    ECase exp cases -> opar n . showString "ECase" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 cases . cpar n
    EAbs patternvariable exp -> opar n . showString "EAbs" . showChar ' ' . showsPrec 1 patternvariable . showChar ' ' . showsPrec 1 exp . cpar n
    EPi patternvariable exp0 exp1 -> opar n . showString "EPi" . showChar ' ' . showsPrec 1 patternvariable . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
    EApp exp0 exp1 -> opar n . showString "EApp" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
    EProj exp cident -> opar n . showString "EProj" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 cident . cpar n
    ERecType fieldtypes -> opar n . showString "ERecType" . showChar ' ' . showsPrec 1 fieldtypes . cpar n
    ERec fieldvalues -> opar n . showString "ERec" . showChar ' ' . showsPrec 1 fieldvalues . cpar n
    EVar cident -> opar n . showString "EVar" . showChar ' ' . showsPrec 1 cident . cpar n
    EType -> showString "EType"
    EStr str -> opar n . showString "EStr" . showChar ' ' . showsPrec 1 str . cpar n
    EInteger n -> opar n . showString "EInteger" . showChar ' ' . showsPrec 1 n . cpar n
    EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . cpar n
    EMeta tmeta -> opar n . showString "EMeta" . showChar ' ' . showsPrec 1 tmeta . cpar n
    LetDef cident exp -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
    Case pattern exp0 exp1 -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
    FieldType cident exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
    FieldValue cident exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
    TMeta str -> opar n . showString "TMeta" . showChar ' ' . showsPrec 1 str . cpar n
    CIdent str -> opar n . showString "CIdent" . showChar ' ' . showsPrec 1 str . cpar n
   where opar n = if n > 0 then showChar '(' else id
         cpar n = if n > 0 then showChar ')' else id

instance Eq (Tree c) where (==) = johnMajorEq

johnMajorEq :: Tree a -> Tree b -> Bool
johnMajorEq (Module decls) (Module decls_) = decls == decls_
johnMajorEq (DataDecl cident exp consdecls) (DataDecl cident_ exp_ consdecls_) = cident == cident_ && exp == exp_ && consdecls == consdecls_
johnMajorEq (TypeDecl cident exp) (TypeDecl cident_ exp_) = cident == cident_ && exp == exp_
johnMajorEq (ValueDecl cident exp) (ValueDecl cident_ exp_) = cident == cident_ && exp == exp_
johnMajorEq (ConsDecl cident exp) (ConsDecl cident_ exp_) = cident == cident_ && exp == exp_
johnMajorEq (PCons cident patterns) (PCons cident_ patterns_) = cident == cident_ && patterns == patterns_
johnMajorEq (PVar patternvariable) (PVar patternvariable_) = patternvariable == patternvariable_
johnMajorEq (PRec fieldpatterns) (PRec fieldpatterns_) = fieldpatterns == fieldpatterns_
johnMajorEq PType PType = True
johnMajorEq (PStr str) (PStr str_) = str == str_
johnMajorEq (PInt n) (PInt n_) = n == n_
johnMajorEq (FieldPattern cident pattern) (FieldPattern cident_ pattern_) = cident == cident_ && pattern == pattern_
johnMajorEq (PVVar cident) (PVVar cident_) = cident == cident_
johnMajorEq PVWild PVWild = True
johnMajorEq (ELet letdefs exp) (ELet letdefs_ exp_) = letdefs == letdefs_ && exp == exp_
johnMajorEq (ECase exp cases) (ECase exp_ cases_) = exp == exp_ && cases == cases_
johnMajorEq (EAbs patternvariable exp) (EAbs patternvariable_ exp_) = patternvariable == patternvariable_ && exp == exp_
johnMajorEq (EPi patternvariable exp0 exp1) (EPi patternvariable_ exp0_ exp1_) = patternvariable == patternvariable_ && exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EApp exp0 exp1) (EApp exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EProj exp cident) (EProj exp_ cident_) = exp == exp_ && cident == cident_
johnMajorEq (ERecType fieldtypes) (ERecType fieldtypes_) = fieldtypes == fieldtypes_
johnMajorEq (ERec fieldvalues) (ERec fieldvalues_) = fieldvalues == fieldvalues_
johnMajorEq (EVar cident) (EVar cident_) = cident == cident_
johnMajorEq EType EType = True
johnMajorEq (EStr str) (EStr str_) = str == str_
johnMajorEq (EInteger n) (EInteger n_) = n == n_
johnMajorEq (EDouble d) (EDouble d_) = d == d_
johnMajorEq (EMeta tmeta) (EMeta tmeta_) = tmeta == tmeta_
johnMajorEq (LetDef cident exp) (LetDef cident_ exp_) = cident == cident_ && exp == exp_
johnMajorEq (Case pattern exp0 exp1) (Case pattern_ exp0_ exp1_) = pattern == pattern_ && exp0 == exp0_ && exp1 == exp1_
johnMajorEq (FieldType cident exp) (FieldType cident_ exp_) = cident == cident_ && exp == exp_
johnMajorEq (FieldValue cident exp) (FieldValue cident_ exp_) = cident == cident_ && exp == exp_
johnMajorEq (TMeta str) (TMeta str_) = str == str_
johnMajorEq (CIdent str) (CIdent str_) = str == str_
johnMajorEq _ _ = False

instance Ord (Tree c) where
  compare x y = compare (index x) (index y) `mappend` compareSame x y
    where
    index (Module _) = 0
    index (DataDecl _ _ _) = 1
    index (TypeDecl _ _) = 2
    index (ValueDecl _ _) = 3
    index (ConsDecl _ _) = 4
    index (PCons _ _) = 5
    index (PVar _) = 6
    index (PRec _) = 7
    index (PType ) = 8
    index (PStr _) = 9
    index (PInt _) = 10
    index (FieldPattern _ _) = 11
    index (PVVar _) = 12
    index (PVWild ) = 13
    index (ELet _ _) = 14
    index (ECase _ _) = 15
    index (EAbs _ _) = 16
    index (EPi _ _ _) = 17
    index (EApp _ _) = 18
    index (EProj _ _) = 19
    index (ERecType _) = 20
    index (ERec _) = 21
    index (EVar _) = 22
    index (EType ) = 23
    index (EStr _) = 24
    index (EInteger _) = 25
    index (EDouble _) = 26
    index (EMeta _) = 27
    index (LetDef _ _) = 28
    index (Case _ _ _) = 29
    index (FieldType _ _) = 30
    index (FieldValue _ _) = 31
    index (TMeta _) = 32
    index (CIdent _) = 33
    compareSame (Module decls) (Module decls_) = compare decls decls_
    compareSame (DataDecl cident exp consdecls) (DataDecl cident_ exp_ consdecls_) = mappend (compare cident cident_) (mappend (compare exp exp_) (compare consdecls consdecls_))
    compareSame (TypeDecl cident exp) (TypeDecl cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
    compareSame (ValueDecl cident exp) (ValueDecl cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
    compareSame (ConsDecl cident exp) (ConsDecl cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
    compareSame (PCons cident patterns) (PCons cident_ patterns_) = mappend (compare cident cident_) (compare patterns patterns_)
    compareSame (PVar patternvariable) (PVar patternvariable_) = compare patternvariable patternvariable_
    compareSame (PRec fieldpatterns) (PRec fieldpatterns_) = compare fieldpatterns fieldpatterns_
    compareSame PType PType = EQ
    compareSame (PStr str) (PStr str_) = compare str str_
    compareSame (PInt n) (PInt n_) = compare n n_
    compareSame (FieldPattern cident pattern) (FieldPattern cident_ pattern_) = mappend (compare cident cident_) (compare pattern pattern_)
    compareSame (PVVar cident) (PVVar cident_) = compare cident cident_
    compareSame PVWild PVWild = EQ
    compareSame (ELet letdefs exp) (ELet letdefs_ exp_) = mappend (compare letdefs letdefs_) (compare exp exp_)
    compareSame (ECase exp cases) (ECase exp_ cases_) = mappend (compare exp exp_) (compare cases cases_)
    compareSame (EAbs patternvariable exp) (EAbs patternvariable_ exp_) = mappend (compare patternvariable patternvariable_) (compare exp exp_)
    compareSame (EPi patternvariable exp0 exp1) (EPi patternvariable_ exp0_ exp1_) = mappend (compare patternvariable patternvariable_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
    compareSame (EApp exp0 exp1) (EApp exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
    compareSame (EProj exp cident) (EProj exp_ cident_) = mappend (compare exp exp_) (compare cident cident_)
    compareSame (ERecType fieldtypes) (ERecType fieldtypes_) = compare fieldtypes fieldtypes_
    compareSame (ERec fieldvalues) (ERec fieldvalues_) = compare fieldvalues fieldvalues_
    compareSame (EVar cident) (EVar cident_) = compare cident cident_
    compareSame EType EType = EQ
    compareSame (EStr str) (EStr str_) = compare str str_
    compareSame (EInteger n) (EInteger n_) = compare n n_
    compareSame (EDouble d) (EDouble d_) = compare d d_
    compareSame (EMeta tmeta) (EMeta tmeta_) = compare tmeta tmeta_
    compareSame (LetDef cident exp) (LetDef cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
    compareSame (Case pattern exp0 exp1) (Case pattern_ exp0_ exp1_) = mappend (compare pattern pattern_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
    compareSame (FieldType cident exp) (FieldType cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
    compareSame (FieldValue cident exp) (FieldValue cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
    compareSame (TMeta str) (TMeta str_) = compare str str_
    compareSame (CIdent str) (CIdent str_) = compare str str_
    compareSame x y = error "BNFC error:" compareSame
