-- 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 AbsCalc (Tree(..), Exp, johnMajorEq, module ComposOpCalc) where

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

import ComposOpCalc

data Tag = Exp_
type Exp = Tree 'Exp_

data Tree (a :: Tag) where
  EAdd :: Exp -> Exp -> Tree 'Exp_
  EDiv :: Exp -> Exp -> Tree 'Exp_
  EInt :: P.Integer -> Tree 'Exp_
  EMul :: Exp -> Exp -> Tree 'Exp_
  ESub :: Exp -> Exp -> Tree 'Exp_


instance Compos Tree where
  compos r a f = \case
    EAdd exp1 exp2 -> r EAdd `a` f exp1 `a` f exp2
    EDiv exp1 exp2 -> r EDiv `a` f exp1 `a` f exp2
    EMul exp1 exp2 -> r EMul `a` f exp1 `a` f exp2
    ESub exp1 exp2 -> r ESub `a` f exp1 `a` f exp2
    t -> r t

instance P.Show (Tree c) where
  showsPrec n = \case
    
    EAdd exp1 exp2 -> opar . P.showString "EAdd" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    EDiv exp1 exp2 -> opar . P.showString "EDiv" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    EInt n -> opar . P.showString "EInt" . P.showChar ' ' . P.showsPrec 1 n . cpar
    EMul exp1 exp2 -> opar . P.showString "EMul" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    ESub exp1 exp2 -> opar . P.showString "ESub" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    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 (EAdd _ _) = 1
index (EDiv _ _) = 2
index (EInt _) = 3
index (EMul _ _) = 4
index (ESub _ _) = 5

johnMajorEq :: Tree a -> Tree b -> P.Bool
johnMajorEq (EAdd exp1 exp2) (EAdd exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (EDiv exp1 exp2) (EDiv exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (EInt n) (EInt n_) = n == n_
johnMajorEq (EMul exp1 exp2) (EMul exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (ESub exp1 exp2) (ESub exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_

johnMajorEq _ _ = P.False

compareSame :: Tree c -> Tree c -> P.Ordering
compareSame (EAdd exp1 exp2) (EAdd exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (EDiv exp1 exp2) (EDiv exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (EInt n) (EInt n_) = P.compare n n_
compareSame (EMul exp1 exp2) (EMul exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (ESub exp1 exp2) (ESub exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)

compareSame _ _ = P.error "BNFC error: compareSame"