-- 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 AbsC4 ( Tree(..)
, Progr
, Dec
, Stm
, Exp
, Op
, Typ
, Ident
, johnMajorEq
, module ComposOpC4 ) where

import Prelude ((.), (>), (&&), (==))
import Prelude ((.), (>), (&&), (==))
import qualified Prelude as P

import ComposOpC4

data Tag = Progr_ | Dec_ | Stm_ | Exp_ | Op_ | Typ_ | Ident_
type Progr = Tree 'Progr_
type Dec = Tree 'Dec_
type Stm = Tree 'Stm_
type Exp = Tree 'Exp_
type Op = Tree 'Op_
type Typ = Tree 'Typ_
type Ident = Tree 'Ident_

data Tree (a :: Tag) where
  Program :: [Dec] -> [Stm] -> Tree 'Progr_
  Decl :: Typ -> [Ident] -> Tree 'Dec_
  SAss :: Ident -> Exp -> Tree 'Stm_
  SAssT :: Typ -> Ident -> Exp -> Tree 'Stm_
  SBlock :: [Dec] -> [Stm] -> Tree 'Stm_
  SDec :: Dec -> Tree 'Stm_
  SDecr :: Ident -> Tree 'Stm_
  SIf :: Exp -> Stm -> Stm -> Tree 'Stm_
  SIncr :: Ident -> Tree 'Stm_
  SPrint :: Exp -> Tree 'Stm_
  SReturn :: Exp -> Tree 'Stm_
  SReturnT :: Typ -> Exp -> Tree 'Stm_
  SWhile :: Exp -> Stm -> Tree 'Stm_
  EChar :: P.Char -> Tree 'Exp_
  EDouble :: P.Double -> Tree 'Exp_
  EInt :: P.Integer -> Tree 'Exp_
  EOpA :: Exp -> Op -> Exp -> Tree 'Exp_
  EOpB :: Exp -> Op -> Exp -> Tree 'Exp_
  EOpC :: Exp -> Op -> Exp -> Tree 'Exp_
  EOpD :: Exp -> Op -> Exp -> Tree 'Exp_
  EOpE :: Exp -> Op -> Exp -> Tree 'Exp_
  EString :: P.String -> Tree 'Exp_
  EVar :: Ident -> Tree 'Exp_
  OAnd :: Tree 'Op_
  OEq :: Tree 'Op_
  OGt :: Tree 'Op_
  OLt :: Tree 'Op_
  OMinus :: Tree 'Op_
  OOr :: Tree 'Op_
  OPlus :: Tree 'Op_
  OTimes :: Tree 'Op_
  TDouble :: Tree 'Typ_
  TInt :: Tree 'Typ_
  Ident ::P.String -> Tree 'Ident_

instance Compos Tree where
  compos r a f = \case
    Program decs stms -> r Program `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) decs `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) stms
    Decl typ idents -> r Decl `a` f typ `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents
    SAss x exp -> r SAss `a` f x `a` f exp
    SAssT typ x exp -> r SAssT `a` f typ `a` f x `a` f exp
    SBlock decs stms -> r SBlock `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) decs `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) stms
    SDec dec -> r SDec `a` f dec
    SDecr x -> r SDecr `a` f x
    SIf exp stm1 stm2 -> r SIf `a` f exp `a` f stm1 `a` f stm2
    SIncr x -> r SIncr `a` f x
    SPrint exp -> r SPrint `a` f exp
    SReturn exp -> r SReturn `a` f exp
    SReturnT typ exp -> r SReturnT `a` f typ `a` f exp
    SWhile exp stm -> r SWhile `a` f exp `a` f stm
    EOpA exp1 op exp2 -> r EOpA `a` f exp1 `a` f op `a` f exp2
    EOpB exp1 op exp2 -> r EOpB `a` f exp1 `a` f op `a` f exp2
    EOpC exp1 op exp2 -> r EOpC `a` f exp1 `a` f op `a` f exp2
    EOpD exp1 op exp2 -> r EOpD `a` f exp1 `a` f op `a` f exp2
    EOpE exp1 op exp2 -> r EOpE `a` f exp1 `a` f op `a` f exp2
    EVar x -> r EVar `a` f x
    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
    Program decs stms -> opar . P.showString "Program" . P.showChar ' ' . P.showsPrec 1 decs . P.showChar ' ' . P.showsPrec 1 stms . cpar
    Decl typ idents -> opar . P.showString "Decl" . P.showChar ' ' . P.showsPrec 1 typ . P.showChar ' ' . P.showsPrec 1 idents . cpar
    SAss x exp -> opar . P.showString "SAss" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 exp . cpar
    SAssT typ x exp -> opar . P.showString "SAssT" . P.showChar ' ' . P.showsPrec 1 typ . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 exp . cpar
    SBlock decs stms -> opar . P.showString "SBlock" . P.showChar ' ' . P.showsPrec 1 decs . P.showChar ' ' . P.showsPrec 1 stms . cpar
    SDec dec -> opar . P.showString "SDec" . P.showChar ' ' . P.showsPrec 1 dec . cpar
    SDecr x -> opar . P.showString "SDecr" . P.showChar ' ' . P.showsPrec 1 x . cpar
    SIf exp stm1 stm2 -> opar . P.showString "SIf" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm1 . P.showChar ' ' . P.showsPrec 1 stm2 . cpar
    SIncr x -> opar . P.showString "SIncr" . P.showChar ' ' . P.showsPrec 1 x . cpar
    SPrint exp -> opar . P.showString "SPrint" . P.showChar ' ' . P.showsPrec 1 exp . cpar
    SReturn exp -> opar . P.showString "SReturn" . P.showChar ' ' . P.showsPrec 1 exp . cpar
    SReturnT typ exp -> opar . P.showString "SReturnT" . P.showChar ' ' . P.showsPrec 1 typ . P.showChar ' ' . P.showsPrec 1 exp . cpar
    SWhile exp stm -> opar . P.showString "SWhile" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 stm . cpar
    EChar c -> opar . P.showString "EChar" . P.showChar ' ' . P.showsPrec 1 c . cpar
    EDouble d -> opar . P.showString "EDouble" . P.showChar ' ' . P.showsPrec 1 d . cpar
    EInt n -> opar . P.showString "EInt" . P.showChar ' ' . P.showsPrec 1 n . cpar
    EOpA exp1 op exp2 -> opar . P.showString "EOpA" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 op . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    EOpB exp1 op exp2 -> opar . P.showString "EOpB" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 op . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    EOpC exp1 op exp2 -> opar . P.showString "EOpC" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 op . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    EOpD exp1 op exp2 -> opar . P.showString "EOpD" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 op . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    EOpE exp1 op exp2 -> opar . P.showString "EOpE" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 op . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    EString str -> opar . P.showString "EString" . P.showChar ' ' . P.showsPrec 1 str . cpar
    EVar x -> opar . P.showString "EVar" . P.showChar ' ' . P.showsPrec 1 x . cpar
    OAnd -> P.showString "OAnd"
    OEq -> P.showString "OEq"
    OGt -> P.showString "OGt"
    OLt -> P.showString "OLt"
    OMinus -> P.showString "OMinus"
    OOr -> P.showString "OOr"
    OPlus -> P.showString "OPlus"
    OTimes -> P.showString "OTimes"
    TDouble -> P.showString "TDouble"
    TInt -> P.showString "TInt"
    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 (Program _ _) = 1
index (Decl _ _) = 2
index (SAss _ _) = 3
index (SAssT _ _ _) = 4
index (SBlock _ _) = 5
index (SDec _) = 6
index (SDecr _) = 7
index (SIf _ _ _) = 8
index (SIncr _) = 9
index (SPrint _) = 10
index (SReturn _) = 11
index (SReturnT _ _) = 12
index (SWhile _ _) = 13
index (EChar _) = 14
index (EDouble _) = 15
index (EInt _) = 16
index (EOpA _ _ _) = 17
index (EOpB _ _ _) = 18
index (EOpC _ _ _) = 19
index (EOpD _ _ _) = 20
index (EOpE _ _ _) = 21
index (EString _) = 22
index (EVar _) = 23
index (OAnd ) = 24
index (OEq ) = 25
index (OGt ) = 26
index (OLt ) = 27
index (OMinus ) = 28
index (OOr ) = 29
index (OPlus ) = 30
index (OTimes ) = 31
index (TDouble ) = 32
index (TInt ) = 33
index (Ident _) = 34

johnMajorEq :: Tree a -> Tree b -> P.Bool
johnMajorEq (Program decs stms) (Program decs_ stms_) = decs == decs_ && stms == stms_
johnMajorEq (Decl typ idents) (Decl typ_ idents_) = typ == typ_ && idents == idents_
johnMajorEq (SAss x exp) (SAss x_ exp_) = x == x_ && exp == exp_
johnMajorEq (SAssT typ x exp) (SAssT typ_ x_ exp_) = typ == typ_ && x == x_ && exp == exp_
johnMajorEq (SBlock decs stms) (SBlock decs_ stms_) = decs == decs_ && stms == stms_
johnMajorEq (SDec dec) (SDec dec_) = dec == dec_
johnMajorEq (SDecr x) (SDecr x_) = x == x_
johnMajorEq (SIf exp stm1 stm2) (SIf exp_ stm1_ stm2_) = exp == exp_ && stm1 == stm1_ && stm2 == stm2_
johnMajorEq (SIncr x) (SIncr x_) = x == x_
johnMajorEq (SPrint exp) (SPrint exp_) = exp == exp_
johnMajorEq (SReturn exp) (SReturn exp_) = exp == exp_
johnMajorEq (SReturnT typ exp) (SReturnT typ_ exp_) = typ == typ_ && exp == exp_
johnMajorEq (SWhile exp stm) (SWhile exp_ stm_) = exp == exp_ && stm == stm_
johnMajorEq (EChar c) (EChar c_) = c == c_
johnMajorEq (EDouble d) (EDouble d_) = d == d_
johnMajorEq (EInt n) (EInt n_) = n == n_
johnMajorEq (EOpA exp1 op exp2) (EOpA exp1_ op_ exp2_) = exp1 == exp1_ && op == op_ && exp2 == exp2_
johnMajorEq (EOpB exp1 op exp2) (EOpB exp1_ op_ exp2_) = exp1 == exp1_ && op == op_ && exp2 == exp2_
johnMajorEq (EOpC exp1 op exp2) (EOpC exp1_ op_ exp2_) = exp1 == exp1_ && op == op_ && exp2 == exp2_
johnMajorEq (EOpD exp1 op exp2) (EOpD exp1_ op_ exp2_) = exp1 == exp1_ && op == op_ && exp2 == exp2_
johnMajorEq (EOpE exp1 op exp2) (EOpE exp1_ op_ exp2_) = exp1 == exp1_ && op == op_ && exp2 == exp2_
johnMajorEq (EString str) (EString str_) = str == str_
johnMajorEq (EVar x) (EVar x_) = x == x_
johnMajorEq OAnd OAnd = P.True
johnMajorEq OEq OEq = P.True
johnMajorEq OGt OGt = P.True
johnMajorEq OLt OLt = P.True
johnMajorEq OMinus OMinus = P.True
johnMajorEq OOr OOr = P.True
johnMajorEq OPlus OPlus = P.True
johnMajorEq OTimes OTimes = P.True
johnMajorEq TDouble TDouble = P.True
johnMajorEq TInt TInt = P.True
johnMajorEq (Ident str) (Ident str_) = str == str_
johnMajorEq _ _ = P.False

compareSame :: Tree c -> Tree c -> P.Ordering
compareSame (Program decs stms) (Program decs_ stms_) = P.mappend (P.compare decs decs_) (P.compare stms stms_)
compareSame (Decl typ idents) (Decl typ_ idents_) = P.mappend (P.compare typ typ_) (P.compare idents idents_)
compareSame (SAss x exp) (SAss x_ exp_) = P.mappend (P.compare x x_) (P.compare exp exp_)
compareSame (SAssT typ x exp) (SAssT typ_ x_ exp_) = P.mappend (P.compare typ typ_) (P.mappend (P.compare x x_) (P.compare exp exp_))
compareSame (SBlock decs stms) (SBlock decs_ stms_) = P.mappend (P.compare decs decs_) (P.compare stms stms_)
compareSame (SDec dec) (SDec dec_) = P.compare dec dec_
compareSame (SDecr x) (SDecr x_) = P.compare x x_
compareSame (SIf exp stm1 stm2) (SIf exp_ stm1_ stm2_) = P.mappend (P.compare exp exp_) (P.mappend (P.compare stm1 stm1_) (P.compare stm2 stm2_))
compareSame (SIncr x) (SIncr x_) = P.compare x x_
compareSame (SPrint exp) (SPrint exp_) = P.compare exp exp_
compareSame (SReturn exp) (SReturn exp_) = P.compare exp exp_
compareSame (SReturnT typ exp) (SReturnT typ_ exp_) = P.mappend (P.compare typ typ_) (P.compare exp exp_)
compareSame (SWhile exp stm) (SWhile exp_ stm_) = P.mappend (P.compare exp exp_) (P.compare stm stm_)
compareSame (EChar c) (EChar c_) = P.compare c c_
compareSame (EDouble d) (EDouble d_) = P.compare d d_
compareSame (EInt n) (EInt n_) = P.compare n n_
compareSame (EOpA exp1 op exp2) (EOpA exp1_ op_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare op op_) (P.compare exp2 exp2_))
compareSame (EOpB exp1 op exp2) (EOpB exp1_ op_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare op op_) (P.compare exp2 exp2_))
compareSame (EOpC exp1 op exp2) (EOpC exp1_ op_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare op op_) (P.compare exp2 exp2_))
compareSame (EOpD exp1 op exp2) (EOpD exp1_ op_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare op op_) (P.compare exp2 exp2_))
compareSame (EOpE exp1 op exp2) (EOpE exp1_ op_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare op op_) (P.compare exp2 exp2_))
compareSame (EString str) (EString str_) = P.compare str str_
compareSame (EVar x) (EVar x_) = P.compare x x_
compareSame OAnd OAnd = P.EQ
compareSame OEq OEq = P.EQ
compareSame OGt OGt = P.EQ
compareSame OLt OLt = P.EQ
compareSame OMinus OMinus = P.EQ
compareSame OOr OOr = P.EQ
compareSame OPlus OPlus = P.EQ
compareSame OTimes OTimes = P.EQ
compareSame TDouble TDouble = P.EQ
compareSame TInt TInt = P.EQ
compareSame (Ident str) (Ident str_) = P.compare str str_
compareSame _ _ = P.error "BNFC error: compareSame"