language-oberon-0.3: Parser, pretty-printer, and more for the Oberon programming language
Safe HaskellNone
LanguageHaskell2010

Language.Oberon.Grammar

Description

Oberon grammar adapted from http://www.ethoberon.ethz.ch/EBNF.html

Extracted from the book Programmieren in Oberon - Das neue Pascal by N. Wirth and M. Reiser and translated by J. Templ.

The grammars in this module attempt to follow the language grammars from the reports, while generating a semantically meaningful abstract syntax tree; the latter is defined in Language.Oberon.AST. As the grammars are ambiguous, it is necessary to resolve the ambiguities after parsing all Oberon modules in use. Language.Oberon.Resolver provides this functionality. Only after the ambiguity resolution can the abstract syntax tree be pretty-printed using the instances from Language.Oberon.Pretty. Alternatively, since the parsing preserves the original parsed lexemes including comments in the AST, you can use Language.Oberon.Reserializer to reproduce the original source code from the AST.

Synopsis

Documentation

data OberonGrammar l f p Source #

All the productions of the Oberon grammar

Constructors

OberonGrammar 

Fields

Instances

Instances details
Functor (OberonGrammar l f :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

(<$>) :: (forall (a :: k). p a -> q a) -> OberonGrammar l f p -> OberonGrammar l f q #

Foldable (OberonGrammar l f :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

foldMap :: Monoid m => (forall (a :: k). p a -> m) -> OberonGrammar l f p -> m #

Traversable (OberonGrammar l f :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

traverse :: Applicative m => (forall (a :: k). p a -> m (q a)) -> OberonGrammar l f p -> m (OberonGrammar l f q) #

sequence :: forall m (p :: k -> Type). Applicative m => OberonGrammar l f (Compose m p) -> m (OberonGrammar l f p) #

Apply (OberonGrammar l f :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

(<*>) :: forall (p :: k -> Type) (q :: k -> Type). OberonGrammar l f (p ~> q) -> OberonGrammar l f p -> OberonGrammar l f q #

liftA2 :: (forall (a :: k). p a -> q a -> r a) -> OberonGrammar l f p -> OberonGrammar l f q -> OberonGrammar l f r #

liftA3 :: (forall (a :: k). p a -> q a -> r a -> s a) -> OberonGrammar l f p -> OberonGrammar l f q -> OberonGrammar l f r -> OberonGrammar l f s #

Applicative (OberonGrammar l f :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

pure :: (forall (a :: k). f0 a) -> OberonGrammar l f f0 #

Distributive (OberonGrammar l f :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

collect :: forall f1 a (f2 :: k -> Type). Functor f1 => (a -> OberonGrammar l f f2) -> f1 a -> OberonGrammar l f (Compose f1 f2) #

distribute :: forall f1 (f2 :: k -> Type). Functor f1 => f1 (OberonGrammar l f f2) -> OberonGrammar l f (Compose f1 f2) #

cotraverse :: Functor m => (forall (a :: k). m (p a) -> q a) -> m (OberonGrammar l f p) -> OberonGrammar l f q #

DistributiveTraversable (OberonGrammar l f :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

collectTraversable :: forall f1 a (f2 :: k -> Type). Traversable f1 => (a -> OberonGrammar l f f2) -> f1 a -> OberonGrammar l f (Compose f1 f2) #

distributeTraversable :: forall f1 (f2 :: k -> Type). Traversable f1 => f1 (OberonGrammar l f f2) -> OberonGrammar l f (Compose f1 f2) #

cotraverseTraversable :: Traversable f1 => (forall (x :: k). f1 (f2 x) -> f0 x) -> f1 (OberonGrammar l f f2) -> OberonGrammar l f f0 #

LexicalParsing (Parser (OberonGrammar l f) Text) Source # 
Instance details

Defined in Language.Oberon.Grammar

TokenParsing (Parser (OberonGrammar l f) Text) Source # 
Instance details

Defined in Language.Oberon.Grammar

type NodeWrap = Compose ((,) (Position, Position)) (Compose Ambiguous ((,) ParsedLexemes)) Source #

Every node in the parsed AST will be wrapped in this data type.

newtype ParsedLexemes Source #

Constructors

Trailing [Lexeme] 

Instances

Instances details
Data ParsedLexemes Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ParsedLexemes -> c ParsedLexemes #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ParsedLexemes #

toConstr :: ParsedLexemes -> Constr #

dataTypeOf :: ParsedLexemes -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ParsedLexemes) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedLexemes) #

gmapT :: (forall b. Data b => b -> b) -> ParsedLexemes -> ParsedLexemes #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ParsedLexemes -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ParsedLexemes -> r #

gmapQ :: (forall d. Data d => d -> u) -> ParsedLexemes -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ParsedLexemes -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes #

Show ParsedLexemes Source # 
Instance details

Defined in Language.Oberon.Grammar

Semigroup ParsedLexemes Source # 
Instance details

Defined in Language.Oberon.Grammar

Monoid ParsedLexemes Source # 
Instance details

Defined in Language.Oberon.Grammar

(Ord (QualIdent l), v ~ Value l l Placed Placed) => SynthesizedField "designatorValue" (Maybe (Placed v)) (Auto ConstantFold) (Designator l l) Sem Placed Source # 
Instance details

Defined in Language.Oberon.ConstantFolder

Methods

synthesizedField :: forall (sem :: Type -> Type). sem ~ Semantics (Auto ConstantFold) => Proxy "designatorValue" -> Auto ConstantFold -> Placed (Designator l l Sem Sem) -> Atts (Inherited (Auto ConstantFold)) (Designator l l sem sem) -> Designator l l sem (Synthesized (Auto ConstantFold)) -> Maybe (Placed v) #

(Nameable l, k ~ QualIdent l, v ~ Value l l Placed Placed, Ord k, Atts (Synthesized (Auto ConstantFold)) (ConstExpression l l Sem Sem) ~ SynCFExp l l) => SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (Declaration l l) Sem Placed Source # 
Instance details

Defined in Language.Oberon.ConstantFolder

Methods

synthesizedField :: forall (sem :: Type -> Type). sem ~ Semantics (Auto ConstantFold) => Proxy "moduleEnv" -> Auto ConstantFold -> Placed (Declaration l l Sem Sem) -> Atts (Inherited (Auto ConstantFold)) (Declaration l l sem sem) -> Declaration l l sem (Synthesized (Auto ConstantFold)) -> Map k (Maybe v) #

(Nameable l, k ~ QualIdent l, v ~ Value l l Placed Placed, Ord k, Atts (Synthesized (Auto ConstantFold)) (Declaration l l Sem Sem) ~ SynCFMod' l (Declaration l l)) => SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (Block l l) Sem Placed Source # 
Instance details

Defined in Language.Oberon.ConstantFolder

Methods

synthesizedField :: forall (sem :: Type -> Type). sem ~ Semantics (Auto ConstantFold) => Proxy "moduleEnv" -> Auto ConstantFold -> Placed (Block l l Sem Sem) -> Atts (Inherited (Auto ConstantFold)) (Block l l sem sem) -> Block l l sem (Synthesized (Auto ConstantFold)) -> Map k (Maybe v) #

Ord (QualIdent l) => Bequether (Auto ConstantFold) (Modules l) Sem Placed Source # 
Instance details

Defined in Language.Oberon.ConstantFolder

Ord (QualIdent l) => Synthesizer (Auto ConstantFold) (Modules l) Sem Placed Source # 
Instance details

Defined in Language.Oberon.ConstantFolder

Methods

synthesis :: forall (sem :: Type -> Type). sem ~ Semantics (Auto ConstantFold) => Auto ConstantFold -> Placed (Modules l Sem Sem) -> Atts (Inherited (Auto ConstantFold)) (Modules l sem sem) -> Modules l sem (Synthesized (Auto ConstantFold)) -> Atts (Synthesized (Auto ConstantFold)) (Modules l sem sem) #

(Nameable l, Ord (QualIdent l), Atts (Synthesized (Auto ConstantFold)) (Declaration l l Sem Sem) ~ SynCFMod' l (Declaration l l), Atts (Inherited (Auto ConstantFold)) (StatementSequence l l Sem Sem) ~ InhCF l, Atts (Inherited (Auto ConstantFold)) (Declaration l l Sem Sem) ~ InhCF l) => Bequether (Auto ConstantFold) (Block l l) Sem Placed Source # 
Instance details

Defined in Language.Oberon.ConstantFolder

Methods

bequest :: forall (sem :: Type -> Type). sem ~ Semantics (Auto ConstantFold) => Auto ConstantFold -> Placed (Block l l Sem Sem) -> Atts (Inherited (Auto ConstantFold)) (Block l l sem sem) -> Block l l sem (Synthesized (Auto ConstantFold)) -> Block l l sem (Inherited (Auto ConstantFold)) #

(Oberon l, Nameable l, Ord (QualIdent l), Value l ~ Value l, InhCF l ~ InhCF λ, Pretty (Value λ λ Identity Identity), Atts (Synthesized (Auto ConstantFold)) (Expression l l Sem Sem) ~ SynCFExp l l, Atts (Synthesized (Auto ConstantFold)) (Element l l Sem Sem) ~ SynCF' (Element l l), Atts (Synthesized (Auto ConstantFold)) (Designator l l Sem Sem) ~ SynCFDesignator l) => Synthesizer (Auto ConstantFold) (Expression λ l) Sem Placed Source # 
Instance details

Defined in Language.Oberon.ConstantFolder

Methods

synthesis :: forall (sem :: Type -> Type). sem ~ Semantics (Auto ConstantFold) => Auto ConstantFold -> Placed (Expression λ l Sem Sem) -> Atts (Inherited (Auto ConstantFold)) (Expression λ l sem sem) -> Expression λ l sem (Synthesized (Auto ConstantFold)) -> Atts (Synthesized (Auto ConstantFold)) (Expression λ l sem sem) #

(Oberon l, Nameable l, Ord (QualIdent l), Show (QualIdent l), Atts (Synthesized (Auto ConstantFold)) (Block l l Sem Sem) ~ SynCFMod' l (Block l l)) => Synthesizer (Auto ConstantFold) (Module l l) Sem Placed Source # 
Instance details

Defined in Language.Oberon.ConstantFolder

Methods

synthesis :: forall (sem :: Type -> Type). sem ~ Semantics (Auto ConstantFold) => Auto ConstantFold -> Placed (Module l l Sem Sem) -> Atts (Inherited (Auto ConstantFold)) (Module l l sem sem) -> Module l l sem (Synthesized (Auto ConstantFold)) -> Atts (Synthesized (Auto ConstantFold)) (Module l l sem sem) #

data Lexeme Source #

Constructors

WhiteSpace 

Fields

Comment 

Fields

Token 

Instances

Instances details
Eq Lexeme Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

(==) :: Lexeme -> Lexeme -> Bool #

(/=) :: Lexeme -> Lexeme -> Bool #

Data Lexeme Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Lexeme -> c Lexeme #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Lexeme #

toConstr :: Lexeme -> Constr #

dataTypeOf :: Lexeme -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Lexeme) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lexeme) #

gmapT :: (forall b. Data b => b -> b) -> Lexeme -> Lexeme #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Lexeme -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Lexeme -> r #

gmapQ :: (forall d. Data d => d -> u) -> Lexeme -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Lexeme -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Lexeme -> m Lexeme #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Lexeme -> m Lexeme #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Lexeme -> m Lexeme #

Show Lexeme Source # 
Instance details

Defined in Language.Oberon.Grammar

LexicalParsing (Parser (OberonGrammar l f) Text) Source # 
Instance details

Defined in Language.Oberon.Grammar

TokenParsing (Parser (OberonGrammar l f) Text) Source # 
Instance details

Defined in Language.Oberon.Grammar

data TokenType Source #

Constructors

Delimiter 
Keyword 
Operator 
Other 

Instances

Instances details
Eq TokenType Source # 
Instance details

Defined in Language.Oberon.Grammar

Data TokenType Source # 
Instance details

Defined in Language.Oberon.Grammar

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> TokenType -> c TokenType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c TokenType #

toConstr :: TokenType -> Constr #

dataTypeOf :: TokenType -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c TokenType) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenType) #

gmapT :: (forall b. Data b => b -> b) -> TokenType -> TokenType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TokenType -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TokenType -> r #

gmapQ :: (forall d. Data d => d -> u) -> TokenType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> TokenType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> TokenType -> m TokenType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> TokenType -> m TokenType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> TokenType -> m TokenType #

Show TokenType Source # 
Instance details

Defined in Language.Oberon.Grammar

oberonDefinitionGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text Source #

Grammar of an Oberon definition module

oberon2DefinitionGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text Source #

Grammar of an Oberon-2 definition module