{-# 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.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.LeftRecursive.Transformer (ParserT, lift, tmap)
import Text.Parser.Token (braces, brackets, parens)

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

newtype BinOp l f = BinOp {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 = String -> BinOp l f -> String
forall a b. a -> b -> a
const String
"BinOp{}"

$(Rank2.TH.deriveAll ''OberonGrammar)

type Parser = ParserT ((,) [[Lexeme]])
data Lexeme = WhiteSpace{Lexeme -> Ident
lexemeText :: Text}
            | Comment{lexemeText :: Text}
            | Token{Lexeme -> TokenType
lexemeType :: TokenType,
                    lexemeText :: Text}
            deriving (Typeable Lexeme
DataType
Constr
Typeable Lexeme
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Lexeme -> c Lexeme)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Lexeme)
-> (Lexeme -> Constr)
-> (Lexeme -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Lexeme -> Lexeme)
-> (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 u. (forall d. Data d => d -> u) -> Lexeme -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Lexeme -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Lexeme -> m Lexeme)
-> Data Lexeme
Lexeme -> DataType
Lexeme -> Constr
(forall b. Data b => b -> b) -> Lexeme -> Lexeme
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lexeme -> c Lexeme
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cToken :: Constr
$cComment :: Constr
$cWhiteSpace :: Constr
$tLexeme :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Lexeme -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Lexeme -> u
gmapQ :: (forall d. Data d => d -> u) -> Lexeme -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Lexeme -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Lexeme
Data, Lexeme -> Lexeme -> Bool
(Lexeme -> Lexeme -> Bool)
-> (Lexeme -> Lexeme -> Bool) -> Eq Lexeme
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
(Int -> Lexeme -> ShowS)
-> (Lexeme -> String) -> ([Lexeme] -> ShowS) -> Show Lexeme
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
DataType
Constr
Typeable TokenType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TokenType -> c TokenType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TokenType)
-> (TokenType -> Constr)
-> (TokenType -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> TokenType -> TokenType)
-> (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 u. (forall d. Data d => d -> u) -> TokenType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TokenType -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenType -> m TokenType)
-> Data TokenType
TokenType -> DataType
TokenType -> Constr
(forall b. Data b => b -> b) -> TokenType -> TokenType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenType -> c TokenType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cOther :: Constr
$cOperator :: Constr
$cKeyword :: Constr
$cDelimiter :: Constr
$tTokenType :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> TokenType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenType -> u
gmapQ :: (forall d. Data d => d -> u) -> TokenType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TokenType -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable TokenType
Data, TokenType -> TokenType -> Bool
(TokenType -> TokenType -> Bool)
-> (TokenType -> TokenType -> Bool) -> Eq TokenType
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
(Int -> TokenType -> ShowS)
-> (TokenType -> String)
-> ([TokenType] -> ShowS)
-> Show TokenType
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 ((,) (Position, Position)) (Compose Ambiguous ((,) ParsedLexemes))

newtype ParsedLexemes = Trailing [Lexeme]
                      deriving (Typeable ParsedLexemes
DataType
Constr
Typeable ParsedLexemes
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ParsedLexemes -> c ParsedLexemes)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParsedLexemes)
-> (ParsedLexemes -> Constr)
-> (ParsedLexemes -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> ParsedLexemes -> ParsedLexemes)
-> (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 u. (forall d. Data d => d -> u) -> ParsedLexemes -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParsedLexemes -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParsedLexemes -> m ParsedLexemes)
-> Data ParsedLexemes
ParsedLexemes -> DataType
ParsedLexemes -> Constr
(forall b. Data b => b -> b) -> ParsedLexemes -> ParsedLexemes
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedLexemes -> c ParsedLexemes
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cTrailing :: Constr
$tParsedLexemes :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> ParsedLexemes -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedLexemes -> u
gmapQ :: (forall d. Data d => d -> u) -> ParsedLexemes -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedLexemes -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable ParsedLexemes
Data, Int -> ParsedLexemes -> ShowS
[ParsedLexemes] -> ShowS
ParsedLexemes -> String
(Int -> ParsedLexemes -> ShowS)
-> (ParsedLexemes -> String)
-> ([ParsedLexemes] -> ShowS)
-> Show ParsedLexemes
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, b -> ParsedLexemes -> ParsedLexemes
NonEmpty ParsedLexemes -> ParsedLexemes
ParsedLexemes -> ParsedLexemes -> ParsedLexemes
(ParsedLexemes -> ParsedLexemes -> ParsedLexemes)
-> (NonEmpty ParsedLexemes -> ParsedLexemes)
-> (forall b. Integral b => b -> ParsedLexemes -> ParsedLexemes)
-> Semigroup 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 :: 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
Semigroup ParsedLexemes
-> ParsedLexemes
-> (ParsedLexemes -> ParsedLexemes -> ParsedLexemes)
-> ([ParsedLexemes] -> ParsedLexemes)
-> Monoid 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
$cp1Monoid :: Semigroup ParsedLexemes
Monoid)

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

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

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

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

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

wrapAmbiguous, wrap :: Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous :: Parser g Ident a -> Parser g Ident (NodeWrap a)
wrapAmbiguous = Parser g Ident a -> Parser g Ident (NodeWrap a)
forall (g :: (* -> *) -> *) a.
Parser g Ident a -> Parser g Ident (NodeWrap a)
wrap
wrap :: Parser g Ident a -> Parser g Ident (NodeWrap a)
wrap = (((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a)
-> NodeWrap a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a)
 -> NodeWrap a)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Ident
     ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a)
-> Parser g Ident (NodeWrap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Fixed
   (ParserT ((,) [[Lexeme]]))
   g
   Ident
   ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a)
 -> Parser g Ident (NodeWrap a))
-> (Parser g Ident a
    -> Fixed
         (ParserT ((,) [[Lexeme]]))
         g
         Ident
         ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a))
-> Parser g Ident a
-> Parser g Ident (NodeWrap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Ident
  (Compose Ambiguous ((,) ParsedLexemes) a)
p-> (Position
 -> Compose Ambiguous ((,) ParsedLexemes) a
 -> Position
 -> ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a))
-> Fixed (ParserT ((,) [[Lexeme]])) g Ident Position
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Ident
     (Compose Ambiguous ((,) ParsedLexemes) a)
-> Fixed (ParserT ((,) [[Lexeme]])) g Ident Position
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Ident
     ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Position
-> Compose Ambiguous ((,) ParsedLexemes) a
-> Position
-> ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a)
forall a b b. a -> b -> b -> ((a, b), b)
surround Fixed (ParserT ((,) [[Lexeme]])) g Ident Position
forall (m :: * -> *). InputParsing m => m Position
getSourcePos Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Ident
  (Compose Ambiguous ((,) ParsedLexemes) a)
p Fixed (ParserT ((,) [[Lexeme]])) g Ident Position
forall (m :: * -> *). InputParsing m => m Position
getSourcePos)
         (Fixed
   (ParserT ((,) [[Lexeme]]))
   g
   Ident
   (Compose Ambiguous ((,) ParsedLexemes) a)
 -> Fixed
      (ParserT ((,) [[Lexeme]]))
      g
      Ident
      ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a))
-> (Parser g Ident a
    -> Fixed
         (ParserT ((,) [[Lexeme]]))
         g
         Ident
         (Compose Ambiguous ((,) ParsedLexemes) a))
-> Parser g Ident a
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Ident
     ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ambiguous (ParsedLexemes, a)
-> Compose Ambiguous ((,) ParsedLexemes) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Ambiguous (ParsedLexemes, a)
 -> Compose Ambiguous ((,) ParsedLexemes) a)
-> Fixed
     (ParserT ((,) [[Lexeme]])) g Ident (Ambiguous (ParsedLexemes, a))
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Ident
     (Compose Ambiguous ((,) ParsedLexemes) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Fixed
   (ParserT ((,) [[Lexeme]])) g Ident (Ambiguous (ParsedLexemes, a))
 -> Fixed
      (ParserT ((,) [[Lexeme]]))
      g
      Ident
      (Compose Ambiguous ((,) ParsedLexemes) a))
-> (Parser g Ident a
    -> Fixed
         (ParserT ((,) [[Lexeme]])) g Ident (Ambiguous (ParsedLexemes, a)))
-> Parser g Ident a
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Ident
     (Compose Ambiguous ((,) ParsedLexemes) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a)
-> Fixed
     (ParserT ((,) [[Lexeme]])) g Ident (Ambiguous (ParsedLexemes, a))
forall (m :: * -> *) a.
AmbiguousParsing m =>
m a -> m (Ambiguous a)
ambiguous (Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a)
 -> Fixed
      (ParserT ((,) [[Lexeme]])) g Ident (Ambiguous (ParsedLexemes, a)))
-> (Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a)
    -> Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a))
-> Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a)
-> Fixed
     (ParserT ((,) [[Lexeme]])) g Ident (Ambiguous (ParsedLexemes, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([[Lexeme]], (ParsedLexemes, a))
 -> ([[Lexeme]], (ParsedLexemes, a)))
-> Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a)
-> Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a)
forall (m :: * -> *) a (g :: (* -> *) -> *) s.
(m a -> m a) -> ParserT m g s a -> ParserT m g s a
tmap ([[Lexeme]], (ParsedLexemes, a))
-> ([[Lexeme]], (ParsedLexemes, a))
forall a (t :: * -> *) b.
(Monoid a, Foldable t) =>
(t [Lexeme], (ParsedLexemes, b)) -> (a, (ParsedLexemes, b))
store) (Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a)
 -> Fixed
      (ParserT ((,) [[Lexeme]])) g Ident (Ambiguous (ParsedLexemes, a)))
-> (Parser g Ident a
    -> Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a))
-> Parser g Ident a
-> Fixed
     (ParserT ((,) [[Lexeme]])) g Ident (Ambiguous (ParsedLexemes, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,) ([Lexeme] -> ParsedLexemes
Trailing []) (a -> (ParsedLexemes, a))
-> Parser g Ident a
-> Fixed (ParserT ((,) [[Lexeme]])) g Ident (ParsedLexemes, a)
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)) = (a
forall a. Monoid a => a
mempty, ([Lexeme] -> ParsedLexemes
Trailing (t [Lexeme] -> [Lexeme]
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 Ident
oberonGrammar = (Grammar (OberonGrammar Language NodeWrap) Parser Ident
 -> Grammar (OberonGrammar Language NodeWrap) Parser Ident)
-> Grammar (OberonGrammar Language NodeWrap) Parser Ident
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
fixGrammar Grammar (OberonGrammar Language NodeWrap) Parser Ident
-> Grammar (OberonGrammar Language NodeWrap) Parser Ident
forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
grammar
-- | Grammar of an Oberon-2 module
oberon2Grammar :: Grammar (OberonGrammar Language NodeWrap) Parser Ident
oberon2Grammar = (Grammar (OberonGrammar Language NodeWrap) Parser Ident
 -> Grammar (OberonGrammar Language NodeWrap) Parser Ident)
-> Grammar (OberonGrammar Language NodeWrap) Parser Ident
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
fixGrammar Grammar (OberonGrammar Language NodeWrap) Parser Ident
-> Grammar (OberonGrammar Language NodeWrap) Parser Ident
forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
grammar2
-- | Grammar of an Oberon definition module
oberonDefinitionGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Ident
oberonDefinitionGrammar = (Grammar (OberonGrammar Language NodeWrap) Parser Ident
 -> Grammar (OberonGrammar Language NodeWrap) Parser Ident)
-> Grammar (OberonGrammar Language NodeWrap) Parser Ident
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
fixGrammar Grammar (OberonGrammar Language NodeWrap) Parser Ident
-> Grammar (OberonGrammar Language NodeWrap) Parser Ident
forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
definitionGrammar
-- | Grammar of an Oberon-2 definition module
oberon2DefinitionGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Ident
oberon2DefinitionGrammar = (Grammar (OberonGrammar Language NodeWrap) Parser Ident
 -> Grammar (OberonGrammar Language NodeWrap) Parser Ident)
-> Grammar (OberonGrammar Language NodeWrap) Parser Ident
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
fixGrammar Grammar (OberonGrammar Language NodeWrap) Parser Ident
-> Grammar (OberonGrammar Language NodeWrap) Parser Ident
forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
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 :: GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
definitionGrammar g :: OberonGrammar l NodeWrap (Parser (OberonGrammar l NodeWrap) Ident)
g@OberonGrammar{Parser
  (OberonGrammar l NodeWrap)
  Ident
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Ident
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
Parser
  (OberonGrammar l NodeWrap)
  Ident
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
Parser (OberonGrammar l NodeWrap) Ident [Import l]
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (Ident, ProcedureHeading l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Ident Ident
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Module l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Statement l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Expression l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Designator l l NodeWrap NodeWrap))
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
Parser (OberonGrammar l NodeWrap) Ident (IdentList l)
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (Declaration l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (Type l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (Expression l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (Designator l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (Value l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (FieldList l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (FormalParameters l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (FPSection l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (Block l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap)
  Ident
  (StatementSequence l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (Case l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (CaseLabels l l NodeWrap NodeWrap)
Parser
  (OberonGrammar l NodeWrap) Ident (Element l l NodeWrap NodeWrap)
Parser (OberonGrammar l NodeWrap) Ident (Import l)
Parser (OberonGrammar l NodeWrap) Ident (IdentDef l)
Parser (OberonGrammar l NodeWrap) Ident (BaseType l)
Parser (OberonGrammar l NodeWrap) Ident RelOp
Parser (OberonGrammar l NodeWrap) Ident (BinOp l NodeWrap)
withStatement :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
loopStatement :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
forStatement :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
repeatStatement :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
whileStatement :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
caseLabels :: Parser
  (OberonGrammar l NodeWrap) Ident (CaseLabels l l NodeWrap NodeWrap)
caseLabelList :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NonEmpty (NodeWrap (CaseLabels l l NodeWrap NodeWrap)))
case_prod :: Parser
  (OberonGrammar l NodeWrap) Ident (Case l l NodeWrap NodeWrap)
caseStatement :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
ifStatement :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
procedureCall :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
assignment :: Parser
  (OberonGrammar l NodeWrap) Ident (Statement l l NodeWrap NodeWrap)
statement :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Statement l l NodeWrap NodeWrap))
statementSequence :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (StatementSequence l l NodeWrap NodeWrap)
forwardDeclaration :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (Declaration l l NodeWrap NodeWrap)
procedureBody :: Parser
  (OberonGrammar l NodeWrap) Ident (Block l l NodeWrap NodeWrap)
formalType :: Parser
  (OberonGrammar l NodeWrap) Ident (Type l l NodeWrap NodeWrap)
fPSection :: Parser
  (OberonGrammar l NodeWrap) Ident (FPSection l l NodeWrap NodeWrap)
formalParameters :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (FormalParameters l l NodeWrap NodeWrap)
procedureHeading :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (Ident, ProcedureHeading l l NodeWrap NodeWrap)
procedureDeclaration :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (Declaration l l NodeWrap NodeWrap)
variableDeclaration :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (Declaration l l NodeWrap NodeWrap)
procedureType :: Parser
  (OberonGrammar l NodeWrap) Ident (Type l l NodeWrap NodeWrap)
pointerType :: Parser
  (OberonGrammar l NodeWrap) Ident (Type l l NodeWrap NodeWrap)
identList :: Parser (OberonGrammar l NodeWrap) Ident (IdentList l)
fieldList :: Parser
  (OberonGrammar l NodeWrap) Ident (FieldList l l NodeWrap NodeWrap)
fieldListSequence :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  [NodeWrap (FieldList l l NodeWrap NodeWrap)]
baseType :: Parser (OberonGrammar l NodeWrap) Ident (BaseType l)
recordType :: Parser
  (OberonGrammar l NodeWrap) Ident (Type l l NodeWrap NodeWrap)
length :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Expression l l NodeWrap NodeWrap))
arrayType :: Parser
  (OberonGrammar l NodeWrap) Ident (Type l l NodeWrap NodeWrap)
qualident :: Parser (OberonGrammar l NodeWrap) Ident (BaseType l)
type_prod :: Parser
  (OberonGrammar l NodeWrap) Ident (Type l l NodeWrap NodeWrap)
typeDeclaration :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (Declaration l l NodeWrap NodeWrap)
relation :: Parser (OberonGrammar l NodeWrap) Ident RelOp
addOperator :: Parser (OberonGrammar l NodeWrap) Ident (BinOp l NodeWrap)
mulOperator :: Parser (OberonGrammar l NodeWrap) Ident (BinOp l NodeWrap)
actualParameters :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  [NodeWrap (Expression l l NodeWrap NodeWrap)]
expList :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NonEmpty (NodeWrap (Expression l l NodeWrap NodeWrap)))
unguardedDesignator :: Parser
  (OberonGrammar l NodeWrap) Ident (Designator l l NodeWrap NodeWrap)
designator :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Designator l l NodeWrap NodeWrap))
element :: Parser
  (OberonGrammar l NodeWrap) Ident (Element l l NodeWrap NodeWrap)
set :: Parser
  (OberonGrammar l NodeWrap) Ident (Expression l l NodeWrap NodeWrap)
string_prod :: Parser (OberonGrammar l NodeWrap) Ident Ident
charConstant :: Parser
  (OberonGrammar l NodeWrap) Ident (Value l l NodeWrap NodeWrap)
scaleFactor :: Parser (OberonGrammar l NodeWrap) Ident Ident
real :: Parser
  (OberonGrammar l NodeWrap) Ident (Value l l NodeWrap NodeWrap)
hexDigit :: Parser (OberonGrammar l NodeWrap) Ident Ident
integer :: Parser
  (OberonGrammar l NodeWrap) Ident (Value l l NodeWrap NodeWrap)
number :: Parser
  (OberonGrammar l NodeWrap) Ident (Value l l NodeWrap NodeWrap)
factor :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Expression l l NodeWrap NodeWrap))
term :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Expression l l NodeWrap NodeWrap))
simpleExpression :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Expression l l NodeWrap NodeWrap))
expression :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Expression l l NodeWrap NodeWrap))
constExpression :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (NodeWrap (Expression l l NodeWrap NodeWrap))
identdef :: Parser (OberonGrammar l NodeWrap) Ident (IdentDef l)
constantDeclaration :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (Declaration l l NodeWrap NodeWrap)
declarationSequence :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  [NodeWrap (Declaration l l NodeWrap NodeWrap)]
import_prod :: Parser (OberonGrammar l NodeWrap) Ident (Import l)
importList :: Parser (OberonGrammar l NodeWrap) Ident [Import l]
digit :: Parser (OberonGrammar l NodeWrap) Ident Ident
letter :: Parser (OberonGrammar l NodeWrap) Ident Ident
ident :: Parser (OberonGrammar l NodeWrap) Ident Ident
module_prod :: Parser
  (OberonGrammar l NodeWrap)
  Ident
  (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 (Ident, 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 Ident
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 Ident
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 Ident
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 Ident
letter :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p Ident
ident :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p Ident
module_prod :: forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
..} = GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
definitionMixin (GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Ident
grammar OberonGrammar l NodeWrap (Parser (OberonGrammar l NodeWrap) Ident)
g)

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

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

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

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

wrapBinary :: (NodeWrap a -> NodeWrap a -> a) -> (NodeWrap a -> NodeWrap a -> NodeWrap a)
wrapBinary :: (NodeWrap a -> NodeWrap a -> a)
-> NodeWrap a -> NodeWrap a -> NodeWrap a
wrapBinary NodeWrap a -> NodeWrap a -> a
op a :: NodeWrap a
a@(Compose ((Position, Position)
pos, Compose Ambiguous ((,) ParsedLexemes) a
_)) NodeWrap a
b = ((Position, Position), Compose Ambiguous ((,) ParsedLexemes) a)
-> NodeWrap a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((Position, Position)
pos, Ambiguous (ParsedLexemes, a)
-> Compose Ambiguous ((,) ParsedLexemes) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Ambiguous (ParsedLexemes, a)
 -> Compose Ambiguous ((,) ParsedLexemes) a)
-> Ambiguous (ParsedLexemes, a)
-> Compose Ambiguous ((,) ParsedLexemes) a
forall a b. (a -> b) -> a -> b
$ (ParsedLexemes, a) -> Ambiguous (ParsedLexemes, a)
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 :: f a -> f a
moptional f a
p = f a
p f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> 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 :: Ident -> Parser (OberonGrammar l f) Ident Ident
delimiter Ident
s = Parser (OberonGrammar l f) Ident Ident
-> Parser (OberonGrammar l f) Ident Ident
forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (ParserInput
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     (OberonGrammar l f)
     Ident
     (ParserInput
        (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Ident
ParserInput
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident)
s Parser (OberonGrammar l f) Ident Ident
-> Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident ()
-> Parser (OberonGrammar l f) Ident Ident
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ([[Lexeme]], ())
-> Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident ()
forall (m :: * -> *) a (g :: (* -> *) -> *) s.
Applicative m =>
m a -> ParserT m g s a
lift ([[TokenType -> Ident -> Lexeme
Token TokenType
Delimiter Ident
s]], ())) Parser (OberonGrammar l f) Ident Ident
-> String -> Parser (OberonGrammar l f) Ident Ident
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"delimiter " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ident -> String
forall a. Show a => a -> String
show Ident
s)
operator :: Ident -> Parser (OberonGrammar l f) Ident Ident
operator Ident
s = Parser (OberonGrammar l f) Ident Ident
-> Parser (OberonGrammar l f) Ident Ident
forall (m :: * -> *) a. LexicalParsing m => m a -> m a
lexicalToken (ParserInput
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     (OberonGrammar l f)
     Ident
     (ParserInput
        (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Ident
ParserInput
  (Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident)
s Parser (OberonGrammar l f) Ident Ident
-> Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident ()
-> Parser (OberonGrammar l f) Ident Ident
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ([[Lexeme]], ())
-> Fixed (ParserT ((,) [[Lexeme]])) (OberonGrammar l f) Ident ()
forall (m :: * -> *) a (g :: (* -> *) -> *) s.
Applicative m =>
m a -> ParserT m g s a
lift ([[TokenType -> Ident -> Lexeme
Token TokenType
Operator Ident
s]], ())) Parser (OberonGrammar l f) Ident Ident
-> String -> Parser (OberonGrammar l f) Ident Ident
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"operator " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ident -> String
forall a. Show a => a -> String
show Ident
s)

reservedWords :: [Text]
reservedWords :: [Ident]
reservedWords = [Ident
"ARRAY", Ident
"IMPORT", Ident
"RETURN",
                 Ident
"BEGIN", Ident
"IN", Ident
"THEN",
                 Ident
"BY", Ident
"IS", Ident
"TO",
                 Ident
"CASE", Ident
"LOOP", Ident
"TYPE",
                 Ident
"DIV", Ident
"MODULE", Ident
"VAR",
                 Ident
"DO", Ident
"NIL", Ident
"WHILE",
                 Ident
"ELSE", Ident
"OF", Ident
"WITH",
                 Ident
"ELSIF", Ident
"OR",
                 Ident
"END", Ident
"POINTER",
                 Ident
"EXIT", Ident
"PROCEDURE",
                 Ident
"FOR", Ident
"RECORD",
                 Ident
"IF", Ident
"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/}
-}