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

-- | Oberon grammar adapted from http://www.ethoberon.ethz.ch/EBNF.html
-- 
-- Extracted from the book Programmieren in Oberon - Das neue Pascal by N. Wirth and M. Reiser and translated by
-- J. Templ.
--
-- The grammars in this module attempt to follow the language grammars from the reports, while generating a
-- semantically meaningful abstract syntax tree; the latter is defined in "Language.Oberon.AST". As the grammars are
-- ambiguous, it is necessary to resolve the ambiguities after parsing all Oberon modules in use.
-- "Language.Oberon.Resolver" provides this functionality. Only after the ambiguity resolution can the abstract syntax
-- tree be pretty-printed using the instances from "Language.Oberon.Pretty". Alternatively, since the parsing
-- preserves the original parsed lexemes including comments in the AST, you can use "Language.Oberon.Reserializer" to
-- reproduce the original source code from the AST.

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

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

import qualified Rank2
import qualified Rank2.TH

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

import Prelude hiding (length, takeWhile)

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

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

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

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

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

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

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

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

comment :: Rank2.Apply g => Parser g Text Text
comment :: forall (g :: (* -> *) -> *). Apply g => Parser g Text Text
comment = Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
forall a.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text)
"(*"
               Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
forall a. Semigroup a => a -> a -> a
<> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
forall (p :: * -> *) a. (Alternative p, Monoid a) => p a -> p a
concatMany (Fixed (ParserT ((,) [[Lexeme]])) g Text Text
forall (g :: (* -> *) -> *). Apply g => Parser g Text Text
comment Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
forall a.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text a
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall a.
Show a =>
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy (ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text)
"*)") Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
forall a b.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text b
-> Fixed (ParserT ((,) [[Lexeme]])) g Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Text
  (ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text))
forall (m :: * -> *). InputParsing m => m (ParserInput m)
anyToken Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text))
forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isCommentChar)
               Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> Fixed (ParserT ((,) [[Lexeme]])) g Text Text
forall a. Semigroup a => a -> a -> a
<> ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text))
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string Text
ParserInput (Fixed (ParserT ((,) [[Lexeme]])) g Text)
"*)")
   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 :: Rank2.Apply g => LexicalParsing (Parser g Text) => Parser g Text ()
whiteSpace :: forall (g :: (* -> *) -> *).
(Apply g, LexicalParsing (Parser g Text)) =>
Parser g Text ()
whiteSpace = Fixed (ParserT ((,) [[Lexeme]])) g Text ()
spaceChars Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall a b.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text b
-> Fixed (ParserT ((,) [[Lexeme]])) g Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall a.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany (Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall (m :: * -> *). LexicalParsing m => m ()
lexicalComment Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall a b.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text b
-> Fixed (ParserT ((,) [[Lexeme]])) g Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
spaceChars) Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> String -> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall a.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> String -> Fixed (ParserT ((,) [[Lexeme]])) g Text a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"whitespace"
   where spaceChars :: Fixed (ParserT ((,) [[Lexeme]])) g Text ()
spaceChars = ((Char -> Bool)
-> Fixed
     (ParserT ((,) [[Lexeme]])) g Text (ParserInput (Parser g Text))
forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile1 Char -> Bool
isSpace Fixed (ParserT ((,) [[Lexeme]])) g Text Text
-> (Text -> Fixed (ParserT ((,) [[Lexeme]])) g Text ())
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall a b.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> (a -> Fixed (ParserT ((,) [[Lexeme]])) g Text b)
-> Fixed (ParserT ((,) [[Lexeme]])) g Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
ws-> ([[Lexeme]], ()) -> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall (m :: * -> *) s a (g :: (* -> *) -> *).
(Applicative m, Ord s) =>
m a -> ParserT m g s a
lift ([[Text -> Lexeme
WhiteSpace Text
ws]], ())) Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
-> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall a.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text a
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> () -> Fixed (ParserT ((,) [[Lexeme]])) g Text ()
forall a. a -> Fixed (ParserT ((,) [[Lexeme]])) g Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

wrapAmbiguous, wrap :: Rank2.Apply g => Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous :: forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrapAmbiguous = Parser g Text a -> Parser g Text (NodeWrap a)
forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap
wrap :: forall (g :: (* -> *) -> *) a.
Apply g =>
Parser g Text a -> Parser g Text (NodeWrap a)
wrap = (((Down Int, Down Int), Compose Ambiguous ((,) ParsedLexemes) a)
-> Compose
     ((,) (Down Int, Down Int))
     (Compose Ambiguous ((,) ParsedLexemes))
     a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (((Down Int, Down Int), Compose Ambiguous ((,) ParsedLexemes) a)
 -> Compose
      ((,) (Down Int, Down Int))
      (Compose Ambiguous ((,) ParsedLexemes))
      a)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     ((Down Int, Down Int), Compose Ambiguous ((,) ParsedLexemes) a)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (Compose
        ((,) (Down Int, Down Int))
        (Compose Ambiguous ((,) ParsedLexemes))
        a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Fixed
   (ParserT ((,) [[Lexeme]]))
   g
   Text
   ((Down Int, Down Int), Compose Ambiguous ((,) ParsedLexemes) a)
 -> Fixed
      (ParserT ((,) [[Lexeme]]))
      g
      Text
      (Compose
         ((,) (Down Int, Down Int))
         (Compose Ambiguous ((,) ParsedLexemes))
         a))
-> (Parser g Text a
    -> Fixed
         (ParserT ((,) [[Lexeme]]))
         g
         Text
         ((Down Int, Down Int), Compose Ambiguous ((,) ParsedLexemes) a))
-> Parser g Text a
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (Compose
        ((,) (Down Int, Down Int))
        (Compose Ambiguous ((,) ParsedLexemes))
        a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Text
  (Compose Ambiguous ((,) ParsedLexemes) a)
p-> (Down Int
 -> Compose Ambiguous ((,) ParsedLexemes) a
 -> Down Int
 -> ((Down Int, Down Int), Compose Ambiguous ((,) ParsedLexemes) a))
-> Fixed (ParserT ((,) [[Lexeme]])) g Text (Down Int)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (Compose Ambiguous ((,) ParsedLexemes) a)
-> Fixed (ParserT ((,) [[Lexeme]])) g Text (Down Int)
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     ((Down Int, Down Int), 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 Down Int
-> Compose Ambiguous ((,) ParsedLexemes) a
-> Down Int
-> ((Down Int, Down Int), Compose Ambiguous ((,) ParsedLexemes) a)
forall {a} {b} {b}. a -> b -> b -> ((a, b), b)
surround Fixed (ParserT ((,) [[Lexeme]])) g Text (Down Int)
Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Text
  (ParserPosition (Fixed (ParserT ((,) [[Lexeme]])) g Text))
forall (m :: * -> *). InputParsing m => m (ParserPosition m)
getSourcePos Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Text
  (Compose Ambiguous ((,) ParsedLexemes) a)
p Fixed (ParserT ((,) [[Lexeme]])) g Text (Down Int)
Fixed
  (ParserT ((,) [[Lexeme]]))
  g
  Text
  (ParserPosition (Fixed (ParserT ((,) [[Lexeme]])) g Text))
forall (m :: * -> *). InputParsing m => m (ParserPosition m)
getSourcePos)
         (Fixed
   (ParserT ((,) [[Lexeme]]))
   g
   Text
   (Compose Ambiguous ((,) ParsedLexemes) a)
 -> Fixed
      (ParserT ((,) [[Lexeme]]))
      g
      Text
      ((Down Int, Down Int), Compose Ambiguous ((,) ParsedLexemes) a))
-> (Parser g Text a
    -> Fixed
         (ParserT ((,) [[Lexeme]]))
         g
         Text
         (Compose Ambiguous ((,) ParsedLexemes) a))
-> Parser g Text a
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     ((Down Int, Down Int), 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 Text (Ambiguous (ParsedLexemes, a))
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (Compose Ambiguous ((,) ParsedLexemes) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Fixed
   (ParserT ((,) [[Lexeme]])) g Text (Ambiguous (ParsedLexemes, a))
 -> Fixed
      (ParserT ((,) [[Lexeme]]))
      g
      Text
      (Compose Ambiguous ((,) ParsedLexemes) a))
-> (Parser g Text a
    -> Fixed
         (ParserT ((,) [[Lexeme]])) g Text (Ambiguous (ParsedLexemes, a)))
-> Parser g Text a
-> Fixed
     (ParserT ((,) [[Lexeme]]))
     g
     Text
     (Compose Ambiguous ((,) ParsedLexemes) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixed (ParserT ((,) [[Lexeme]])) g Text (ParsedLexemes, a)
-> Fixed
     (ParserT ((,) [[Lexeme]])) g Text (Ambiguous (ParsedLexemes, a))
forall a.
Fixed (ParserT ((,) [[Lexeme]])) g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text (Ambiguous a)
forall (m :: * -> *) a.
AmbiguousParsing m =>
m a -> m (Ambiguous a)
ambiguous (Fixed (ParserT ((,) [[Lexeme]])) g Text (ParsedLexemes, a)
 -> Fixed
      (ParserT ((,) [[Lexeme]])) g Text (Ambiguous (ParsedLexemes, a)))
-> (Fixed (ParserT ((,) [[Lexeme]])) g Text (ParsedLexemes, a)
    -> Fixed (ParserT ((,) [[Lexeme]])) g Text (ParsedLexemes, a))
-> Fixed (ParserT ((,) [[Lexeme]])) g Text (ParsedLexemes, a)
-> Fixed
     (ParserT ((,) [[Lexeme]])) g Text (Ambiguous (ParsedLexemes, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([[Lexeme]], (ParsedLexemes, a))
 -> ([[Lexeme]], (ParsedLexemes, a)))
-> Fixed (ParserT ((,) [[Lexeme]])) g Text (ParsedLexemes, a)
-> Fixed (ParserT ((,) [[Lexeme]])) g Text (ParsedLexemes, a)
forall b (m :: * -> *) a (g :: (* -> *) -> *) s.
AmbiguityDecidable b =>
(m a -> m b) -> ParserT m g s a -> ParserT m g s b
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 Text (ParsedLexemes, a)
 -> Fixed
      (ParserT ((,) [[Lexeme]])) g Text (Ambiguous (ParsedLexemes, a)))
-> (Parser g Text a
    -> Fixed (ParserT ((,) [[Lexeme]])) g Text (ParsedLexemes, a))
-> Parser g Text a
-> Fixed
     (ParserT ((,) [[Lexeme]])) g Text (Ambiguous (ParsedLexemes, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,) ([Lexeme] -> ParsedLexemes
Trailing []) (a -> (ParsedLexemes, a))
-> Parser g Text a
-> Fixed (ParserT ((,) [[Lexeme]])) g Text (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 Text
oberonGrammar = Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall (p :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
       (f :: * -> *) (rl :: * -> * -> *) (cb :: * -> *).
(cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,
 LeftRecParsing p g s rl, DeterministicParsing (p g s), Apply g,
 Traversable g, Distributive g, Logistic g) =>
g (Fixed p g s) -> g (Fixed p g s)
autochain (Grammar (OberonGrammar Language NodeWrap) Parser Text
 -> Grammar (OberonGrammar Language NodeWrap) Parser Text)
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall a b. (a -> b) -> a -> b
$ (Grammar (OberonGrammar Language NodeWrap) Parser Text
 -> Grammar (OberonGrammar Language NodeWrap) Parser Text)
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
forall (g :: (* -> *) -> *).
(g
 ~ ParserGrammar
     (Fixed
        (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text),
 GrammarConstraint
   (Fixed
      (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
   g,
 Distributive g) =>
(g (Fixed
      (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
 -> g (Fixed
         (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text))
-> g (Fixed
        (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
fixGrammar Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar
-- | Grammar of an Oberon-2 module
oberon2Grammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text
oberon2Grammar = Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall (p :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
       (f :: * -> *) (rl :: * -> * -> *) (cb :: * -> *).
(cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,
 LeftRecParsing p g s rl, DeterministicParsing (p g s), Apply g,
 Traversable g, Distributive g, Logistic g) =>
g (Fixed p g s) -> g (Fixed p g s)
autochain (Grammar (OberonGrammar Language NodeWrap) Parser Text
 -> Grammar (OberonGrammar Language NodeWrap) Parser Text)
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall a b. (a -> b) -> a -> b
$ (Grammar (OberonGrammar Language NodeWrap) Parser Text
 -> Grammar (OberonGrammar Language NodeWrap) Parser Text)
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
forall (g :: (* -> *) -> *).
(g
 ~ ParserGrammar
     (Fixed
        (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text),
 GrammarConstraint
   (Fixed
      (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
   g,
 Distributive g) =>
(g (Fixed
      (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
 -> g (Fixed
         (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text))
-> g (Fixed
        (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
fixGrammar Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
grammar2
-- | Grammar of an Oberon definition module
oberonDefinitionGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text
oberonDefinitionGrammar = Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall (p :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
       (f :: * -> *) (rl :: * -> * -> *) (cb :: * -> *).
(cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,
 LeftRecParsing p g s rl, DeterministicParsing (p g s), Apply g,
 Traversable g, Distributive g, Logistic g) =>
g (Fixed p g s) -> g (Fixed p g s)
autochain (Grammar (OberonGrammar Language NodeWrap) Parser Text
 -> Grammar (OberonGrammar Language NodeWrap) Parser Text)
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall a b. (a -> b) -> a -> b
$ (Grammar (OberonGrammar Language NodeWrap) Parser Text
 -> Grammar (OberonGrammar Language NodeWrap) Parser Text)
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
forall (g :: (* -> *) -> *).
(g
 ~ ParserGrammar
     (Fixed
        (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text),
 GrammarConstraint
   (Fixed
      (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
   g,
 Distributive g) =>
(g (Fixed
      (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
 -> g (Fixed
         (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text))
-> g (Fixed
        (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
fixGrammar Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall l.
Oberon l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionGrammar
-- | Grammar of an Oberon-2 definition module
oberon2DefinitionGrammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text
oberon2DefinitionGrammar = Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall (p :: ((* -> *) -> *) -> * -> * -> *) (g :: (* -> *) -> *) s
       (f :: * -> *) (rl :: * -> * -> *) (cb :: * -> *).
(cb ~ Const (g (Const Bool)), f ~ GrammarFunctor (p g s), f ~ rl s,
 LeftRecParsing p g s rl, DeterministicParsing (p g s), Apply g,
 Traversable g, Distributive g, Logistic g) =>
g (Fixed p g s) -> g (Fixed p g s)
autochain (Grammar (OberonGrammar Language NodeWrap) Parser Text
 -> Grammar (OberonGrammar Language NodeWrap) Parser Text)
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall a b. (a -> b) -> a -> b
$ (Grammar (OberonGrammar Language NodeWrap) Parser Text
 -> Grammar (OberonGrammar Language NodeWrap) Parser Text)
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
(g m -> g m) -> g m
forall (g :: (* -> *) -> *).
(g
 ~ ParserGrammar
     (Fixed
        (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text),
 GrammarConstraint
   (Fixed
      (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
   g,
 Distributive g) =>
(g (Fixed
      (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
 -> g (Fixed
         (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text))
-> g (Fixed
        (ParserT ((,) [[Lexeme]])) (OberonGrammar Language NodeWrap) Text)
fixGrammar Grammar (OberonGrammar Language NodeWrap) Parser Text
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
forall l.
Oberon2 l =>
GrammarBuilder
  (OberonGrammar l NodeWrap) (OberonGrammar l NodeWrap) Parser Text
definitionGrammar2

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

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

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

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

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

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

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

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

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

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

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

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

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

where the body is removed and in:

ProcedureDeclaration  = ProcedureHeading ";"

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

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