-- 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 LBNF. module AbsLBNF where import qualified Prelude as T (Char, Integer, String) import qualified Prelude as C ( Eq , Ord , Show , Read , Functor , Foldable , Traversable , Int, Maybe(..) ) import Data.String type Grammar = Grammar' BNFC'Position data Grammar' a = MkGrammar a [Def' a] -- ^ Grammar ::= Def deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Def = Def' BNFC'Position data Def' a = Coercions a Ident T.Integer -- ^ Def ::= "coercions" Ident Integer | Comment a T.String -- ^ Def ::= "comment" String | Comments a T.String T.String -- ^ Def ::= "comment" String String | Entryp a [Ident] -- ^ Def ::= "entrypoints" Ident | Internal a (Label' a) (Cat' a) [Item' a] -- ^ Def ::= "internal" Label "." Cat "::=" Item | Layout a [T.String] -- ^ Def ::= "layout" String | LayoutStop a [T.String] -- ^ Def ::= "layout" "stop" String | LayoutTop a -- ^ Def ::= "layout" "toplevel" | PosToken a Ident (Reg' a) -- ^ Def ::= "position" "token" Ident Reg | Rule a (Label' a) (Cat' a) [Item' a] -- ^ Def ::= Label "." Cat "::=" Item | Rules a Ident [RHS' a] -- ^ Def ::= "rules" Ident "::=" RHS | Separator a (MinimumSize' a) (Cat' a) T.String -- ^ Def ::= "separator" MinimumSize Cat String | Terminator a (MinimumSize' a) (Cat' a) T.String -- ^ Def ::= "terminator" MinimumSize Cat String | Token a Ident (Reg' a) -- ^ Def ::= "token" Ident Reg deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Item = Item' BNFC'Position data Item' a = NTerminal a (Cat' a) -- ^ Item ::= Cat | Terminal a T.String -- ^ Item ::= String deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Cat = Cat' BNFC'Position data Cat' a = IdCat a Ident -- ^ Cat ::= Ident | ListCat a (Cat' a) -- ^ Cat ::= "[" Cat "]" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Label = Label' BNFC'Position data Label' a = LabF a (LabelId' a) (LabelId' a) -- ^ Label ::= LabelId LabelId | LabNoP a (LabelId' a) -- ^ Label ::= LabelId | LabP a (LabelId' a) [ProfItem' a] -- ^ Label ::= LabelId ProfItem | LabPF a (LabelId' a) (LabelId' a) [ProfItem' a] -- ^ Label ::= LabelId LabelId ProfItem deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type LabelId = LabelId' BNFC'Position data LabelId' a = Id a Ident -- ^ LabelId ::= Ident | ListCons a -- ^ LabelId ::= "(" ":" ")" | ListE a -- ^ LabelId ::= "[" "]" | ListOne a -- ^ LabelId ::= "(" ":" "[" "]" ")" | Wild a -- ^ LabelId ::= "_" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type ProfItem = ProfItem' BNFC'Position data ProfItem' a = ProfIt a [IntList' a] [T.Integer] -- ^ ProfItem ::= "(" "[" IntList "]" "," "[" Integer "]" ")" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type IntList = IntList' BNFC'Position data IntList' a = Ints a [T.Integer] -- ^ IntList ::= "[" Integer "]" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type RHS = RHS' BNFC'Position data RHS' a = MkRHS a [Item' a] -- ^ RHS ::= Item deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type MinimumSize = MinimumSize' BNFC'Position data MinimumSize' a = MEmpty a -- ^ MinimumSize ::= | MNonempty a -- ^ MinimumSize ::= "nonempty" deriving (C.Eq, C.Ord, C.Show, C.Read, C.Functor, C.Foldable, C.Traversable) type Reg = Reg' BNFC'Position data Reg' a = RAlt a (Reg' a) (Reg' a) -- ^ Reg ::= Reg1 "|" Reg2 | RAlts a T.String -- ^ Reg ::= "[" String "]" | RAny a -- ^ Reg ::= "char" | RChar a T.Char -- ^ Reg ::= Char | RDigit a -- ^ Reg ::= "digit" | REps a -- ^ Reg ::= "eps" | RLetter a -- ^ Reg ::= "letter" | RLower a -- ^ Reg ::= "lower" | RMinus a (Reg' a) (Reg' a) -- ^ Reg ::= Reg2 "-" Reg2 | ROpt a (Reg' a) -- ^ Reg ::= Reg3 "?" | RPlus a (Reg' a) -- ^ Reg ::= Reg3 "+" | RSeq a (Reg' a) (Reg' a) -- ^ Reg ::= Reg2 Reg3 | RSeqs a T.String -- ^ Reg ::= "{" String "}" | RStar a (Reg' a) -- ^ Reg ::= Reg3 "*" | RUpper a -- ^ Reg ::= "upper" 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 Grammar where hasPosition = \case MkGrammar p _ -> p instance HasPosition Def where hasPosition = \case Coercions p _ _ -> p Comment p _ -> p Comments p _ _ -> p Entryp p _ -> p Internal p _ _ _ -> p Layout p _ -> p LayoutStop p _ -> p LayoutTop p -> p PosToken p _ _ -> p Rule p _ _ _ -> p Rules p _ _ -> p Separator p _ _ _ -> p Terminator p _ _ _ -> p Token p _ _ -> p instance HasPosition Item where hasPosition = \case NTerminal p _ -> p Terminal p _ -> p instance HasPosition Cat where hasPosition = \case IdCat p _ -> p ListCat p _ -> p instance HasPosition Label where hasPosition = \case LabF p _ _ -> p LabNoP p _ -> p LabP p _ _ -> p LabPF p _ _ _ -> p instance HasPosition LabelId where hasPosition = \case Id p _ -> p ListCons p -> p ListE p -> p ListOne p -> p Wild p -> p instance HasPosition ProfItem where hasPosition = \case ProfIt p _ _ -> p instance HasPosition IntList where hasPosition = \case Ints p _ -> p instance HasPosition RHS where hasPosition = \case MkRHS p _ -> p instance HasPosition MinimumSize where hasPosition = \case MEmpty p -> p MNonempty p -> p instance HasPosition Reg where hasPosition = \case RAlt p _ _ -> p RAlts p _ -> p RAny p -> p RChar p _ -> p RDigit p -> p REps p -> p RLetter p -> p RLower p -> p RMinus p _ _ -> p ROpt p _ -> p RPlus p _ -> p RSeq p _ _ -> p RSeqs p _ -> p RStar p _ -> p RUpper p -> p