language-Modula2-0.1.5: Parser, pretty-printer, and more for the Modula-2 programming language
Safe HaskellNone
LanguageHaskell2010

Language.Modula2.Grammar

Description

Modula-2 grammar adapted from ''Report on the Programming Language Modula-2''

Synopsis

Documentation

data Modula2Grammar l (f :: Type -> Type) (p :: Type -> Type) Source #

The names and types of all the Modula-2 grammar productions

Constructors

Modula2Grammar 

Fields

Instances

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

Defined in Language.Modula2.Grammar

Methods

pure :: (forall a. f0 a) -> Modula2Grammar l f f0

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

Defined in Language.Modula2.Grammar

Methods

(<*>) :: forall (p :: Type -> Type) (q :: Type -> Type). Modula2Grammar l f (p ~> q) -> Modula2Grammar l f p -> Modula2Grammar l f q

liftA2 :: (forall a. p a -> q a -> r a) -> Modula2Grammar l f p -> Modula2Grammar l f q -> Modula2Grammar l f r

liftA3 :: (forall a. p a -> q a -> r a -> s a) -> Modula2Grammar l f p -> Modula2Grammar l f q -> Modula2Grammar l f r -> Modula2Grammar l f s

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

Defined in Language.Modula2.Grammar

Methods

collect :: forall p a (q :: Type -> Type). Functor p => (a -> Modula2Grammar l f q) -> p a -> Modula2Grammar l f (Compose p q)

distribute :: forall p (q :: Type -> Type). Functor p => p (Modula2Grammar l f q) -> Modula2Grammar l f (Compose p q)

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

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

Defined in Language.Modula2.Grammar

Methods

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

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

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

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

Defined in Language.Modula2.Grammar

Methods

foldMap :: Monoid m => (forall a. p a -> m) -> Modula2Grammar l f p -> m

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

Defined in Language.Modula2.Grammar

Methods

(<$>) :: (forall a. p a -> q a) -> Modula2Grammar l f p -> Modula2Grammar l f q

coerce :: forall (p :: Type -> Type) (q :: Type -> Type). (forall a. Coercible (p a) (q a)) => Modula2Grammar l f p -> Modula2Grammar l f q

Logistic (Modula2Grammar l f :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Language.Modula2.Grammar

Methods

deliver :: forall p (q :: Type -> Type). Contravariant p => p (Modula2Grammar l f q -> Modula2Grammar l f q) -> Modula2Grammar l f (Compose p (q ~> q))

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

Defined in Language.Modula2.Grammar

Methods

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

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

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

Defined in Language.Modula2.Grammar

LexicalParsing (Parser (ISOGrammar l) Text) Source # 
Instance details

Defined in Language.Modula2.ISO.Grammar

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

Defined in Language.Modula2.Grammar

TokenParsing (Parser (ISOGrammar l) Text) Source # 
Instance details

Defined in Language.Modula2.ISO.Grammar

moptional :: (Alternative f, Monoid (f a)) => f a -> f a Source #

delimiter :: forall (g :: (Type -> Type) -> Type). LexicalParsing (Parser g Text) => Text -> Parser g Text () Source #

operator :: forall (g :: (Type -> Type) -> Type). LexicalParsing (Parser g Text) => Text -> Parser g Text () Source #

whiteSpace :: forall (g :: (Type -> Type) -> Type). (Apply g, LexicalParsing (Parser g Text)) => Parser g Text () Source #

wrap :: forall (g :: (Type -> Type) -> Type) a. Apply g => Parser g Text a -> Parser g Text (NodeWrap a) Source #

grammar :: forall l (g :: (Type -> Type) -> Type). (Modula2 l, Apply g, LexicalParsing (Parser g Text)) => GrammarBuilder (Modula2Grammar l NodeWrap) g Parser Text Source #

All the productions of Modula-2 grammar

comment :: forall (g :: (Type -> Type) -> Type). Apply g => Parser g Text Text Source #

data Lexeme #

Constructors

WhiteSpace 

Fields

Comment 

Fields

Token 

Instances

Instances details
Data Lexeme 
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 
Instance details

Defined in Language.Oberon.Grammar

Eq Lexeme 
Instance details

Defined in Language.Oberon.Grammar

Methods

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

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

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

Defined in Language.Modula2.Grammar

LexicalParsing (Parser (ISOGrammar l) Text) Source # 
Instance details

Defined in Language.Modula2.ISO.Grammar

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

Defined in Language.Oberon.Grammar

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

Defined in Language.Modula2.Grammar

TokenParsing (Parser (ISOGrammar l) Text) Source # 
Instance details

Defined in Language.Modula2.ISO.Grammar

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

Defined in Language.Oberon.Grammar

newtype ParsedLexemes #

Constructors

Trailing [Lexeme] 

Instances

Instances details
Data ParsedLexemes 
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 #

Monoid ParsedLexemes 
Instance details

Defined in Language.Oberon.Grammar

Semigroup ParsedLexemes 
Instance details

Defined in Language.Oberon.Grammar

Show ParsedLexemes 
Instance details

Defined in Language.Oberon.Grammar

Eq ParsedLexemes 
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) 
Instance details

Defined in Language.Oberon.ConstantFolder

Methods

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

(Foldable (g (Const (Sum Int) :: Type -> Type)), Foldable (Fold Parsed (Sum Int)) g) => At PositionAdjustment (g Parsed Parsed) 
Instance details

Defined in Language.Oberon.Reserializer

Methods

($) :: PositionAdjustment -> Domain PositionAdjustment (g Parsed Parsed) -> Codomain PositionAdjustment (g Parsed Parsed) #

At Serialization (g Parsed Parsed) 
Instance details

Defined in Language.Oberon.Reserializer

Methods

($) :: Serialization -> Domain Serialization (g Parsed Parsed) -> Codomain Serialization (g Parsed Parsed) #

At (Resolution l) (g NodeWrap NodeWrap) 
Instance details

Defined in Language.Oberon.Resolver

Methods

($) :: Resolution l -> Domain (Resolution l) (g NodeWrap NodeWrap) -> Codomain (Resolution l) (g NodeWrap NodeWrap) #

At (Resolution l) (g Placed Placed) 
Instance details

Defined in Language.Oberon.Resolver

Methods

($) :: Resolution l -> Domain (Resolution l) (g Placed Placed) -> Codomain (Resolution l) (g Placed Placed) #

(BindableDeclaration l, Traversable (Resolution l) (Type l l), Traversable (Resolution l) (FormalParameters l l), Traversable (Resolution l) (ConstExpression l l), Traversable (Resolution l) (DeclarationRHS l), Traversable (Resolution l) (Type l l), Traversable (Resolution l) (FormalParameters l l), Traversable (Resolution l) (ConstExpression l l)) => At (Resolution l) (Block l l NodeWrap NodeWrap) 
Instance details

Defined in Language.Oberon.Resolver

Methods

($) :: Resolution l -> Domain (Resolution l) (Block l l NodeWrap NodeWrap) -> Codomain (Resolution l) (Block l l NodeWrap NodeWrap) #

(BindableDeclaration l, CoFormalParameters l, Wirthy l, Traversable (Resolution l) (Type l l), Traversable (Resolution l) (FormalParameters l l), Traversable (Resolution l) (ConstExpression l l), Traversable (Resolution l) (DeclarationRHS l), Traversable (Resolution l) (Type l l), Traversable (Resolution l) (ProcedureHeading l l), Traversable (Resolution l) (FormalParameters l l), Traversable (Resolution l) (ConstExpression l l), At (Resolution l) (ProcedureHeading l l NodeWrap NodeWrap), At (Resolution l) (Block l l NodeWrap NodeWrap)) => At (Resolution l) (Declaration l l NodeWrap NodeWrap) 
Instance details

Defined in Language.Oberon.Resolver

Methods

($) :: Resolution l -> Domain (Resolution l) (Declaration l l NodeWrap NodeWrap) -> Codomain (Resolution l) (Declaration l l NodeWrap NodeWrap) #

Resolvable l => At (Resolution l) (Designator l l NodeWrap NodeWrap) 
Instance details

Defined in Language.Oberon.Resolver

Methods

($) :: Resolution l -> Domain (Resolution l) (Designator l l NodeWrap NodeWrap) -> Codomain (Resolution l) (Designator l l NodeWrap NodeWrap) #

(Readable l, Nameable l, Oberon l, Traversable (Resolution l) (Expression l l), Traversable (Resolution l) (Designator l l), At (Resolution l) (Expression l l NodeWrap NodeWrap), At (Resolution l) (Designator l l NodeWrap NodeWrap)) => At (Resolution l) (Expression l l NodeWrap NodeWrap) 
Instance details

Defined in Language.Oberon.Resolver

Methods

($) :: Resolution l -> Domain (Resolution l) (Expression l l NodeWrap NodeWrap) -> Codomain (Resolution l) (Expression l l NodeWrap NodeWrap) #

(Wirthy l, CoFormalParameters l, Traversable (Resolution l) (Type l l), Traversable (Resolution l) (FormalParameters l l), Traversable (Resolution l) (ConstExpression l l), Traversable (Resolution l) (DeclarationRHS l), Traversable (Resolution l) (Type l l), Traversable (Resolution l) (FormalParameters l l), Traversable (Resolution l) (ConstExpression l l)) => At (Resolution l) (ProcedureHeading l l NodeWrap NodeWrap) 
Instance details

Defined in Language.Oberon.Resolver

Methods

($) :: Resolution l -> Domain (Resolution l) (ProcedureHeading l l NodeWrap NodeWrap) -> Codomain (Resolution l) (ProcedureHeading l l NodeWrap NodeWrap) #

(Traversable (Resolution l) (Designator l l), At (Resolution l) (Designator l l NodeWrap NodeWrap)) => At (Resolution l) (Statement l l NodeWrap NodeWrap) 
Instance details

Defined in Language.Oberon.Resolver

Methods

($) :: Resolution l -> Domain (Resolution l) (Statement l l NodeWrap NodeWrap) -> Codomain (Resolution l) (Statement l l NodeWrap NodeWrap) #

LexicalParsing (Parser (ISOGrammar l) Text) Source # 
Instance details

Defined in Language.Modula2.ISO.Grammar

TokenParsing (Parser (ISOGrammar l) Text) Source # 
Instance details

Defined in Language.Modula2.ISO.Grammar

(Functor (g Placed), Functor (Map Placed Identity) g) => Functor (Map Placed Identity) g Source # 
Instance details

Defined in Language.Modula2

Methods

(<$>) :: Map Placed Identity -> Domain (Map Placed Identity) (g (Domain (Map Placed Identity)) (Domain (Map Placed Identity))) -> Codomain (Map Placed Identity) (g (Codomain (Map Placed Identity)) (Codomain (Map Placed Identity))) #

coerce :: (Map Placed Identity ~ Coercion p q, forall (h :: (Type -> Type) -> (Type -> Type) -> Type). Coercible (p (h p p)) (q (h q q))) => p (g p p) -> q (g q q) #

(Functor (g NodeWrap), Functor (Map NodeWrap Placed) g) => Functor (Map NodeWrap Placed) g Source # 
Instance details

Defined in Language.Modula2

Methods

(<$>) :: Map NodeWrap Placed -> Domain (Map NodeWrap Placed) (g (Domain (Map NodeWrap Placed)) (Domain (Map NodeWrap Placed))) -> Codomain (Map NodeWrap Placed) (g (Codomain (Map NodeWrap Placed)) (Codomain (Map NodeWrap Placed))) #

coerce :: (Map NodeWrap Placed ~ Coercion p q, forall (h :: (Type -> Type) -> (Type -> Type) -> Type). Coercible (p (h p p)) (q (h q q))) => p (g p p) -> q (g q q) #

(Show (FormalParameters l l NodeWrap NodeWrap), Show (Type l l NodeWrap NodeWrap), Show (ConstExpression l l NodeWrap NodeWrap)) => Show (DeclarationRHS l NodeWrap NodeWrap) 
Instance details

Defined in Language.Oberon.Resolver

Methods

showsPrec :: Int -> DeclarationRHS l NodeWrap NodeWrap -> ShowS #

show :: DeclarationRHS l NodeWrap NodeWrap -> String #

showList :: [DeclarationRHS l NodeWrap NodeWrap] -> ShowS #

(Show (FormalParameters l l Placed Placed), Show (Type l l Placed Placed), Show (ConstExpression l l Placed Placed)) => Show (DeclarationRHS l Placed Placed) 
Instance details

Defined in Language.Oberon.Resolver

Methods

showsPrec :: Int -> DeclarationRHS l Placed Placed -> ShowS #

show :: DeclarationRHS l Placed Placed -> String #

showList :: [DeclarationRHS l Placed Placed] -> ShowS #