-- 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"