-- Haskel data types for the abstract syntax. -- Generated by the BNF converter. {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} -- | The abstract syntax of language Cpp. module AbsCpp where import qualified Prelude as T (Double, Integer, String) import qualified Prelude as C ( Eq , Ord , Show , Read , Functor , Foldable , Traversable , Int, Maybe(..) ) import Data.String type Program = Program' BNFC'Position data Program' a = PDefs a [Def' a] -- ^ Program ::= Def deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Def = Def' BNFC'Position data Def' a = DFun a (Type' a) Id [Arg' a] [Stm' a] -- ^ Def ::= Type Id "(" Arg ")" "{" Stm "}" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Arg = Arg' BNFC'Position data Arg' a = ADecl a (Type' a) Id -- ^ Arg ::= Type Id deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Stm = Stm' BNFC'Position data Stm' a = SBlock a [Stm' a] -- ^ Stm ::= "{" Stm "}" | SDecls a (Type' a) [Id] -- ^ Stm ::= Type Id ";" | SExp a (Exp' a) -- ^ Stm ::= Exp ";" | SIfElse a (Exp' a) (Stm' a) (Stm' a) -- ^ Stm ::= "if" "(" Exp ")" Stm "else" Stm | SInit a (Type' a) Id (Exp' a) -- ^ Stm ::= Type Id "=" Exp ";" | SReturn a (Exp' a) -- ^ Stm ::= "return" Exp ";" | SReturnVoid a -- ^ Stm ::= "return" ";" | SWhile a (Exp' a) (Stm' a) -- ^ Stm ::= "while" "(" Exp ")" Stm deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Exp = Exp' BNFC'Position data Exp' a = EAnd a (Exp' a) (Exp' a) -- ^ Exp ::= Exp4 "&&" Exp5 | EApp a Id [Exp' a] -- ^ Exp ::= Id "(" Exp ")" | EAss a (Exp' a) (Exp' a) -- ^ Exp ::= Exp3 "=" Exp2 | EDecr a (Exp' a) -- ^ Exp ::= "--" Exp14 | EDiv a (Exp' a) (Exp' a) -- ^ Exp ::= Exp12 "/" Exp13 | EDouble a T.Double -- ^ Exp ::= Double | EEq a (Exp' a) (Exp' a) -- ^ Exp ::= Exp8 "==" Exp9 | EFalse a -- ^ Exp ::= "false" | EGt a (Exp' a) (Exp' a) -- ^ Exp ::= Exp9 ">" Exp10 | EGtEq a (Exp' a) (Exp' a) -- ^ Exp ::= Exp9 ">=" Exp10 | EId a Id -- ^ Exp ::= Id | EIncr a (Exp' a) -- ^ Exp ::= "++" Exp14 | EInt a T.Integer -- ^ Exp ::= Integer | ELt a (Exp' a) (Exp' a) -- ^ Exp ::= Exp9 "<" Exp10 | ELtEq a (Exp' a) (Exp' a) -- ^ Exp ::= Exp9 "<=" Exp10 | EMinus a (Exp' a) (Exp' a) -- ^ Exp ::= Exp11 "-" Exp12 | ENEq a (Exp' a) (Exp' a) -- ^ Exp ::= Exp8 "!=" Exp9 | EOr a (Exp' a) (Exp' a) -- ^ Exp ::= Exp3 "||" Exp4 | EPDecr a (Exp' a) -- ^ Exp ::= Exp15 "--" | EPIncr a (Exp' a) -- ^ Exp ::= Exp15 "++" | EPlus a (Exp' a) (Exp' a) -- ^ Exp ::= Exp11 "+" Exp12 | EString a T.String -- ^ Exp ::= String | ETimes a (Exp' a) (Exp' a) -- ^ Exp ::= Exp12 "*" Exp13 | ETrue a -- ^ Exp ::= "true" | ETyped a (Exp' a) (Type' a) -- ^ Exp ::= "(" Exp ":" Type ")" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Type = Type' BNFC'Position data Type' a = Type_bool a -- ^ Type ::= "bool" | Type_double a -- ^ Type ::= "double" | Type_int a -- ^ Type ::= "int" | Type_string a -- ^ Type ::= "string" | Type_void a -- ^ Type ::= "void" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) newtype Id = Id T.String deriving (C.Eq, C.Ord, C.Show, C.Read, Data.String.IsString) -- | Start position (line, column) of something. type BNFC'Position = C.Maybe (C.Int, C.Int) pattern BNFC'NoPosition :: BNFC'Position pattern BNFC'NoPosition = C.Nothing pattern BNFC'Position :: C.Int -> C.Int -> BNFC'Position pattern BNFC'Position line col = C.Just (line, col) -- | Get the start position of something. class HasPosition a where hasPosition :: a -> BNFC'Position instance HasPosition Program where hasPosition = \case PDefs p _ -> p instance HasPosition Def where hasPosition = \case DFun p _ _ _ _ -> p instance HasPosition Arg where hasPosition = \case ADecl p _ _ -> p instance HasPosition Stm where hasPosition = \case SBlock p _ -> p SDecls p _ _ -> p SExp p _ -> p SIfElse p _ _ _ -> p SInit p _ _ _ -> p SReturn p _ -> p SReturnVoid p -> p SWhile p _ _ -> p instance HasPosition Exp where hasPosition = \case EAnd p _ _ -> p EApp p _ _ -> p EAss p _ _ -> p EDecr p _ -> p EDiv p _ _ -> p EDouble p _ -> p EEq p _ _ -> p EFalse p -> p EGt p _ _ -> p EGtEq p _ _ -> p EId p _ -> p EIncr p _ -> p EInt p _ -> p ELt p _ _ -> p ELtEq p _ _ -> p EMinus p _ _ -> p ENEq p _ _ -> p EOr p _ _ -> p EPDecr p _ -> p EPIncr p _ -> p EPlus p _ _ -> p EString p _ -> p ETimes p _ _ -> p ETrue p -> p ETyped p _ _ -> p instance HasPosition Type where hasPosition = \case Type_bool p -> p Type_double p -> p Type_int p -> p Type_string p -> p Type_void p -> p