forked from GitHub/gf-core
474 lines
28 KiB
Haskell
474 lines
28 KiB
Haskell
{-# OPTIONS_GHC -fglasgow-exts #-}
|
|
module Transfer.Syntax.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 Import_
|
|
type Import = Tree Import_
|
|
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 Exp_
|
|
type Exp = Tree Exp_
|
|
data LetDef_
|
|
type LetDef = Tree LetDef_
|
|
data Case_
|
|
type Case = Tree Case_
|
|
data Bind_
|
|
type Bind = Tree Bind_
|
|
data VarOrWild_
|
|
type VarOrWild = Tree VarOrWild_
|
|
data FieldType_
|
|
type FieldType = Tree FieldType_
|
|
data FieldValue_
|
|
type FieldValue = Tree FieldValue_
|
|
data Ident_
|
|
type Ident = Tree Ident_
|
|
|
|
data Tree :: * -> * where
|
|
Module :: [Import] -> [Decl] -> Tree Module_
|
|
Import :: Ident -> Tree Import_
|
|
DataDecl :: Ident -> Exp -> [ConsDecl] -> Tree Decl_
|
|
TypeDecl :: Ident -> Exp -> Tree Decl_
|
|
ValueDecl :: Ident -> [Pattern] -> Exp -> Tree Decl_
|
|
DeriveDecl :: Ident -> Ident -> Tree Decl_
|
|
ConsDecl :: Ident -> Exp -> Tree ConsDecl_
|
|
POr :: Pattern -> Pattern -> Tree Pattern_
|
|
PConsTop :: Ident -> Pattern -> [Pattern] -> Tree Pattern_
|
|
PCons :: Ident -> [Pattern] -> Tree Pattern_
|
|
PRec :: [FieldPattern] -> Tree Pattern_
|
|
PType :: Tree Pattern_
|
|
PStr :: String -> Tree Pattern_
|
|
PInt :: Integer -> Tree Pattern_
|
|
PVar :: Ident -> Tree Pattern_
|
|
PWild :: Tree Pattern_
|
|
FieldPattern :: Ident -> Pattern -> Tree FieldPattern_
|
|
ELet :: [LetDef] -> Exp -> Tree Exp_
|
|
ECase :: Exp -> [Case] -> Tree Exp_
|
|
EIf :: Exp -> Exp -> Exp -> Tree Exp_
|
|
EDo :: [Bind] -> Exp -> Tree Exp_
|
|
EAbs :: VarOrWild -> Exp -> Tree Exp_
|
|
EPi :: VarOrWild -> Exp -> Exp -> Tree Exp_
|
|
EPiNoVar :: Exp -> Exp -> Tree Exp_
|
|
EBind :: Exp -> Exp -> Tree Exp_
|
|
EBindC :: Exp -> Exp -> Tree Exp_
|
|
EOr :: Exp -> Exp -> Tree Exp_
|
|
EAnd :: Exp -> Exp -> Tree Exp_
|
|
EEq :: Exp -> Exp -> Tree Exp_
|
|
ENe :: Exp -> Exp -> Tree Exp_
|
|
ELt :: Exp -> Exp -> Tree Exp_
|
|
ELe :: Exp -> Exp -> Tree Exp_
|
|
EGt :: Exp -> Exp -> Tree Exp_
|
|
EGe :: Exp -> Exp -> Tree Exp_
|
|
EListCons :: Exp -> Exp -> Tree Exp_
|
|
EAdd :: Exp -> Exp -> Tree Exp_
|
|
ESub :: Exp -> Exp -> Tree Exp_
|
|
EMul :: Exp -> Exp -> Tree Exp_
|
|
EDiv :: Exp -> Exp -> Tree Exp_
|
|
EMod :: Exp -> Exp -> Tree Exp_
|
|
ENeg :: Exp -> Tree Exp_
|
|
EApp :: Exp -> Exp -> Tree Exp_
|
|
EProj :: Exp -> Ident -> Tree Exp_
|
|
ERecType :: [FieldType] -> Tree Exp_
|
|
ERec :: [FieldValue] -> Tree Exp_
|
|
EList :: [Exp] -> Tree Exp_
|
|
EVar :: Ident -> Tree Exp_
|
|
EType :: Tree Exp_
|
|
EStr :: String -> Tree Exp_
|
|
EInt :: Integer -> Tree Exp_
|
|
EMeta :: Tree Exp_
|
|
LetDef :: Ident -> Exp -> Exp -> Tree LetDef_
|
|
Case :: Pattern -> Exp -> Tree Case_
|
|
BindVar :: VarOrWild -> Exp -> Tree Bind_
|
|
BindNoVar :: Exp -> Tree Bind_
|
|
VVar :: Ident -> Tree VarOrWild_
|
|
VWild :: Tree VarOrWild_
|
|
FieldType :: Ident -> Exp -> Tree FieldType_
|
|
FieldValue :: Ident -> Exp -> Tree FieldValue_
|
|
Ident :: String -> Tree Ident_
|
|
|
|
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 imports decls -> return Module `ap` mapM f imports `ap` mapM f decls
|
|
Import i -> return Import `ap` f i
|
|
DataDecl i exp consdecls -> return DataDecl `ap` f i `ap` f exp `ap` mapM f consdecls
|
|
TypeDecl i exp -> return TypeDecl `ap` f i `ap` f exp
|
|
ValueDecl i patterns exp -> return ValueDecl `ap` f i `ap` mapM f patterns `ap` f exp
|
|
DeriveDecl i0 i1 -> return DeriveDecl `ap` f i0 `ap` f i1
|
|
ConsDecl i exp -> return ConsDecl `ap` f i `ap` f exp
|
|
POr pattern0 pattern1 -> return POr `ap` f pattern0 `ap` f pattern1
|
|
PConsTop i pattern patterns -> return PConsTop `ap` f i `ap` f pattern `ap` mapM f patterns
|
|
PCons i patterns -> return PCons `ap` f i `ap` mapM f patterns
|
|
PRec fieldpatterns -> return PRec `ap` mapM f fieldpatterns
|
|
PVar i -> return PVar `ap` f i
|
|
FieldPattern i pattern -> return FieldPattern `ap` f i `ap` f pattern
|
|
ELet letdefs exp -> return ELet `ap` mapM f letdefs `ap` f exp
|
|
ECase exp cases -> return ECase `ap` f exp `ap` mapM f cases
|
|
EIf exp0 exp1 exp2 -> return EIf `ap` f exp0 `ap` f exp1 `ap` f exp2
|
|
EDo binds exp -> return EDo `ap` mapM f binds `ap` f exp
|
|
EAbs varorwild exp -> return EAbs `ap` f varorwild `ap` f exp
|
|
EPi varorwild exp0 exp1 -> return EPi `ap` f varorwild `ap` f exp0 `ap` f exp1
|
|
EPiNoVar exp0 exp1 -> return EPiNoVar `ap` f exp0 `ap` f exp1
|
|
EBind exp0 exp1 -> return EBind `ap` f exp0 `ap` f exp1
|
|
EBindC exp0 exp1 -> return EBindC `ap` f exp0 `ap` f exp1
|
|
EOr exp0 exp1 -> return EOr `ap` f exp0 `ap` f exp1
|
|
EAnd exp0 exp1 -> return EAnd `ap` f exp0 `ap` f exp1
|
|
EEq exp0 exp1 -> return EEq `ap` f exp0 `ap` f exp1
|
|
ENe exp0 exp1 -> return ENe `ap` f exp0 `ap` f exp1
|
|
ELt exp0 exp1 -> return ELt `ap` f exp0 `ap` f exp1
|
|
ELe exp0 exp1 -> return ELe `ap` f exp0 `ap` f exp1
|
|
EGt exp0 exp1 -> return EGt `ap` f exp0 `ap` f exp1
|
|
EGe exp0 exp1 -> return EGe `ap` f exp0 `ap` f exp1
|
|
EListCons exp0 exp1 -> return EListCons `ap` f exp0 `ap` f exp1
|
|
EAdd exp0 exp1 -> return EAdd `ap` f exp0 `ap` f exp1
|
|
ESub exp0 exp1 -> return ESub `ap` f exp0 `ap` f exp1
|
|
EMul exp0 exp1 -> return EMul `ap` f exp0 `ap` f exp1
|
|
EDiv exp0 exp1 -> return EDiv `ap` f exp0 `ap` f exp1
|
|
EMod exp0 exp1 -> return EMod `ap` f exp0 `ap` f exp1
|
|
ENeg exp -> return ENeg `ap` f exp
|
|
EApp exp0 exp1 -> return EApp `ap` f exp0 `ap` f exp1
|
|
EProj exp i -> return EProj `ap` f exp `ap` f i
|
|
ERecType fieldtypes -> return ERecType `ap` mapM f fieldtypes
|
|
ERec fieldvalues -> return ERec `ap` mapM f fieldvalues
|
|
EList exps -> return EList `ap` mapM f exps
|
|
EVar i -> return EVar `ap` f i
|
|
LetDef i exp0 exp1 -> return LetDef `ap` f i `ap` f exp0 `ap` f exp1
|
|
Case pattern exp -> return Case `ap` f pattern `ap` f exp
|
|
BindVar varorwild exp -> return BindVar `ap` f varorwild `ap` f exp
|
|
BindNoVar exp -> return BindNoVar `ap` f exp
|
|
VVar i -> return VVar `ap` f i
|
|
FieldType i exp -> return FieldType `ap` f i `ap` f exp
|
|
FieldValue i exp -> return FieldValue `ap` f i `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 imports decls -> foldr combine zero (map f imports) `combine` foldr combine zero (map f decls)
|
|
Import i -> f i
|
|
DataDecl i exp consdecls -> f i `combine` f exp `combine` foldr combine zero (map f consdecls)
|
|
TypeDecl i exp -> f i `combine` f exp
|
|
ValueDecl i patterns exp -> f i `combine` foldr combine zero (map f patterns) `combine` f exp
|
|
DeriveDecl i0 i1 -> f i0 `combine` f i1
|
|
ConsDecl i exp -> f i `combine` f exp
|
|
POr pattern0 pattern1 -> f pattern0 `combine` f pattern1
|
|
PConsTop i pattern patterns -> f i `combine` f pattern `combine` foldr combine zero (map f patterns)
|
|
PCons i patterns -> f i `combine` foldr combine zero (map f patterns)
|
|
PRec fieldpatterns -> foldr combine zero (map f fieldpatterns)
|
|
PVar i -> f i
|
|
FieldPattern i pattern -> f i `combine` f pattern
|
|
ELet letdefs exp -> foldr combine zero (map f letdefs) `combine` f exp
|
|
ECase exp cases -> f exp `combine` foldr combine zero (map f cases)
|
|
EIf exp0 exp1 exp2 -> f exp0 `combine` f exp1 `combine` f exp2
|
|
EDo binds exp -> foldr combine zero (map f binds) `combine` f exp
|
|
EAbs varorwild exp -> f varorwild `combine` f exp
|
|
EPi varorwild exp0 exp1 -> f varorwild `combine` f exp0 `combine` f exp1
|
|
EPiNoVar exp0 exp1 -> f exp0 `combine` f exp1
|
|
EBind exp0 exp1 -> f exp0 `combine` f exp1
|
|
EBindC exp0 exp1 -> f exp0 `combine` f exp1
|
|
EOr exp0 exp1 -> f exp0 `combine` f exp1
|
|
EAnd exp0 exp1 -> f exp0 `combine` f exp1
|
|
EEq exp0 exp1 -> f exp0 `combine` f exp1
|
|
ENe exp0 exp1 -> f exp0 `combine` f exp1
|
|
ELt exp0 exp1 -> f exp0 `combine` f exp1
|
|
ELe exp0 exp1 -> f exp0 `combine` f exp1
|
|
EGt exp0 exp1 -> f exp0 `combine` f exp1
|
|
EGe exp0 exp1 -> f exp0 `combine` f exp1
|
|
EListCons exp0 exp1 -> f exp0 `combine` f exp1
|
|
EAdd exp0 exp1 -> f exp0 `combine` f exp1
|
|
ESub exp0 exp1 -> f exp0 `combine` f exp1
|
|
EMul exp0 exp1 -> f exp0 `combine` f exp1
|
|
EDiv exp0 exp1 -> f exp0 `combine` f exp1
|
|
EMod exp0 exp1 -> f exp0 `combine` f exp1
|
|
ENeg exp -> f exp
|
|
EApp exp0 exp1 -> f exp0 `combine` f exp1
|
|
EProj exp i -> f exp `combine` f i
|
|
ERecType fieldtypes -> foldr combine zero (map f fieldtypes)
|
|
ERec fieldvalues -> foldr combine zero (map f fieldvalues)
|
|
EList exps -> foldr combine zero (map f exps)
|
|
EVar i -> f i
|
|
LetDef i exp0 exp1 -> f i `combine` f exp0 `combine` f exp1
|
|
Case pattern exp -> f pattern `combine` f exp
|
|
BindVar varorwild exp -> f varorwild `combine` f exp
|
|
BindNoVar exp -> f exp
|
|
VVar i -> f i
|
|
FieldType i exp -> f i `combine` f exp
|
|
FieldValue i exp -> f i `combine` f exp
|
|
_ -> zero
|
|
|
|
instance Show (Tree c) where
|
|
showsPrec n t = case t of
|
|
Module imports decls -> opar n . showString "Module" . showChar ' ' . showsPrec 1 imports . showChar ' ' . showsPrec 1 decls . cpar n
|
|
Import i -> opar n . showString "Import" . showChar ' ' . showsPrec 1 i . cpar n
|
|
DataDecl i exp consdecls -> opar n . showString "DataDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 consdecls . cpar n
|
|
TypeDecl i exp -> opar n . showString "TypeDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
|
ValueDecl i patterns exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . showChar ' ' . showsPrec 1 exp . cpar n
|
|
DeriveDecl i0 i1 -> opar n . showString "DeriveDecl" . showChar ' ' . showsPrec 1 i0 . showChar ' ' . showsPrec 1 i1 . cpar n
|
|
ConsDecl i exp -> opar n . showString "ConsDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
|
POr pattern0 pattern1 -> opar n . showString "POr" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n
|
|
PConsTop i pattern patterns -> opar n . showString "PConsTop" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 patterns . cpar n
|
|
PCons i patterns -> opar n . showString "PCons" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . 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
|
|
PVar i -> opar n . showString "PVar" . showChar ' ' . showsPrec 1 i . cpar n
|
|
PWild -> showString "PWild"
|
|
FieldPattern i pattern -> opar n . showString "FieldPattern" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . cpar n
|
|
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
|
|
EIf exp0 exp1 exp2 -> opar n . showString "EIf" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . showChar ' ' . showsPrec 1 exp2 . cpar n
|
|
EDo binds exp -> opar n . showString "EDo" . showChar ' ' . showsPrec 1 binds . showChar ' ' . showsPrec 1 exp . cpar n
|
|
EAbs varorwild exp -> opar n . showString "EAbs" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
|
|
EPi varorwild exp0 exp1 -> opar n . showString "EPi" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EPiNoVar exp0 exp1 -> opar n . showString "EPiNoVar" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EBind exp0 exp1 -> opar n . showString "EBind" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EBindC exp0 exp1 -> opar n . showString "EBindC" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EOr exp0 exp1 -> opar n . showString "EOr" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EAnd exp0 exp1 -> opar n . showString "EAnd" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EEq exp0 exp1 -> opar n . showString "EEq" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
ENe exp0 exp1 -> opar n . showString "ENe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
ELt exp0 exp1 -> opar n . showString "ELt" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
ELe exp0 exp1 -> opar n . showString "ELe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EGt exp0 exp1 -> opar n . showString "EGt" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EGe exp0 exp1 -> opar n . showString "EGe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EListCons exp0 exp1 -> opar n . showString "EListCons" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EAdd exp0 exp1 -> opar n . showString "EAdd" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
ESub exp0 exp1 -> opar n . showString "ESub" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EMul exp0 exp1 -> opar n . showString "EMul" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EDiv exp0 exp1 -> opar n . showString "EDiv" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EMod exp0 exp1 -> opar n . showString "EMod" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
ENeg exp -> opar n . showString "ENeg" . showChar ' ' . showsPrec 1 exp . cpar n
|
|
EApp exp0 exp1 -> opar n . showString "EApp" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
EProj exp i -> opar n . showString "EProj" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 i . 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
|
|
EList exps -> opar n . showString "EList" . showChar ' ' . showsPrec 1 exps . cpar n
|
|
EVar i -> opar n . showString "EVar" . showChar ' ' . showsPrec 1 i . cpar n
|
|
EType -> showString "EType"
|
|
EStr str -> opar n . showString "EStr" . showChar ' ' . showsPrec 1 str . cpar n
|
|
EInt n -> opar n . showString "EInt" . showChar ' ' . showsPrec 1 n . cpar n
|
|
EMeta -> showString "EMeta"
|
|
LetDef i exp0 exp1 -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
|
|
Case pattern exp -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 exp . cpar n
|
|
BindVar varorwild exp -> opar n . showString "BindVar" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
|
|
BindNoVar exp -> opar n . showString "BindNoVar" . showChar ' ' . showsPrec 1 exp . cpar n
|
|
VVar i -> opar n . showString "VVar" . showChar ' ' . showsPrec 1 i . cpar n
|
|
VWild -> showString "VWild"
|
|
FieldType i exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
|
FieldValue i exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
|
|
Ident str -> opar n . showString "Ident" . 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 imports decls) (Module imports_ decls_) = imports == imports_ && decls == decls_
|
|
johnMajorEq (Import i) (Import i_) = i == i_
|
|
johnMajorEq (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = i == i_ && exp == exp_ && consdecls == consdecls_
|
|
johnMajorEq (TypeDecl i exp) (TypeDecl i_ exp_) = i == i_ && exp == exp_
|
|
johnMajorEq (ValueDecl i patterns exp) (ValueDecl i_ patterns_ exp_) = i == i_ && patterns == patterns_ && exp == exp_
|
|
johnMajorEq (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = i0 == i0_ && i1 == i1_
|
|
johnMajorEq (ConsDecl i exp) (ConsDecl i_ exp_) = i == i_ && exp == exp_
|
|
johnMajorEq (POr pattern0 pattern1) (POr pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_
|
|
johnMajorEq (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = i == i_ && pattern == pattern_ && patterns == patterns_
|
|
johnMajorEq (PCons i patterns) (PCons i_ patterns_) = i == i_ && patterns == patterns_
|
|
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 (PVar i) (PVar i_) = i == i_
|
|
johnMajorEq PWild PWild = True
|
|
johnMajorEq (FieldPattern i pattern) (FieldPattern i_ pattern_) = i == i_ && pattern == pattern_
|
|
johnMajorEq (ELet letdefs exp) (ELet letdefs_ exp_) = letdefs == letdefs_ && exp == exp_
|
|
johnMajorEq (ECase exp cases) (ECase exp_ cases_) = exp == exp_ && cases == cases_
|
|
johnMajorEq (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = exp0 == exp0_ && exp1 == exp1_ && exp2 == exp2_
|
|
johnMajorEq (EDo binds exp) (EDo binds_ exp_) = binds == binds_ && exp == exp_
|
|
johnMajorEq (EAbs varorwild exp) (EAbs varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
|
|
johnMajorEq (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = varorwild == varorwild_ && exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EBind exp0 exp1) (EBind exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EBindC exp0 exp1) (EBindC exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EOr exp0 exp1) (EOr exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EAnd exp0 exp1) (EAnd exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EEq exp0 exp1) (EEq exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (ENe exp0 exp1) (ENe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (ELt exp0 exp1) (ELt exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (ELe exp0 exp1) (ELe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EGt exp0 exp1) (EGt exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EGe exp0 exp1) (EGe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EListCons exp0 exp1) (EListCons exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EAdd exp0 exp1) (EAdd exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (ESub exp0 exp1) (ESub exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EMul exp0 exp1) (EMul exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EDiv exp0 exp1) (EDiv exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EMod exp0 exp1) (EMod exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (ENeg exp) (ENeg exp_) = exp == exp_
|
|
johnMajorEq (EApp exp0 exp1) (EApp exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (EProj exp i) (EProj exp_ i_) = exp == exp_ && i == i_
|
|
johnMajorEq (ERecType fieldtypes) (ERecType fieldtypes_) = fieldtypes == fieldtypes_
|
|
johnMajorEq (ERec fieldvalues) (ERec fieldvalues_) = fieldvalues == fieldvalues_
|
|
johnMajorEq (EList exps) (EList exps_) = exps == exps_
|
|
johnMajorEq (EVar i) (EVar i_) = i == i_
|
|
johnMajorEq EType EType = True
|
|
johnMajorEq (EStr str) (EStr str_) = str == str_
|
|
johnMajorEq (EInt n) (EInt n_) = n == n_
|
|
johnMajorEq EMeta EMeta = True
|
|
johnMajorEq (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = i == i_ && exp0 == exp0_ && exp1 == exp1_
|
|
johnMajorEq (Case pattern exp) (Case pattern_ exp_) = pattern == pattern_ && exp == exp_
|
|
johnMajorEq (BindVar varorwild exp) (BindVar varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
|
|
johnMajorEq (BindNoVar exp) (BindNoVar exp_) = exp == exp_
|
|
johnMajorEq (VVar i) (VVar i_) = i == i_
|
|
johnMajorEq VWild VWild = True
|
|
johnMajorEq (FieldType i exp) (FieldType i_ exp_) = i == i_ && exp == exp_
|
|
johnMajorEq (FieldValue i exp) (FieldValue i_ exp_) = i == i_ && exp == exp_
|
|
johnMajorEq (Ident str) (Ident 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 (Import _) = 1
|
|
index (DataDecl _ _ _) = 2
|
|
index (TypeDecl _ _) = 3
|
|
index (ValueDecl _ _ _) = 4
|
|
index (DeriveDecl _ _) = 5
|
|
index (ConsDecl _ _) = 6
|
|
index (POr _ _) = 7
|
|
index (PConsTop _ _ _) = 8
|
|
index (PCons _ _) = 9
|
|
index (PRec _) = 10
|
|
index (PType ) = 11
|
|
index (PStr _) = 12
|
|
index (PInt _) = 13
|
|
index (PVar _) = 14
|
|
index (PWild ) = 15
|
|
index (FieldPattern _ _) = 16
|
|
index (ELet _ _) = 17
|
|
index (ECase _ _) = 18
|
|
index (EIf _ _ _) = 19
|
|
index (EDo _ _) = 20
|
|
index (EAbs _ _) = 21
|
|
index (EPi _ _ _) = 22
|
|
index (EPiNoVar _ _) = 23
|
|
index (EBind _ _) = 24
|
|
index (EBindC _ _) = 25
|
|
index (EOr _ _) = 26
|
|
index (EAnd _ _) = 27
|
|
index (EEq _ _) = 28
|
|
index (ENe _ _) = 29
|
|
index (ELt _ _) = 30
|
|
index (ELe _ _) = 31
|
|
index (EGt _ _) = 32
|
|
index (EGe _ _) = 33
|
|
index (EListCons _ _) = 34
|
|
index (EAdd _ _) = 35
|
|
index (ESub _ _) = 36
|
|
index (EMul _ _) = 37
|
|
index (EDiv _ _) = 38
|
|
index (EMod _ _) = 39
|
|
index (ENeg _) = 40
|
|
index (EApp _ _) = 41
|
|
index (EProj _ _) = 42
|
|
index (ERecType _) = 43
|
|
index (ERec _) = 44
|
|
index (EList _) = 45
|
|
index (EVar _) = 46
|
|
index (EType ) = 47
|
|
index (EStr _) = 48
|
|
index (EInt _) = 49
|
|
index (EMeta ) = 50
|
|
index (LetDef _ _ _) = 51
|
|
index (Case _ _) = 52
|
|
index (BindVar _ _) = 53
|
|
index (BindNoVar _) = 54
|
|
index (VVar _) = 55
|
|
index (VWild ) = 56
|
|
index (FieldType _ _) = 57
|
|
index (FieldValue _ _) = 58
|
|
index (Ident _) = 59
|
|
compareSame (Module imports decls) (Module imports_ decls_) = mappend (compare imports imports_) (compare decls decls_)
|
|
compareSame (Import i) (Import i_) = compare i i_
|
|
compareSame (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = mappend (compare i i_) (mappend (compare exp exp_) (compare consdecls consdecls_))
|
|
compareSame (TypeDecl i exp) (TypeDecl i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
|
compareSame (ValueDecl i patterns exp) (ValueDecl i_ patterns_ exp_) = mappend (compare i i_) (mappend (compare patterns patterns_) (compare exp exp_))
|
|
compareSame (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = mappend (compare i0 i0_) (compare i1 i1_)
|
|
compareSame (ConsDecl i exp) (ConsDecl i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
|
compareSame (POr pattern0 pattern1) (POr pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_)
|
|
compareSame (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = mappend (compare i i_) (mappend (compare pattern pattern_) (compare patterns patterns_))
|
|
compareSame (PCons i patterns) (PCons i_ patterns_) = mappend (compare i i_) (compare patterns patterns_)
|
|
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 (PVar i) (PVar i_) = compare i i_
|
|
compareSame PWild PWild = EQ
|
|
compareSame (FieldPattern i pattern) (FieldPattern i_ pattern_) = mappend (compare i i_) (compare pattern pattern_)
|
|
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 (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = mappend (compare exp0 exp0_) (mappend (compare exp1 exp1_) (compare exp2 exp2_))
|
|
compareSame (EDo binds exp) (EDo binds_ exp_) = mappend (compare binds binds_) (compare exp exp_)
|
|
compareSame (EAbs varorwild exp) (EAbs varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
|
|
compareSame (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = mappend (compare varorwild varorwild_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
|
|
compareSame (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EBind exp0 exp1) (EBind exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EBindC exp0 exp1) (EBindC exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EOr exp0 exp1) (EOr exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EAnd exp0 exp1) (EAnd exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EEq exp0 exp1) (EEq exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (ENe exp0 exp1) (ENe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (ELt exp0 exp1) (ELt exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (ELe exp0 exp1) (ELe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EGt exp0 exp1) (EGt exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EGe exp0 exp1) (EGe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EListCons exp0 exp1) (EListCons exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EAdd exp0 exp1) (EAdd exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (ESub exp0 exp1) (ESub exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EMul exp0 exp1) (EMul exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EDiv exp0 exp1) (EDiv exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EMod exp0 exp1) (EMod exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (ENeg exp) (ENeg exp_) = compare exp exp_
|
|
compareSame (EApp exp0 exp1) (EApp exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
|
|
compareSame (EProj exp i) (EProj exp_ i_) = mappend (compare exp exp_) (compare i i_)
|
|
compareSame (ERecType fieldtypes) (ERecType fieldtypes_) = compare fieldtypes fieldtypes_
|
|
compareSame (ERec fieldvalues) (ERec fieldvalues_) = compare fieldvalues fieldvalues_
|
|
compareSame (EList exps) (EList exps_) = compare exps exps_
|
|
compareSame (EVar i) (EVar i_) = compare i i_
|
|
compareSame EType EType = EQ
|
|
compareSame (EStr str) (EStr str_) = compare str str_
|
|
compareSame (EInt n) (EInt n_) = compare n n_
|
|
compareSame EMeta EMeta = EQ
|
|
compareSame (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = mappend (compare i i_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
|
|
compareSame (Case pattern exp) (Case pattern_ exp_) = mappend (compare pattern pattern_) (compare exp exp_)
|
|
compareSame (BindVar varorwild exp) (BindVar varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
|
|
compareSame (BindNoVar exp) (BindNoVar exp_) = compare exp exp_
|
|
compareSame (VVar i) (VVar i_) = compare i i_
|
|
compareSame VWild VWild = EQ
|
|
compareSame (FieldType i exp) (FieldType i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
|
compareSame (FieldValue i exp) (FieldValue i_ exp_) = mappend (compare i i_) (compare exp exp_)
|
|
compareSame (Ident str) (Ident str_) = compare str str_
|
|
compareSame x y = error "BNFC error:" compareSame
|