-- 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 JavaletteLight. module AbsJavaletteLight 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 Prog = Prog' BNFC'Position data Prog' a = Fun a (Typ' a) Ident [Stm' a] -- ^ Prog ::= Typ Ident "(" ")" "{" Stm "}" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Stm = Stm' BNFC'Position data Stm' a = SAss a Ident (Exp' a) -- ^ Stm ::= Ident "=" Exp ";" | SDecl a (Typ' a) Ident -- ^ Stm ::= Typ Ident ";" | SIncr a Ident -- ^ Stm ::= Ident "++" ";" | 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 = EDouble a T.Double -- ^ Exp ::= Double | EInt a T.Integer -- ^ Exp ::= Integer | ELt a (Exp' a) (Exp' a) -- ^ Exp ::= Exp1 "<" Exp1 | EPlus a (Exp' a) (Exp' a) -- ^ Exp ::= Exp1 "+" Exp2 | ETimes a (Exp' a) (Exp' a) -- ^ Exp ::= Exp2 "*" Exp3 | EVar a Ident -- ^ Exp ::= Ident | ExpT a (Typ' a) (Exp' a) -- ^ Exp ::= Typ "(" Exp ")" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Typ = Typ' BNFC'Position data Typ' a = TDouble a -- ^ Typ ::= "double" | TInt a -- ^ Typ ::= "int" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) newtype Ident = Ident 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 Prog where hasPosition = \case Fun p _ _ _ -> p instance HasPosition Stm where hasPosition = \case SAss p _ _ -> p SDecl p _ _ -> p SIncr p _ -> p SWhile p _ _ -> p instance HasPosition Exp where hasPosition = \case EDouble p _ -> p EInt p _ -> p ELt p _ _ -> p EPlus p _ _ -> p ETimes p _ _ -> p EVar p _ -> p ExpT p _ _ -> p instance HasPosition Typ where hasPosition = \case TDouble p -> p TInt p -> p