{-# Language DeriveDataTypeable, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
             OverloadedStrings, Rank2Types, RecordWildCards, ScopedTypeVariables,
             TypeApplications, TypeFamilies, TypeSynonymInstances, TemplateHaskell #-}

-- | 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.

module Language.Oberon.Grammar (OberonGrammar(..), Parser, NodeWrap, ParsedLexemes(..), Lexeme(..), TokenType(..),
                                oberonGrammar, oberon2Grammar, oberonDefinitionGrammar, oberon2DefinitionGrammar) where

import Control.Applicative
import Control.Arrow (first)
import Control.Monad (guard)
import Data.Char
import Data.Data (Data)
import Data.Functor.Compose (Compose(..))
import Data.List.NonEmpty (NonEmpty)
import Data.Ord (Down)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>), Dual(Dual, getDual), Endo(Endo, appEndo))
import Numeric (readDec, readHex, readFloat)
import Data.Text (Text, unpack)
import Text.Grampa
import Text.Parser.Combinators (sepBy, sepBy1, sepByNonEmpty, try)
import Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive (ParserT, autochain, lift, tmap)
import Text.Parser.Token (braces, brackets, parens)

import qualified Rank2
import qualified Rank2.TH

import qualified Language.Oberon.Abstract as Abstract
import qualified Language.Oberon.AST as AST

import Prelude hiding (length, takeWhile)

-- | All the productions of the Oberon grammar
data OberonGrammar l f p = OberonGrammar {
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
module_prod :: p (f (Abstract.Module l l f f)),
   forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
ident :: p Abstract.Ident,
   forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
letter :: p Text,
   forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
digit :: p Text,
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [Import l]
importList :: p [Abstract.Import l],
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Import l)
import_prod :: p (Abstract.Import l),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Declaration l l f f)]
declarationSequence :: p [f (Abstract.Declaration l l f f)],
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
constantDeclaration :: p (Abstract.Declaration l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentDef l)
identdef :: p (Abstract.IdentDef l),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
constExpression :: p (f (Abstract.Expression l l f f)),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
expression :: p (f (Abstract.Expression l l f f)),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
simpleExpression :: p (f (Abstract.Expression l l f f)),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
term :: p (f (Abstract.Expression l l f f)),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
factor :: p (f (Abstract.Expression l l f f)),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
number :: p (Abstract.Value l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
integer :: p (Abstract.Value l l f f),
   forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
hexDigit :: p Text,
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
real :: p (Abstract.Value l l f f),
   forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
scaleFactor :: p Text,
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
charConstant :: p (Abstract.Value l l f f),
   forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
string_prod :: p Text,
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Expression l l f f)
set :: p (Abstract.Expression l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Element l l f f)
element :: p (Abstract.Element l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Designator l l f f))
designator :: p (f (Abstract.Designator l l f f)),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Designator l l f f)
unguardedDesignator :: p (Abstract.Designator l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (Expression l l f f)))
expList :: p (NonEmpty (f (Abstract.Expression l l f f))),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Expression l l f f)]
actualParameters :: p [f (Abstract.Expression l l f f)],
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
mulOperator :: p (BinOp l f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
addOperator :: p (BinOp l f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p RelOp
relation :: p Abstract.RelOp,
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
typeDeclaration :: p (Abstract.Declaration l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
type_prod :: p (Abstract.Type l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
qualident :: p (Abstract.QualIdent l),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
arrayType :: p (Abstract.Type l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
length :: p (f (Abstract.Expression l l f f)),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
recordType :: p (Abstract.Type l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
baseType :: p (Abstract.BaseType l),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (FieldList l l f f)]
fieldListSequence :: p [f (Abstract.FieldList l l f f)],
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FieldList l l f f)
fieldList :: p (Abstract.FieldList l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentList l)
identList :: p (Abstract.IdentList l),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
pointerType :: p (Abstract.Type l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
procedureType :: p (Abstract.Type l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
variableDeclaration :: p (Abstract.Declaration l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureDeclaration :: p (Abstract.Declaration l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Text, ProcedureHeading l l f f)
procedureHeading :: p (Abstract.Ident, Abstract.ProcedureHeading l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FormalParameters l l f f)
formalParameters :: p (Abstract.FormalParameters l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FPSection l l f f)
fPSection :: p (Abstract.FPSection l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
formalType :: p (Abstract.Type l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Block l l f f)
procedureBody :: p (Abstract.Block l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
forwardDeclaration :: p (Abstract.Declaration l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (StatementSequence l l f f)
statementSequence :: p (Abstract.StatementSequence l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Statement l l f f))
statement :: p (f (Abstract.Statement l l f f)),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
assignment :: p (Abstract.Statement l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
procedureCall :: p (Abstract.Statement l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
ifStatement :: p (Abstract.Statement l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
caseStatement :: p (Abstract.Statement l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Case l l f f)
case_prod :: p (Abstract.Case l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (CaseLabels l l f f)))
caseLabelList :: p (NonEmpty (f (Abstract.CaseLabels l l f f))),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (CaseLabels l l f f)
caseLabels :: p (Abstract.CaseLabels l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
whileStatement :: p (Abstract.Statement l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
repeatStatement :: p (Abstract.Statement l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
forStatement :: p (Abstract.Statement l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
loopStatement :: p (Abstract.Statement l l f f),
   forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
withStatement :: p (Abstract.Statement l l f f)}

newtype BinOp l f = BinOp {forall l (f :: * -> *).
BinOp l f
-> f (Expression l l f f)
-> f (Expression l l f f)
-> f (Expression l l f f)
applyBinOp :: (f (Abstract.Expression l l f f)
                                          -> f (Abstract.Expression l l f f)
                                          -> f (Abstract.Expression l l f f))}

instance Show (BinOp l f) where
   show :: BinOp l f -> String
show = forall a b. a -> b -> a
const String
"BinOp{}"

$(Rank2.TH.deriveAll ''OberonGrammar)

type Parser = ParserT ((,) [[Lexeme]])
data Lexeme = WhiteSpace{Lexeme -> Text
lexemeText :: Text}
            | Comment{lexemeText :: Text}
            | Token{Lexeme -> TokenType
lexemeType :: TokenType,
                    lexemeText :: Text}
            deriving (Typeable Lexeme
Lexeme -> DataType
Lexeme -> Constr
(forall b. Data b => b -> b) -> Lexeme -> Lexeme
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Lexeme -> u
forall u. (forall d. Data d => d -> u) -> Lexeme -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Lexeme -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Lexeme -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lexeme -> m Lexeme
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lexeme -> m Lexeme
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lexeme
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lexeme -> c Lexeme
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lexeme)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lexeme)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lexeme -> m Lexeme
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lexeme -> m Lexeme
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lexeme -> m Lexeme
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lexeme -> m Lexeme
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lexeme -> m Lexeme
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lexeme -> m Lexeme
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Lexeme -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Lexeme -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Lexeme -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Lexeme -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Lexeme -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Lexeme -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Lexeme -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Lexeme -> r
gmapT :: (forall b. Data b => b -> b) -> Lexeme -> Lexeme
$cgmapT :: (forall b. Data b => b -> b) -> Lexeme -> Lexeme
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lexeme)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lexeme)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lexeme)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lexeme)
dataTypeOf :: Lexeme -> DataType
$cdataTypeOf :: Lexeme -> DataType
toConstr :: Lexeme -> Constr
$ctoConstr :: Lexeme -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lexeme
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lexeme
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lexeme -> c Lexeme
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lexeme -> c Lexeme
Data, Lexeme -> Lexeme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lexeme -> Lexeme -> Bool
$c/= :: Lexeme -> Lexeme -> Bool
== :: Lexeme -> Lexeme -> Bool
$c== :: Lexeme -> Lexeme -> Bool
Eq, Int -> Lexeme -> ShowS
[Lexeme] -> ShowS
Lexeme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lexeme] -> ShowS
$cshowList :: [Lexeme] -> ShowS
show :: Lexeme -> String
$cshow :: Lexeme -> String
showsPrec :: Int -> Lexeme -> ShowS
$cshowsPrec :: Int -> Lexeme -> ShowS
Show)

data TokenType = Delimiter | Keyword | Operator | Other
               deriving (Typeable TokenType
TokenType -> DataType
TokenType -> Constr
(forall b. Data b => b -> b) -> TokenType -> TokenType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TokenType -> u
forall u. (forall d. Data d => d -> u) -> TokenType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenType -> c TokenType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TokenType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TokenType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
gmapT :: (forall b. Data b => b -> b) -> TokenType -> TokenType
$cgmapT :: (forall b. Data b => b -> b) -> TokenType -> TokenType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenType)
dataTypeOf :: TokenType -> DataType
$cdataTypeOf :: TokenType -> DataType
toConstr :: TokenType -> Constr
$ctoConstr :: TokenType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenType -> c TokenType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenType -> c TokenType
Data, TokenType -> TokenType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenType -> TokenType -> Bool
$c/= :: TokenType -> TokenType -> Bool
== :: TokenType -> TokenType -> Bool
$c== :: TokenType -> TokenType -> Bool
Eq, Int -> TokenType -> ShowS
[TokenType] -> ShowS
TokenType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenType] -> ShowS
$cshowList :: [TokenType] -> ShowS
show :: TokenType -> String
$cshow :: TokenType -> String
showsPrec :: Int -> TokenType -> ShowS
$cshowsPrec :: Int -> TokenType -> ShowS
Show)

-- | Every node in the parsed AST will be wrapped in this data type.
type NodeWrap = Compose ((,) (Down Int, Down Int)) (Compose Ambiguous ((,) ParsedLexemes))

newtype ParsedLexemes = Trailing [Lexeme]
                      deriving (Typeable ParsedLexemes
ParsedLexemes -> DataType
ParsedLexemes -> Constr
(forall b. Data b => b -> b) -> ParsedLexemes -> ParsedLexemes
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ParsedLexemes -> u
forall u. (forall d. Data d => d -> u) -> ParsedLexemes -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedLexemes -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedLexemes -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedLexemes
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedLexemes -> c ParsedLexemes
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedLexemes)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParsedLexemes)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedLexemes -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedLexemes -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedLexemes -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedLexemes -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedLexemes -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedLexemes -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedLexemes -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedLexemes -> r
gmapT :: (forall b. Data b => b -> b) -> ParsedLexemes -> ParsedLexemes
$cgmapT :: (forall b. Data b => b -> b) -> ParsedLexemes -> ParsedLexemes
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParsedLexemes)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParsedLexemes)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedLexemes)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedLexemes)
dataTypeOf :: ParsedLexemes -> DataType
$cdataTypeOf :: ParsedLexemes -> DataType
toConstr :: ParsedLexemes -> Constr
$ctoConstr :: ParsedLexemes -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedLexemes
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedLexemes
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedLexemes -> c ParsedLexemes
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedLexemes -> c ParsedLexemes
Data, ParsedLexemes -> ParsedLexemes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsedLexemes -> ParsedLexemes -> Bool
$c/= :: ParsedLexemes -> ParsedLexemes -> Bool
== :: ParsedLexemes -> ParsedLexemes -> Bool
$c== :: ParsedLexemes -> ParsedLexemes -> Bool
Eq, Int -> ParsedLexemes -> ShowS
[ParsedLexemes] -> ShowS
ParsedLexemes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedLexemes] -> ShowS
$cshowList :: [ParsedLexemes] -> ShowS
show :: ParsedLexemes -> String
$cshow :: ParsedLexemes -> String
showsPrec :: Int -> ParsedLexemes -> ShowS
$cshowsPrec :: Int -> ParsedLexemes -> ShowS
Show, NonEmpty ParsedLexemes -> ParsedLexemes
ParsedLexemes -> ParsedLexemes -> ParsedLexemes
forall b. Integral b => b -> ParsedLexemes -> ParsedLexemes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> ParsedLexemes -> ParsedLexemes
$cstimes :: forall b. Integral b => b -> ParsedLexemes -> ParsedLexemes
sconcat :: NonEmpty ParsedLexemes -> ParsedLexemes
$csconcat :: NonEmpty ParsedLexemes -> ParsedLexemes
<> :: ParsedLexemes -> ParsedLexemes -> ParsedLexemes
$c<> :: ParsedLexemes -> ParsedLexemes -> ParsedLexemes
Semigroup, Semigroup ParsedLexemes
ParsedLexemes
[ParsedLexemes] -> ParsedLexemes
ParsedLexemes -> ParsedLexemes -> ParsedLexemes
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ParsedLexemes] -> ParsedLexemes
$cmconcat :: [ParsedLexemes] -> ParsedLexemes
mappend :: ParsedLexemes -> ParsedLexemes -> ParsedLexemes
$cmappend :: ParsedLexemes -> ParsedLexemes -> ParsedLexemes
mempty :: ParsedLexemes
$cmempty :: ParsedLexemes
Monoid)

instance TokenParsing (Parser (OberonGrammar l f) Text) where
   someSpace :: Parser (OberonGrammar l f) Text ()
someSpace = forall (m :: * -> *). LexicalParsing m => m ()
someLexicalSpace
   token :: forall a.
Parser (OberonGrammar l f) Text a
-> Parser (OberonGrammar l f) Text a
token = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken

instance LexicalParsing (Parser (OberonGrammar l f) Text) where
   lexicalComment :: Parser (OberonGrammar l f) Text ()
lexicalComment = do Text
c <- forall (g :: (* -> *) -> *). Apply g => Parser g Text Text
comment
                       forall (m :: * -> *) s a (g :: (* -> *) -> *).
(Applicative m, Ord s) =>
m a -> ParserT m g s a
lift ([[Text -> Lexeme
Comment Text
c]], ())
   lexicalWhiteSpace :: Parser (OberonGrammar l f) Text ()
lexicalWhiteSpace = forall (g :: (* -> *) -> *).
(Apply g, LexicalParsing (Parser g Text)) =>
Parser g Text ()
whiteSpace
   isIdentifierStartChar :: Char -> Bool
isIdentifierStartChar = Char -> Bool
isLetter
   isIdentifierFollowChar :: Char -> Bool
isIdentifierFollowChar = Char -> Bool
isAlphaNum
   identifierToken :: Parser
  (OberonGrammar l f)
  Text
  (ParserInput (Parser (OberonGrammar l f) Text))
-> Parser
     (OberonGrammar l f)
     Text
     (ParserInput (Parser (OberonGrammar l f) Text))
identifierToken Parser
  (OberonGrammar l f)
  Text
  (ParserInput (Parser (OberonGrammar l f) Text))
word = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (do Text
w <- Parser
  (OberonGrammar l f)
  Text
  (ParserInput (Parser (OberonGrammar l f) Text))
word
                                           forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
reservedWords)
                                           forall (m :: * -> *) a. Monad m => a -> m a
return Text
w)
   lexicalToken :: forall a.
Parser (OberonGrammar l f) Text a
-> Parser (OberonGrammar l f) Text a
lexicalToken Parser (OberonGrammar l f) Text a
p = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: * -> *) a (g :: (* -> *) -> *) s.
AmbiguityDecidable b =>
(m a -> m b) -> ParserT m g s a -> ParserT m g s b
tmap forall {b}. ([[Lexeme]], (Text, b)) -> ([[Lexeme]], (Text, b))
addOtherToken (forall (m :: * -> *) a.
ConsumedInputParsing m =>
m a -> m (ParserInput m, a)
match Parser (OberonGrammar l f) Text a
p) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace
      where addOtherToken :: ([[Lexeme]], (Text, b)) -> ([[Lexeme]], (Text, b))
addOtherToken ([], (Text
i, b
x)) = ([[TokenType -> Text -> Lexeme
Token TokenType
Other Text
i]], (Text
i, b
x))
            addOtherToken ([[Lexeme]]
t, (Text
i, b
x)) = ([[Lexeme]]
t, (Text
i, b
x))
   keyword :: ParserInput (Parser (OberonGrammar l f) Text)
-> Parser (OberonGrammar l f) Text ()
keyword ParserInput (Parser (OberonGrammar l f) Text)
s = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ParserInput (Parser (OberonGrammar l f) Text)
s
                             forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). InputCharParsing m => (Char -> Bool) -> m ()
notSatisfyChar (forall (m :: * -> *). LexicalParsing m => Char -> Bool
isIdentifierFollowChar @(Parser (OberonGrammar l f) Text))
                             forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s a (g :: (* -> *) -> *).
(Applicative m, Ord s) =>
m a -> ParserT m g s a
lift ([[TokenType -> Text -> Lexeme
Token TokenType
Keyword ParserInput (Parser (OberonGrammar l f) Text)
s]], ()))
               forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"keyword " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParserInput (Parser (OberonGrammar l f) Text)
s)

comment :: Rank2.Apply g => Parser g Text Text
comment :: forall (g :: (* -> *) -> *). Apply g => Parser g Text Text
comment = forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"(*"
               forall a. Semigroup a => a -> a -> a
<> forall (p :: * -> *) a. (Alternative p, Monoid a) => p a -> p a
concatMany (forall (g :: (* -> *) -> *). Apply g => Parser g Text Text
comment forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"*)") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). InputParsing m => m (ParserInput m)
anyToken forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isCommentChar)
               forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"*)")
   where isCommentChar :: Char -> Bool
isCommentChar Char
c = Char
c forall a. Eq a => a -> a -> Bool
/= Char
'*' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'('

whiteSpace :: Rank2.Apply g => LexicalParsing (Parser g Text) => Parser g Text ()
whiteSpace :: forall (g :: (* -> *) -> *).
(Apply g, LexicalParsing (Parser g Text)) =>
Parser g Text ()
whiteSpace = Fixed (ParserT ((,) [[Lexeme]])) g Text ()
spaceChars forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany (forall (m :: * -> *). LexicalParsing m => m ()
lexicalComment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
spaceChars) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"whitespace"
   where spaceChars :: Fixed (ParserT ((,) [[Lexeme]])) g Text ()
spaceChars = (forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile1 Char -> Bool
isSpace forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
ws-> forall (m :: * -> *) s a (g :: (* -> *) -> *).
(Applicative m, Ord s) =>
m a -> ParserT m g s a
lift ([[Text -> Lexeme
WhiteSpace Text
ws]], ())) forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

clearConsumed :: ParserT ((,) [a]) g s Text -> ParserT ((,) [a]) g s Text
clearConsumed = forall b (m :: * -> *) a (g :: (* -> *) -> *) s.
AmbiguityDecidable b =>
(m a -> m b) -> ParserT m g s a -> ParserT m g s b
tmap forall {a} {b} {a}. (a, b) -> ([a], b)
clear
   where clear :: (a, b) -> ([a], b)
clear (a
_, b
x) = ([], b
x)

wrapAmbiguous, wrap :: Rank2.Apply g => Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous :: forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous = forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap
wrap :: forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap = (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Text
  (Compose Ambiguous ((,) ParsedLexemes) a)
p-> forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 forall {a} {b} {b}. a -> b -> b -> ((a, b), b)
surround forall (m :: * -> *). InputParsing m => m (ParserPosition m)
getSourcePos Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Text
  (Compose Ambiguous ((,) ParsedLexemes) a)
p forall (m :: * -> *). InputParsing m => m (ParserPosition m)
getSourcePos)
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a.
AmbiguousParsing m =>
m a -> m (Ambiguous a)
ambiguous forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (m :: * -> *) a (g :: (* -> *) -> *) s.
AmbiguityDecidable b =>
(m a -> m b) -> ParserT m g s a -> ParserT m g s b
tmap forall {a} {t :: * -> *} {b}.
(Monoid a, Foldable t) =>
(t [Lexeme], (ParsedLexemes, b)) -> (a, (ParsedLexemes, b))
store) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,) ([Lexeme] -> ParsedLexemes
Trailing []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
   where store :: (t [Lexeme], (ParsedLexemes, b)) -> (a, (ParsedLexemes, b))
store (t [Lexeme]
wss, (Trailing [], b
a)) = (forall a. Monoid a => a
mempty, ([Lexeme] -> ParsedLexemes
Trailing (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Lexeme]
wss), b
a))
         surround :: a -> b -> b -> ((a, b), b)
surround a
start b
val b
end = ((a
start, b
end), b
val)

oberonGrammar, oberon2Grammar, oberonDefinitionGrammar, oberon2DefinitionGrammar
   :: Grammar (OberonGrammar AST.Language NodeWrap) Parser Text
-- | Grammar of an Oberon module
oberonGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text
oberonGrammar = forall (p :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
       (f :: * -> *) (rl :: * -> * -> *) (cb :: * -> *).
(cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,
 LeftRecParsing p g s rl, DeterministicParsing (p g s), Apply g,
 Traversable g, Distributive g, Logistic g) =>
g (Fixed p g s) -> g (Fixed p g s)
autochain forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
fixGrammar forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar
-- | Grammar of an Oberon-2 module
oberon2Grammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text
oberon2Grammar = forall (p :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
       (f :: * -> *) (rl :: * -> * -> *) (cb :: * -> *).
(cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,
 LeftRecParsing p g s rl, DeterministicParsing (p g s), Apply g,
 Traversable g, Distributive g, Logistic g) =>
g (Fixed p g s) -> g (Fixed p g s)
autochain forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
fixGrammar forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar2
-- | Grammar of an Oberon definition module
oberonDefinitionGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text
oberonDefinitionGrammar = forall (p :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
       (f :: * -> *) (rl :: * -> * -> *) (cb :: * -> *).
(cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,
 LeftRecParsing p g s rl, DeterministicParsing (p g s), Apply g,
 Traversable g, Distributive g, Logistic g) =>
g (Fixed p g s) -> g (Fixed p g s)
autochain forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
fixGrammar forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionGrammar
-- | Grammar of an Oberon-2 definition module
oberon2DefinitionGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text
oberon2DefinitionGrammar = forall (p :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
       (f :: * -> *) (rl :: * -> * -> *) (cb :: * -> *).
(cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,
 LeftRecParsing p g s rl, DeterministicParsing (p g s), Apply g,
 Traversable g, Distributive g, Logistic g) =>
g (Fixed p g s) -> g (Fixed p g s)
autochain forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
fixGrammar forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionGrammar2

grammar, definitionGrammar :: forall l. Abstract.Oberon l
                           => GrammarBuilder (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar2, definitionGrammar2 :: forall l. Abstract.Oberon2 l
                             => GrammarBuilder (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text

definitionGrammar :: forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionGrammar g :: OberonGrammar l NodeWrap (Parser (OberonGrammar l NodeWrap) Text)
g@OberonGrammar{Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
Parser (OberonGrammar l NodeWrap) Text [Import l]
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
Parser (OberonGrammar l NodeWrap) Text (IdentList l)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text Text
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Import l)
Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
Parser (OberonGrammar l NodeWrap) Text (BaseType l)
Parser (OberonGrammar l NodeWrap) Text RelOp
Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
withStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
loopStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
forStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
repeatStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
whileStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
caseLabels :: Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
caseLabelList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
case_prod :: Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
caseStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
ifStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
procedureCall :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
assignment :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
statement :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
statementSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
forwardDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureBody :: Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
formalType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
fPSection :: Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
formalParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
procedureHeading :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
variableDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
pointerType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
identList :: Parser (OberonGrammar l NodeWrap) Text (IdentList l)
fieldList :: Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
fieldListSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
baseType :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
recordType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
length :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
arrayType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
qualident :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
type_prod :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
typeDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
relation :: Parser (OberonGrammar l NodeWrap) Text RelOp
addOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
mulOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
actualParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
expList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
unguardedDesignator :: Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
designator :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
element :: Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
set :: Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
string_prod :: Parser (OberonGrammar l NodeWrap) Text Text
charConstant :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
scaleFactor :: Parser (OberonGrammar l NodeWrap) Text Text
real :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
hexDigit :: Parser (OberonGrammar l NodeWrap) Text Text
integer :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
number :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
factor :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
identdef :: Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
constantDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
declarationSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
import_prod :: Parser (OberonGrammar l NodeWrap) Text (Import l)
importList :: Parser (OberonGrammar l NodeWrap) Text [Import l]
digit :: Parser (OberonGrammar l NodeWrap) Text Text
letter :: Parser (OberonGrammar l NodeWrap) Text Text
ident :: Parser (OberonGrammar l NodeWrap) Text Text
module_prod :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
withStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
loopStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
forStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
repeatStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
whileStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
caseLabels :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (CaseLabels l l f f)
caseLabelList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (CaseLabels l l f f)))
case_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Case l l f f)
caseStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
ifStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
procedureCall :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
assignment :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
statement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Statement l l f f))
statementSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (StatementSequence l l f f)
forwardDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureBody :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Block l l f f)
formalType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
fPSection :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FPSection l l f f)
formalParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FormalParameters l l f f)
procedureHeading :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Text, ProcedureHeading l l f f)
procedureDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
variableDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
pointerType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
identList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentList l)
fieldList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FieldList l l f f)
fieldListSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (FieldList l l f f)]
baseType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
recordType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
length :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
arrayType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
qualident :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
type_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
typeDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
relation :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p RelOp
addOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
mulOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
actualParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Expression l l f f)]
expList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (Expression l l f f)))
unguardedDesignator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Designator l l f f)
designator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Designator l l f f))
element :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Element l l f f)
set :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Expression l l f f)
string_prod :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
charConstant :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
scaleFactor :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
real :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
hexDigit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
integer :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
number :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
factor :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
term :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
simpleExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
expression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
constExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
identdef :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentDef l)
constantDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
declarationSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Declaration l l f f)]
import_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Import l)
importList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [Import l]
digit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
letter :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
ident :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
module_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
..} = forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionMixin (forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar OberonGrammar l NodeWrap (Parser (OberonGrammar l NodeWrap) Text)
g)

definitionGrammar2 :: forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionGrammar2 g :: OberonGrammar l NodeWrap (Parser (OberonGrammar l NodeWrap) Text)
g@OberonGrammar{Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
Parser (OberonGrammar l NodeWrap) Text [Import l]
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
Parser (OberonGrammar l NodeWrap) Text (IdentList l)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text Text
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Import l)
Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
Parser (OberonGrammar l NodeWrap) Text (BaseType l)
Parser (OberonGrammar l NodeWrap) Text RelOp
Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
withStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
loopStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
forStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
repeatStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
whileStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
caseLabels :: Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
caseLabelList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
case_prod :: Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
caseStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
ifStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
procedureCall :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
assignment :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
statement :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
statementSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
forwardDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureBody :: Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
formalType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
fPSection :: Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
formalParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
procedureHeading :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
variableDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
pointerType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
identList :: Parser (OberonGrammar l NodeWrap) Text (IdentList l)
fieldList :: Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
fieldListSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
baseType :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
recordType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
length :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
arrayType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
qualident :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
type_prod :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
typeDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
relation :: Parser (OberonGrammar l NodeWrap) Text RelOp
addOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
mulOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
actualParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
expList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
unguardedDesignator :: Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
designator :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
element :: Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
set :: Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
string_prod :: Parser (OberonGrammar l NodeWrap) Text Text
charConstant :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
scaleFactor :: Parser (OberonGrammar l NodeWrap) Text Text
real :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
hexDigit :: Parser (OberonGrammar l NodeWrap) Text Text
integer :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
number :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
factor :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
identdef :: Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
constantDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
declarationSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
import_prod :: Parser (OberonGrammar l NodeWrap) Text (Import l)
importList :: Parser (OberonGrammar l NodeWrap) Text [Import l]
digit :: Parser (OberonGrammar l NodeWrap) Text Text
letter :: Parser (OberonGrammar l NodeWrap) Text Text
ident :: Parser (OberonGrammar l NodeWrap) Text Text
module_prod :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
withStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
loopStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
forStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
repeatStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
whileStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
caseLabels :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (CaseLabels l l f f)
caseLabelList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (CaseLabels l l f f)))
case_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Case l l f f)
caseStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
ifStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
procedureCall :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
assignment :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
statement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Statement l l f f))
statementSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (StatementSequence l l f f)
forwardDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureBody :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Block l l f f)
formalType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
fPSection :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FPSection l l f f)
formalParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FormalParameters l l f f)
procedureHeading :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Text, ProcedureHeading l l f f)
procedureDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
variableDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
pointerType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
identList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentList l)
fieldList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FieldList l l f f)
fieldListSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (FieldList l l f f)]
baseType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
recordType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
length :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
arrayType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
qualident :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
type_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
typeDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
relation :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p RelOp
addOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
mulOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
actualParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Expression l l f f)]
expList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (Expression l l f f)))
unguardedDesignator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Designator l l f f)
designator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Designator l l f f))
element :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Element l l f f)
set :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Expression l l f f)
string_prod :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
charConstant :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
scaleFactor :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
real :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
hexDigit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
integer :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
number :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
factor :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
term :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
simpleExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
expression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
constExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
identdef :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentDef l)
constantDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
declarationSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Declaration l l f f)]
import_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Import l)
importList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [Import l]
digit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
letter :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
ident :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
module_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
..} = forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionMixin (forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar2 OberonGrammar l NodeWrap (Parser (OberonGrammar l NodeWrap) Text)
g)

definitionMixin :: Abstract.Oberon l => GrammarBuilder (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionMixin :: forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionMixin g :: OberonGrammar
  l
  NodeWrap
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text)
g@OberonGrammar{Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [Import l]
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
Parser (OberonGrammar l NodeWrap) Text (IdentList l)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text Text
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Import l)
Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
Parser (OberonGrammar l NodeWrap) Text (BaseType l)
Parser (OberonGrammar l NodeWrap) Text RelOp
Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
withStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
loopStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
forStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
repeatStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
whileStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
caseLabels :: Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
caseLabelList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
case_prod :: Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
caseStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
ifStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
procedureCall :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
assignment :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
statement :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
statementSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
forwardDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureBody :: Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
formalType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
fPSection :: Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
formalParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
procedureHeading :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
variableDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
pointerType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
identList :: Parser (OberonGrammar l NodeWrap) Text (IdentList l)
fieldList :: Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
fieldListSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
baseType :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
recordType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
length :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
arrayType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
qualident :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
type_prod :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
typeDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
relation :: Parser (OberonGrammar l NodeWrap) Text RelOp
addOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
mulOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
actualParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
expList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
unguardedDesignator :: Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
designator :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
element :: Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
set :: Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
string_prod :: Parser (OberonGrammar l NodeWrap) Text Text
charConstant :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
scaleFactor :: Parser (OberonGrammar l NodeWrap) Text Text
real :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
hexDigit :: Parser (OberonGrammar l NodeWrap) Text Text
integer :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
number :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
factor :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
identdef :: Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
constantDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
declarationSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
import_prod :: Parser (OberonGrammar l NodeWrap) Text (Import l)
importList :: Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [Import l]
digit :: Parser (OberonGrammar l NodeWrap) Text Text
letter :: Parser (OberonGrammar l NodeWrap) Text Text
ident :: Parser (OberonGrammar l NodeWrap) Text Text
module_prod :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
withStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
loopStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
forStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
repeatStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
whileStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
caseLabels :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (CaseLabels l l f f)
caseLabelList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (CaseLabels l l f f)))
case_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Case l l f f)
caseStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
ifStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
procedureCall :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
assignment :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
statement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Statement l l f f))
statementSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (StatementSequence l l f f)
forwardDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureBody :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Block l l f f)
formalType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
fPSection :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FPSection l l f f)
formalParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FormalParameters l l f f)
procedureHeading :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Text, ProcedureHeading l l f f)
procedureDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
variableDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
pointerType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
identList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentList l)
fieldList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FieldList l l f f)
fieldListSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (FieldList l l f f)]
baseType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
recordType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
length :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
arrayType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
qualident :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
type_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
typeDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
relation :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p RelOp
addOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
mulOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
actualParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Expression l l f f)]
expList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (Expression l l f f)))
unguardedDesignator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Designator l l f f)
designator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Designator l l f f))
element :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Element l l f f)
set :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Expression l l f f)
string_prod :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
charConstant :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
scaleFactor :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
real :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
hexDigit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
integer :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
number :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
factor :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
term :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
simpleExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
expression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
constExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
identdef :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentDef l)
constantDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
declarationSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Declaration l l f f)]
import_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Import l)
importList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [Import l]
digit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
letter :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
ident :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
module_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
..} = OberonGrammar
  l
  NodeWrap
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text)
g{
   module_prod :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
module_prod = forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap forall a b. (a -> b) -> a -> b
$
                 do forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace 
                    forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"DEFINITION"
                    Text
name <- Parser (OberonGrammar l NodeWrap) Text Text
ident
                    forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";"
                    [Import l]
imports <- forall (f :: * -> *) a. (Alternative f, Monoid (f a)) => f a -> f a
moptional Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [Import l]
importList
                    NodeWrap (Block l l NodeWrap NodeWrap)
block <- forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (Declaration l' l' f' f')]
-> Maybe (f (StatementSequence l' l' f' f')) -> Block l l' f' f
Abstract.block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
declarationSequence forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
                    forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END"
                    forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
name)
                    forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"."
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
Text -> [Import l] -> f (Block l' l' f' f') -> Module l l' f' f
Abstract.moduleUnit Text
name [Import l]
imports NodeWrap (Block l l NodeWrap NodeWrap)
block),
   procedureDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureDeclaration = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (ProcedureHeading l' l' f' f')
-> f (Block l' l' f' f') -> Declaration l l' f' f
Abstract.procedureDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA 
                          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureHeading 
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (Declaration l' l' f' f')]
-> Maybe (f (StatementSequence l' l' f' f')) -> Block l l' f' f
Abstract.block [] forall a. Maybe a
Nothing),
   identdef :: Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef = forall l. Oberon l => Text -> IdentDef l
Abstract.exported forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text Text
ident forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"*")}

grammar2 :: forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar2 g :: OberonGrammar
  l
  NodeWrap
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text)
g@OberonGrammar{Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
Parser (OberonGrammar l NodeWrap) Text [Import l]
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
Parser (OberonGrammar l NodeWrap) Text (IdentList l)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text Text
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Import l)
Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
Parser (OberonGrammar l NodeWrap) Text (BaseType l)
Parser (OberonGrammar l NodeWrap) Text RelOp
Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
withStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
loopStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
forStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
repeatStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
whileStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
caseLabels :: Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
caseLabelList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
case_prod :: Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
caseStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
ifStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
procedureCall :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
assignment :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
statement :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
statementSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
forwardDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureBody :: Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
formalType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
fPSection :: Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
formalParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
procedureHeading :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
variableDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
pointerType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
identList :: Parser (OberonGrammar l NodeWrap) Text (IdentList l)
fieldList :: Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
fieldListSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
baseType :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
recordType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
length :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
arrayType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
qualident :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
type_prod :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
typeDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
relation :: Parser (OberonGrammar l NodeWrap) Text RelOp
addOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
mulOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
actualParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
expList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
unguardedDesignator :: Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
designator :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
element :: Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
set :: Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
string_prod :: Parser (OberonGrammar l NodeWrap) Text Text
charConstant :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
scaleFactor :: Parser (OberonGrammar l NodeWrap) Text Text
real :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
hexDigit :: Parser (OberonGrammar l NodeWrap) Text Text
integer :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
number :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
factor :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
identdef :: Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
constantDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
declarationSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
import_prod :: Parser (OberonGrammar l NodeWrap) Text (Import l)
importList :: Parser (OberonGrammar l NodeWrap) Text [Import l]
digit :: Parser (OberonGrammar l NodeWrap) Text Text
letter :: Parser (OberonGrammar l NodeWrap) Text Text
ident :: Parser (OberonGrammar l NodeWrap) Text Text
module_prod :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
withStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
loopStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
forStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
repeatStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
whileStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
caseLabels :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (CaseLabels l l f f)
caseLabelList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (CaseLabels l l f f)))
case_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Case l l f f)
caseStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
ifStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
procedureCall :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
assignment :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
statement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Statement l l f f))
statementSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (StatementSequence l l f f)
forwardDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureBody :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Block l l f f)
formalType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
fPSection :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FPSection l l f f)
formalParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FormalParameters l l f f)
procedureHeading :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Text, ProcedureHeading l l f f)
procedureDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
variableDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
pointerType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
identList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentList l)
fieldList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FieldList l l f f)
fieldListSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (FieldList l l f f)]
baseType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
recordType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
length :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
arrayType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
qualident :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
type_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
typeDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
relation :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p RelOp
addOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
mulOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
actualParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Expression l l f f)]
expList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (Expression l l f f)))
unguardedDesignator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Designator l l f f)
designator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Designator l l f f))
element :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Element l l f f)
set :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Expression l l f f)
string_prod :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
charConstant :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
scaleFactor :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
real :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
hexDigit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
integer :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
number :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
factor :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
term :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
simpleExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
expression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
constExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
identdef :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentDef l)
constantDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
declarationSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Declaration l l f f)]
import_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Import l)
importList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [Import l]
digit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
letter :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
ident :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
module_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
..} = OberonGrammar
  l
  NodeWrap
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text)
g1{
   identdef :: Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef = Parser (OberonGrammar l NodeWrap) Text Text
ident 
              forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (forall l. Oberon l => Text -> IdentDef l
Abstract.exported forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"*" 
                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l. Oberon2 l => Text -> IdentDef l
Abstract.readOnly forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"-" 
                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall l. Wirthy l => Text -> IdentDef l
Abstract.identDef),
   
   string_prod :: Parser (OberonGrammar l NodeWrap) Text Text
string_prod = Parser (OberonGrammar l NodeWrap) Text Text
string_prod1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\'' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *).
InputParsing m =>
(ParserInput m -> Bool) -> m (ParserInput m)
takeWhile (forall a. Eq a => a -> a -> Bool
/= Text
"'") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\''),
   procedureHeading :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureHeading = Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureHeading1
                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l l' (f :: * -> *) (f' :: * -> *).
Oberon2 l =>
Bool
-> Text
-> Text
-> Bool
-> IdentDef l'
-> Maybe (f (FormalParameters l' l' f' f'))
-> ProcedureHeading l l' f' f
Abstract.typeBoundHeading forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"PROCEDURE"
                          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"("
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"VAR" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OberonGrammar l NodeWrap) Text Text
ident
                          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":"
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OberonGrammar l NodeWrap) Text Text
ident
                          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
")"
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"*" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
                          forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> do Text
n <- forall {a} {g :: (* -> *) -> *} {s}.
ParserT ((,) [a]) g s Text -> ParserT ((,) [a]) g s Text
clearConsumed (forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead Parser (OberonGrammar l NodeWrap) Text Text
ident)
                                  IdentDef l
idd <- Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef
                                  Maybe (NodeWrap (FormalParameters l l NodeWrap NodeWrap))
params <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
formalParameters)
                                  forall (f :: * -> *) a. Applicative f => a -> f a
pure (\IdentDef l
-> Maybe (NodeWrap (FormalParameters l l NodeWrap NodeWrap))
-> ProcedureHeading l l NodeWrap NodeWrap
proc-> (Text
n, IdentDef l
-> Maybe (NodeWrap (FormalParameters l l NodeWrap NodeWrap))
-> ProcedureHeading l l NodeWrap NodeWrap
proc IdentDef l
idd Maybe (NodeWrap (FormalParameters l l NodeWrap NodeWrap))
params)),
   arrayType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
arrayType =
      forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
[f (ConstExpression l' l' f' f')]
-> f (Type l' l' f' f') -> Type l l' f' f
Abstract.arrayType forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"ARRAY" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
length (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
",") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"OF" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
type_prod,
   forStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
forStatement = 
      forall l (f :: * -> *) l' (f' :: * -> *).
Oberon2 l =>
Text
-> f (Expression l' l' f' f')
-> f (Expression l' l' f' f')
-> Maybe (f (Expression l' l' f' f'))
-> f (StatementSequence l' l' f' f')
-> Statement l l' f' f
Abstract.forStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"FOR" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OberonGrammar l NodeWrap) Text Text
ident forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":=" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"TO" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"BY" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"DO"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END",
   withStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
withStatement = forall l (f :: * -> *) l' (f' :: * -> *).
Oberon2 l =>
NonEmpty (f (WithAlternative l' l' f' f'))
-> Maybe (f (StatementSequence l' l' f' f')) -> Statement l l' f' f
Abstract.variantWithStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"WITH"
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepByNonEmpty (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  (WithAlternative l l NodeWrap NodeWrap)
withAlternative) (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"|")
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"ELSE" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END"}
   where g1 :: OberonGrammar
  l
  NodeWrap
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text)
g1@OberonGrammar{string_prod :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
string_prod= Parser (OberonGrammar l NodeWrap) Text Text
string_prod1, procedureHeading :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Text, ProcedureHeading l l f f)
procedureHeading= Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureHeading1} = forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar OberonGrammar
  l
  NodeWrap
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text)
g
         withAlternative :: Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  (WithAlternative l l NodeWrap NodeWrap)
withAlternative = forall l l' (f :: * -> *) (f' :: * -> *).
Oberon l =>
QualIdent l'
-> QualIdent l'
-> f (StatementSequence l' l' f' f')
-> WithAlternative l l' f' f
Abstract.withAlternative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident
                                                    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"DO" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence

grammar :: forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar OberonGrammar{Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [Import l]
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
Parser (OberonGrammar l NodeWrap) Text (IdentList l)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Text (Import l)
Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
Parser (OberonGrammar l NodeWrap) Text (BaseType l)
Parser (OberonGrammar l NodeWrap) Text RelOp
Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
withStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
loopStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
forStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
repeatStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
whileStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
caseLabels :: Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
caseLabelList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
case_prod :: Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
caseStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
ifStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
procedureCall :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
assignment :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
statement :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
statementSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
forwardDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureBody :: Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
formalType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
fPSection :: Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
formalParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
procedureHeading :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
variableDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
pointerType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
identList :: Parser (OberonGrammar l NodeWrap) Text (IdentList l)
fieldList :: Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
fieldListSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
baseType :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
recordType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
length :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
arrayType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
qualident :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
type_prod :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
typeDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
relation :: Parser (OberonGrammar l NodeWrap) Text RelOp
addOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
mulOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
actualParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
expList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
unguardedDesignator :: Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
designator :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
element :: Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
set :: Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
string_prod :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
charConstant :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
scaleFactor :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
real :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
hexDigit :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
integer :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
number :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
factor :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
identdef :: Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
constantDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
declarationSequence :: Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
import_prod :: Parser (OberonGrammar l NodeWrap) Text (Import l)
importList :: Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [Import l]
digit :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
letter :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
module_prod :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
withStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
loopStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
forStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
repeatStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
whileStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
caseLabels :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (CaseLabels l l f f)
caseLabelList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (CaseLabels l l f f)))
case_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Case l l f f)
caseStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
ifStatement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
procedureCall :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
assignment :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Statement l l f f)
statement :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Statement l l f f))
statementSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (StatementSequence l l f f)
forwardDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureBody :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Block l l f f)
formalType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
fPSection :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FPSection l l f f)
formalParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FormalParameters l l f f)
procedureHeading :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Text, ProcedureHeading l l f f)
procedureDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
variableDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
procedureType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
pointerType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
identList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentList l)
fieldList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (FieldList l l f f)
fieldListSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (FieldList l l f f)]
baseType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
recordType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
length :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
arrayType :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
qualident :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (QualIdent l)
type_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Type l l f f)
typeDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
relation :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p RelOp
addOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
mulOperator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (BinOp l f)
actualParameters :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Expression l l f f)]
expList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (NonEmpty (f (Expression l l f f)))
unguardedDesignator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Designator l l f f)
designator :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Designator l l f f))
element :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Element l l f f)
set :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Expression l l f f)
string_prod :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
charConstant :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
scaleFactor :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
real :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
hexDigit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
integer :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
number :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Value l l f f)
factor :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
term :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
simpleExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
expression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
constExpression :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Expression l l f f))
identdef :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (IdentDef l)
constantDeclaration :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Declaration l l f f)
declarationSequence :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [f (Declaration l l f f)]
import_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (Import l)
importList :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p [Import l]
digit :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
letter :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
ident :: forall l (f :: * -> *) (p :: * -> *). OberonGrammar l f p -> p Text
module_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
..} = OberonGrammar{
   module_prod :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Module l l NodeWrap NodeWrap))
module_prod = forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap forall a b. (a -> b) -> a -> b
$
                 do forall (m :: * -> *). LexicalParsing m => m ()
lexicalWhiteSpace
                    forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"MODULE"
                    Text
name <- Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident
                    forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";"
                    [Import l]
imports <- forall (f :: * -> *) a. (Alternative f, Monoid (f a)) => f a -> f a
moptional Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [Import l]
importList
                    NodeWrap (Block l l NodeWrap NodeWrap)
body <- forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (Declaration l' l' f' f')]
-> Maybe (f (StatementSequence l' l' f' f')) -> Block l l' f' f
Abstract.block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
declarationSequence
                                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"BEGIN" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence)))
                    forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END"
                    forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
name)
                    forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"."
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
Text -> [Import l] -> f (Block l' l' f' f') -> Module l l' f' f
Abstract.moduleUnit Text
name [Import l]
imports NodeWrap (Block l l NodeWrap NodeWrap)
body),
   ident :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident = forall (m :: * -> *). LexicalParsing m => m (ParserInput m)
identifier,
   letter :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
letter = forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
satisfyCharInput Char -> Bool
isLetter,
   digit :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
digit = forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
satisfyCharInput Char -> Bool
isDigit,
   importList :: Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [Import l]
importList = forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"IMPORT" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 Parser (OberonGrammar l NodeWrap) Text (Import l)
import_prod (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
",") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";",
   import_prod :: Parser (OberonGrammar l NodeWrap) Text (Import l)
import_prod = forall l. Oberon l => Maybe Text -> Text -> Import l
Abstract.moduleImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":=") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident,
   declarationSequence :: Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
declarationSequence = forall (p :: * -> *) a. (Alternative p, Monoid a) => p a -> p a
concatMany (((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"CONST" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
constantDeclaration)
                                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
constantDeclaration)
                                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"TYPE" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
typeDeclaration)
                                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
typeDeclaration)
                                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"VAR" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
variableDeclaration)
                                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
variableDeclaration))
                                     forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"CONST" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"TYPE" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"VAR"))
                         forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureDeclaration forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";")
                                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
forwardDeclaration forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";"))
                         forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"declarations",
   constantDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
constantDeclaration = forall l l' (f :: * -> *) (f' :: * -> *).
Wirthy l =>
IdentDef l'
-> f (ConstExpression l' l' f' f') -> Declaration l l' f' f
Abstract.constantDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"=" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";",
   identdef :: Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef = Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (forall l. Oberon l => Text -> IdentDef l
Abstract.exported forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"*" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall l. Wirthy l => Text -> IdentDef l
Abstract.identDef),
   constExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression = Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression,
   expression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression = Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
RelOp
-> f (Expression l' l' f' f')
-> f (Expression l' l' f' f')
-> Expression l l' f' f
Abstract.relation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OberonGrammar l NodeWrap) Text RelOp
relation forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
f (Expression l' l' f' f') -> QualIdent l' -> Expression l l' f' f
Abstract.is forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"IS" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident)
                forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"expression",
   simpleExpression :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression = 
      (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.positive forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"+" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.negative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"-" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term :: Parser (OberonGrammar l NodeWrap) Text (Abstract.Expression l l NodeWrap NodeWrap)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term)
      forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) a. (Alternative p, Monoid a) => p a -> p a
concatMany (forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l (f :: * -> *).
BinOp l f
-> f (Expression l l f f)
-> f (Expression l l f f)
-> f (Expression l l f f)
applyBinOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
addOperator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term))),
   term :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term = Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
factor forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) a. (Alternative p, Monoid a) => p a -> p a
concatMany (forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l (f :: * -> *).
BinOp l f
-> f (Expression l l f f)
-> f (Expression l l f f)
-> f (Expression l l f f)
applyBinOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
mulOperator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
factor))),
   factor :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
factor = forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Value l' l' f' f') -> Expression l l' f' f
Abstract.literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
number
                                                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
charConstant
                                                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Text -> Value l l' f' f
Abstract.string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
string_prod
                                                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.nil forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"NIL")
                           forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
set
                           forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f') -> Expression l l' f' f
Abstract.read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
designator
                           forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f')
-> [f (Expression l' l' f' f')] -> Expression l l' f' f
Abstract.functionCall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
unguardedDesignator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
actualParameters
                           forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.not forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"~" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
factor :: Parser (OberonGrammar l NodeWrap) Text (Abstract.Expression l l NodeWrap NodeWrap)))
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression,
   number :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
number  =  Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
integer forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
real,
   integer :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
integer = forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Integer -> Value l l' f' f
Abstract.integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall a. (Eq a, Num a) => ReadS a
readDec forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile1 Char -> Bool
isDigit
                               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Eq a, Num a) => ReadS a
readHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
digit forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isHexDigit forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"H")),
   hexDigit :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
hexDigit = forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
satisfyCharInput Char -> Bool
isHexDigit,
   real :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
real = forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Double -> Value l l' f' f
Abstract.real forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFrac a => ReadS a
readFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile1 Char -> Bool
isDigit forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"." forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isDigit forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. (Alternative f, Monoid (f a)) => f a -> f a
moptional Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
scaleFactor),
   scaleFactor :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
scaleFactor = (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"E" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
"E" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"D") forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. (Alternative f, Monoid (f a)) => f a -> f a
moptional (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"+" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"-") forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile1 Char -> Bool
isDigit,
   charConstant :: Parser
  (OberonGrammar l NodeWrap) Text (Value l l NodeWrap NodeWrap)
charConstant = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Int -> Value l l' f' f
Abstract.charCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => ReadS a
readHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
                                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
digit forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isHexDigit forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
"X")),
   string_prod :: Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
string_prod = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *).
InputParsing m =>
(ParserInput m -> Bool) -> m (ParserInput m)
takeWhile (forall a. Eq a => a -> a -> Bool
/= Text
"\"") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"'),
   set :: Parser
  (OberonGrammar l NodeWrap) Text (Expression l l NodeWrap NodeWrap)
set = forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
[f (Element l' l' f' f')] -> Expression l l' f' f
Abstract.set forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. TokenParsing m => m a -> m a
braces (forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
element) (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
",")),
   element :: Parser
  (OberonGrammar l NodeWrap) Text (Element l l NodeWrap NodeWrap)
element = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f') -> Element l l' f' f
Abstract.element forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression
             forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Element l l' f' f
Abstract.range forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
".." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression,
   designator :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
designator = forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous (Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
unguardedDesignator
                               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
f (Designator l' l' f' f') -> QualIdent l' -> Designator l l' f' f
Abstract.typeGuard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
designator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident),
   unguardedDesignator :: Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
unguardedDesignator = forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Designator l l' f' f
Abstract.variable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident
                         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f') -> Text -> Designator l l' f' f
Abstract.field forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
designator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident
                         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f')
-> NonEmpty (f (Expression l' l' f' f')) -> Designator l l' f' f
Abstract.index @l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
designator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. TokenParsing m => m a -> m a
brackets Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
expList
                         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f') -> Designator l l' f' f
Abstract.dereference forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
designator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"^",
   expList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
expList = forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepByNonEmpty Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
","),
   actualParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
actualParameters = forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens (forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
",")),
   mulOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
mulOperator = forall l (f :: * -> *).
(f (Expression l l f f)
 -> f (Expression l l f f) -> f (Expression l l f f))
-> BinOp l f
BinOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(NodeWrap a -> NodeWrap a -> a)
-> NodeWrap a -> NodeWrap a -> NodeWrap a
wrapBinary
                 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.multiply forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"*" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.divide forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"/"
                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.integerDivide forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"DIV" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.modulo forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"MOD" 
                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.and forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"&"),
   addOperator :: Parser (OberonGrammar l NodeWrap) Text (BinOp l NodeWrap)
addOperator = forall l (f :: * -> *).
(f (Expression l l f f)
 -> f (Expression l l f f) -> f (Expression l l f f))
-> BinOp l f
BinOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(NodeWrap a -> NodeWrap a -> a)
-> NodeWrap a -> NodeWrap a -> NodeWrap a
wrapBinary 
                 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.add forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"+" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.subtract forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"-" 
                      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (Expression l' l' f' f') -> Expression l l' f' f
Abstract.or forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"OR"),
   relation :: Parser (OberonGrammar l NodeWrap) Text RelOp
relation = RelOp
Abstract.Equal forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"=" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelOp
Abstract.Unequal forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"#" 
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelOp
Abstract.Less forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"<" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelOp
Abstract.LessOrEqual forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
"<=" 
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelOp
Abstract.Greater forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
">" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelOp
Abstract.GreaterOrEqual forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
">=" 
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelOp
Abstract.In forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"IN",
   typeDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
typeDeclaration = forall l l' (f :: * -> *) (f' :: * -> *).
Wirthy l =>
IdentDef l' -> f (Type l' l' f' f') -> Declaration l l' f' f
Abstract.typeDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"=" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
type_prod forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";",
   type_prod :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
type_prod = forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident 
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
arrayType 
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
recordType 
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
pointerType
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
procedureType,
   qualident :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident = forall l. Oberon l => Text -> Text -> QualIdent l
Abstract.qualIdent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident,
   arrayType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
arrayType = forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
[f (ConstExpression l' l' f' f')]
-> f (Type l' l' f' f') -> Type l l' f' f
Abstract.arrayType forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"ARRAY" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
length (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
",") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"OF" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
type_prod,
   length :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
length = Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression,
   recordType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
recordType = forall l l' (f :: * -> *) (f' :: * -> *).
Oberon l =>
Maybe (BaseType l')
-> [f (FieldList l' l' f' f')] -> Type l l' f' f
Abstract.recordType forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"RECORD" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens Parser (OberonGrammar l NodeWrap) Text (BaseType l)
baseType)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
fieldListSequence forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END",
   baseType :: Parser (OberonGrammar l NodeWrap) Text (BaseType l)
baseType = Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident,
   fieldListSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
fieldListSequence = forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
fieldList) (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";"),
   fieldList :: Parser
  (OberonGrammar l NodeWrap) Text (FieldList l l NodeWrap NodeWrap)
fieldList = forall l l' (f :: * -> *) (f' :: * -> *).
Wirthy l =>
NonEmpty (IdentDef l')
-> f (Type l' l' f' f') -> FieldList l l' f' f
Abstract.fieldList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (IdentList l)
identList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
type_prod forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"record field declarations",
   identList :: Parser (OberonGrammar l NodeWrap) Text (IdentList l)
identList = forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepByNonEmpty Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
","),
   pointerType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
pointerType = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Type l' l' f' f') -> Type l l' f' f
Abstract.pointerType forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"POINTER" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"TO" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
type_prod,
   procedureType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
procedureType = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Maybe (f (FormalParameters l' l' f' f')) -> Type l l' f' f
Abstract.procedureType forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"PROCEDURE" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
formalParameters),
   variableDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
variableDeclaration = forall l l' (f :: * -> *) (f' :: * -> *).
Wirthy l =>
IdentList l' -> f (Type l' l' f' f') -> Declaration l l' f' f
Abstract.variableDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (IdentList l)
identList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
type_prod forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";",
   procedureDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
procedureDeclaration = do (Text
procedureName, Compose
  ((,) (Down Int, Down Int))
  (Compose Ambiguous ((,) ParsedLexemes))
  (ProcedureHeading l l NodeWrap NodeWrap)
heading) <- forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureHeading
                             forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";"
                             NodeWrap (Block l l NodeWrap NodeWrap)
body <- forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
procedureBody
                             forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
procedureName)
                             forall (m :: * -> *) a. Monad m => a -> m a
return (forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (ProcedureHeading l' l' f' f')
-> f (Block l' l' f' f') -> Declaration l l' f' f
Abstract.procedureDeclaration Compose
  ((,) (Down Int, Down Int))
  (Compose Ambiguous ((,) ParsedLexemes))
  (ProcedureHeading l l NodeWrap NodeWrap)
heading NodeWrap (Block l l NodeWrap NodeWrap)
body),
   procedureHeading :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (Text, ProcedureHeading l l NodeWrap NodeWrap)
procedureHeading = forall l l' (f :: * -> *) (f' :: * -> *).
Oberon l =>
Bool
-> IdentDef l'
-> Maybe (f (FormalParameters l' l' f' f'))
-> ProcedureHeading l l' f' f
Abstract.procedureHeading forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"PROCEDURE" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"*" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
                      forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> do Text
n <- forall {a} {g :: (* -> *) -> *} {s}.
ParserT ((,) [a]) g s Text -> ParserT ((,) [a]) g s Text
clearConsumed (forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident)
                              IdentDef l
idd <- Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef
                              Maybe (NodeWrap (FormalParameters l l NodeWrap NodeWrap))
params <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
formalParameters)
                              forall (m :: * -> *) a. Monad m => a -> m a
return (\IdentDef l
-> Maybe (NodeWrap (FormalParameters l l NodeWrap NodeWrap))
-> ProcedureHeading l l NodeWrap NodeWrap
proc-> (Text
n, IdentDef l
-> Maybe (NodeWrap (FormalParameters l l NodeWrap NodeWrap))
-> ProcedureHeading l l NodeWrap NodeWrap
proc IdentDef l
idd Maybe (NodeWrap (FormalParameters l l NodeWrap NodeWrap))
params)),
   formalParameters :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
formalParameters = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens (forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
fPSection) (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";"))
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident),
   fPSection :: Parser
  (OberonGrammar l NodeWrap) Text (FPSection l l NodeWrap NodeWrap)
fPSection = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"VAR" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) 
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 Fixed
  (ParserT ((,) [[Lexeme]])) (OberonGrammar l NodeWrap) Text Text
ident (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
",") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
formalType,
   formalType :: Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
formalType = forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
[f (ConstExpression l' l' f' f')]
-> f (Type l' l' f' f') -> Type l l' f' f
Abstract.arrayType [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"ARRAY" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"OF" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Type l l NodeWrap NodeWrap)
formalType 
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Maybe (f (FormalParameters l' l' f' f')) -> Type l l' f' f
Abstract.procedureType forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"PROCEDURE" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
formalParameters),
   procedureBody :: Parser
  (OberonGrammar l NodeWrap) Text (Block l l NodeWrap NodeWrap)
procedureBody = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (Declaration l' l' f' f')]
-> Maybe (f (StatementSequence l' l' f' f')) -> Block l l' f' f
Abstract.block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed
  (ParserT ((,) [[Lexeme]]))
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
declarationSequence
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"BEGIN" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END",
   forwardDeclaration :: Parser
  (OberonGrammar l NodeWrap) Text (Declaration l l NodeWrap NodeWrap)
forwardDeclaration = forall l l' (f :: * -> *) (f' :: * -> *).
Oberon l =>
IdentDef l'
-> Maybe (f (FormalParameters l' l' f' f'))
-> Declaration l l' f' f
Abstract.forwardDeclaration forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"PROCEDURE" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"^"
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OberonGrammar l NodeWrap) Text (IdentDef l)
identdef forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (FormalParameters l l NodeWrap NodeWrap)
formalParameters),
   statementSequence :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (Statement l' l' f' f')] -> StatementSequence l l' f' f
Abstract.statementSequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
statement (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
";"),
   statement :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Statement l l NodeWrap NodeWrap))
statement = forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous (Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
assignment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
procedureCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
ifStatement forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
caseStatement 
                              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
whileStatement forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
repeatStatement forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
loopStatement
                              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
forStatement forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
withStatement 
                              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Statement l l' f' f
Abstract.exitStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"EXIT" 
                              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Maybe (f (Expression l' l' f' f')) -> Statement l l' f' f
Abstract.returnStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"RETURN" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression
                              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Statement l l' f' f
Abstract.emptyStatement)
               forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"statement",
   assignment :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
assignment  =  forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f')
-> f (Expression l' l' f' f') -> Statement l l' f' f
Abstract.assignment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Designator l l NodeWrap NodeWrap))
designator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":=" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression,
   procedureCall :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
procedureCall = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f')
-> Maybe [f (Expression l' l' f' f')] -> Statement l l' f' f
Abstract.procedureCall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous Parser
  (OberonGrammar l NodeWrap) Text (Designator l l NodeWrap NodeWrap)
unguardedDesignator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser
  (OberonGrammar l NodeWrap)
  Text
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
actualParameters,
   ifStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
ifStatement = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
NonEmpty (f (ConditionalBranch l' l' f' f'))
-> Maybe (f (StatementSequence l' l' f' f')) -> Statement l l' f' f
Abstract.ifStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"IF"
       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepByNonEmpty (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (StatementSequence l' l' f' f') -> ConditionalBranch l l' f' f
Abstract.conditionalBranch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"THEN" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence)
                         (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"ELSIF")
       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"ELSE" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END",
   caseStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
caseStatement = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> [f (Case l' l' f' f')]
-> Maybe (f (StatementSequence l' l' f' f'))
-> Statement l l' f' f
Abstract.caseStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"CASE" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression
       forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"OF" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
case_prod) (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
"|"))
       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"ELSE" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END",
   case_prod :: Parser (OberonGrammar l NodeWrap) Text (Case l l NodeWrap NodeWrap)
case_prod = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
NonEmpty (f (CaseLabels l' l' f' f'))
-> f (StatementSequence l' l' f' f') -> Case l l' f' f
Abstract.caseAlternative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
caseLabelList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence,
   caseLabelList :: Parser
  (OberonGrammar l NodeWrap)
  Text
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
caseLabelList = forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepByNonEmpty (forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
caseLabels) (forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
","),
   caseLabels :: Parser
  (OberonGrammar l NodeWrap) Text (CaseLabels l l NodeWrap NodeWrap)
caseLabels = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (ConstExpression l' l' f' f') -> CaseLabels l l' f' f
Abstract.singleLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (ConstExpression l' l' f' f')
-> f (ConstExpression l' l' f' f') -> CaseLabels l l' f' f
Abstract.labelRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
".." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression,
   whileStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
whileStatement = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Expression l' l' f' f')
-> f (StatementSequence l' l' f' f') -> Statement l l' f' f
Abstract.whileStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"WHILE" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"DO"
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END",
   repeatStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
repeatStatement = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (StatementSequence l' l' f' f')
-> f (Expression l' l' f' f') -> Statement l l' f' f
Abstract.repeatStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"REPEAT"
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"UNTIL" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (OberonGrammar l NodeWrap)
  Text
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression,
   loopStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
loopStatement = forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (StatementSequence l' l' f' f') -> Statement l l' f' f
Abstract.loopStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"LOOP" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END",
   forStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
forStatement = forall (f :: * -> *) a. Alternative f => f a
empty,
   withStatement :: Parser
  (OberonGrammar l NodeWrap) Text (Statement l l NodeWrap NodeWrap)
withStatement = forall l (f :: * -> *) l' (f' :: * -> *).
Oberon l =>
f (WithAlternative l' l' f' f') -> Statement l l' f' f
Abstract.withStatement forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"WITH"
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap (forall l l' (f :: * -> *) (f' :: * -> *).
Oberon l =>
QualIdent l'
-> QualIdent l'
-> f (StatementSequence l' l' f' f')
-> WithAlternative l l' f' f
Abstract.withAlternative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OberonGrammar l NodeWrap) Text (BaseType l)
qualident
                             forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"DO" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap Parser
  (OberonGrammar l NodeWrap)
  Text
  (StatementSequence l l NodeWrap NodeWrap)
statementSequence)
                   forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). LexicalParsing m => ParserInput m -> m ()
keyword Text
"END"}

wrapBinary :: (NodeWrap a -> NodeWrap a -> a) -> (NodeWrap a -> NodeWrap a -> NodeWrap a)
wrapBinary :: forall a.
(NodeWrap a -> NodeWrap a -> a)
-> NodeWrap a -> NodeWrap a -> NodeWrap a
wrapBinary NodeWrap a -> NodeWrap a -> a
op a :: NodeWrap a
a@(Compose ((Down Int, Down Int)
pos, Compose Ambiguous ((,) ParsedLexemes) a
_)) NodeWrap a
b = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((Down Int, Down Int)
pos, forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Lexeme] -> ParsedLexemes
Trailing [], NodeWrap a -> NodeWrap a -> a
op NodeWrap a
a NodeWrap a
b))

moptional :: (Alternative f, Monoid (f a)) => f a -> f a
moptional :: forall (f :: * -> *) a. (Alternative f, Monoid (f a)) => f a -> f a
moptional f a
p = f a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Monoid a => a
mempty

delimiter, operator :: Abstract.Oberon l => Text -> Parser (OberonGrammar l f) Text Text

delimiter :: forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
delimiter Text
s = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s a (g :: (* -> *) -> *).
(Applicative m, Ord s) =>
m a -> ParserT m g s a
lift ([[TokenType -> Text -> Lexeme
Token TokenType
Delimiter Text
s]], ())) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"delimiter " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
s)
operator :: forall l (f :: * -> *).
Oberon l =>
Text -> Parser (OberonGrammar l f) Text Text
operator Text
s = forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s a (g :: (* -> *) -> *).
(Applicative m, Ord s) =>
m a -> ParserT m g s a
lift ([[TokenType -> Text -> Lexeme
Token TokenType
Operator Text
s]], ())) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"operator " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
s)

reservedWords :: [Text]
reservedWords :: [Text]
reservedWords = [Text
"ARRAY", Text
"IMPORT", Text
"RETURN",
                 Text
"BEGIN", Text
"IN", Text
"THEN",
                 Text
"BY", Text
"IS", Text
"TO",
                 Text
"CASE", Text
"LOOP", Text
"TYPE",
                 Text
"DIV", Text
"MODULE", Text
"VAR",
                 Text
"DO", Text
"NIL", Text
"WHILE",
                 Text
"ELSE", Text
"OF", Text
"WITH",
                 Text
"ELSIF", Text
"OR",
                 Text
"END", Text
"POINTER",
                 Text
"EXIT", Text
"PROCEDURE",
                 Text
"FOR", Text
"RECORD",
                 Text
"IF", Text
"REPEAT"]

{-
https://cseweb.ucsd.edu/~wgg/CSE131B/oberon2.htm

Module       = MODULE ident ";" [ImportList] DeclSeq
               [BEGIN StatementSeq] END ident ".".
ImportList   = IMPORT [ident ":="] ident {"," [ident ":="] ident} ";".
DeclSeq      = { CONST {ConstDecl ";" } | TYPE {TypeDecl ";"}
                 | VAR {VarDecl ";"}} {ProcDecl ";" | ForwardDecl ";"}.
ConstDecl    = IdentDef "=" ConstExpr.
TypeDecl     = IdentDef "=" Type.
VarDecl      = IdentList ":" Type.
ProcDecl     = PROCEDURE [Receiver] IdentDef [FormalPars] ";" DeclSeq
               [BEGIN StatementSeq] END ident.
ForwardDecl  = PROCEDURE "^" [Receiver] IdentDef [FormalPars].
FormalPars   = "(" [FPSection {";" FPSection}] ")" [":" Qualident].
FPSection    = [VAR] ident {"," ident} ":" Type.
Receiver     = "(" [VAR] ident ":" ident ")".
Type         = Qualident
             | ARRAY [ConstExpr {"," ConstExpr}] OF Type
             | RECORD ["("Qualident")"] FieldList {";" FieldList} END
             | POINTER TO Type
             | PROCEDURE [FormalPars].
FieldList    = [IdentList ":" Type].
StatementSeq = Statement {";" Statement}.
Statement    = [ Designator ":=" Expr 
             | Designator ["(" [ExprList] ")"] 
             | IF Expr THEN StatementSeq {ELSIF Expr THEN StatementSeq}
               [ELSE StatementSeq] END 
             | CASE Expr OF Case {"|" Case} [ELSE StatementSeq] END 
             | WHILE Expr DO StatementSeq END 
             | REPEAT StatementSeq UNTIL Expr 
             | FOR ident ":=" Expr TO Expr [BY ConstExpr] DO StatementSeq END 
             | LOOP StatementSeq END
             | WITH Guard DO StatementSeq {"|" Guard DO StatementSeq}
               [ELSE StatementSeq] END
             | EXIT 
             | RETURN [Expr]
             ].
Case         = [CaseLabels {"," CaseLabels} ":" StatementSeq].
CaseLabels   = ConstExpr [".." ConstExpr].
Guard        = Qualident ":" Qualident.
ConstExpr    = Expr.
Expr         = SimpleExpr [Relation SimpleExpr].
SimpleExpr   = ["+" | "-"] Term {AddOp Term}.
Term         = Factor {MulOp Factor}.
Factor       = Designator ["(" [ExprList] ")"] | number | character | string
               | NIL | Set | "(" Expr ")" | " ~ " Factor.
Set          = "{" [Element {"," Element}] "}".
Element      = Expr [".." Expr].
Relation     = "=" | "#" | "<" | "<=" | ">" | ">=" | IN | IS.
AddOp        = "+" | "-" | OR.
MulOp        = " * " | "/" | DIV | MOD | "&".
Designator   = Qualident {"." ident | "[" ExprList "]" | " ^ "
               | "(" Qualident ")"}.
ExprList     = Expr {"," Expr}.
IdentList    = IdentDef {"," IdentDef}.
Qualident    = [ident "."] ident.
IdentDef     = ident [" * " | "-"].
-}

{-
EBNF definition of a Module Definition ( .Def)

A module definition follows the Oberon grammar. The only differences are in the productions:

module  =  DEFINITION ident ";"  [ImportList] DeclarationSequence END ident ".".

where the body is removed and in:

ProcedureDeclaration  = ProcedureHeading ";"

where ProcedureBody and ident are removed. All the productions from ProcedureBody may be ignored. Depending on the tool (Watson or Browser), the export marks may or may not be included in the output.

12 Jul 2002 - Copyright © 2002 ETH Zürich. All rights reserved.
E-Mail: oberon-web at inf.ethz.ch
Homepage: www.ethoberon.ethz.ch {http://www.ethoberon.ethz.ch/}
-}