--
-- m2.bnf grammar and associated actions for pass 0.
--
-- Copyright (C) 2001-2025 Free Software Foundation, Inc.
-- Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
--
-- This file is part of GNU Modula-2.
--
-- GNU Modula-2 is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 3, or (at your option)
-- any later version.
--
-- GNU Modula-2 is distributed in the hope that it will be useful, but
-- WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with GNU Modula-2; see the file COPYING3. If not see
-- <http://www.gnu.org/licenses/>.
% module P0SyntaxCheck begin
(* output from m2.bnf, automatically generated do not edit if these
are the top two lines in the file.
Copyright (C) 2001-2025 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
This file is part of GNU Modula-2.
GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Modula-2; see the file COPYING. If not,
see <https://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE P0SyntaxCheck ;
FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
InsertTokenAndRewind, GetTokenNo, DisplayToken, DumpTokens ;
FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn,
PopAuto, DisplayStack, PushTFtok, PushTtok, DupFrame,
Top ;
FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok,
QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
FROM M2MetaError IMPORT MetaErrorStringT0 ;
FROM P2SymBuild IMPORT BuildString, BuildNumber ;
FROM NameKey IMPORT Name, NulName, makekey ;
FROM StrLib IMPORT StrCopy, StrConCat, StrEqual ;
FROM M2Batch IMPORT MakeProgramSource, MakeDefinitionSource, MakeImplementationSource ;
FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
FROM M2Debug IMPORT Assert ;
FROM M2Printf IMPORT printf0 ;
(* imports for Pass0 *)
FROM P0SymBuild IMPORT RegisterImports, RegisterInnerImports,
RegisterProgramModule,
RegisterImplementationModule, RegisterDefinitionModule,
RegisterInnerModule, EndModule,
RegisterProcedure, EndProcedure, EndForward ;
FROM SymbolTable IMPORT NulSym, PutModuleContainsBuiltin, PutHiddenTypeDeclared ;
IMPORT M2Error ;
CONST
Debugging = FALSE ;
DebugRecover = FALSE ;
Pass0 = TRUE ;
Pass1 = FALSE ;
Pass2 = FALSE ; (* permanently disabled for the time being *)
Pass3 = FALSE ; (* permanently disabled for the time being *)
MaxInsert = 10 ; (* allow 10 tokens to be inserted before *)
(* giving up. *)
VAR
EnableImportCheck,
seenError : BOOLEAN ;
LastIdent : Name ;
InsertCount : CARDINAL ;
(*
BlockAssert - wrap an Assert specifically for blocks.
*)
PROCEDURE BlockAssert (value: BOOLEAN) ;
BEGIN
Assert (value) ;
END BlockAssert ;
PROCEDURE ErrorString (s: String) ;
BEGIN
MetaErrorStringT0 (GetTokenNo (), s) ;
seenError := TRUE
END ErrorString ;
PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
BEGIN
ErrorString (InitString (a))
END ErrorArray ;
% declaration P0SyntaxCheck begin
(*
SyntaxError - after a syntax error we skip all tokens up until we reach
a stop symbol.
*)
PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
DescribeError ;
IF Debugging
THEN
printf0('\nskipping token *** ')
END ;
(* --fixme-- this assumes a 32 bit word size. *)
WHILE NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR
((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
DO
GetToken
END ;
IF Debugging
THEN
printf0(' ***\n')
END
END SyntaxError ;
(*
SyntaxCheck -
*)
PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
(* --fixme-- this assumes a 32 bit word size. *)
IF NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR
((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
THEN
SyntaxError (stopset0, stopset1, stopset2)
END
END SyntaxCheck ;
(*
GetMissingTokenMessage - generates and returns a string about a missing token, t.
*)
PROCEDURE GetMissingTokenMessage (t: toktype) : String ;
VAR
s0 : SetOfStop0 ;
s1 : SetOfStop1 ;
s2 : SetOfStop2 ;
str: String ;
BEGIN
s0 := SetOfStop0{} ;
s1 := SetOfStop1{} ;
s2 := SetOfStop2{} ;
IF ORD(t)<32
THEN
s0 := SetOfStop0{t}
ELSIF ORD(t)<64
THEN
s1 := SetOfStop1{t}
ELSE
s2 := SetOfStop2{t}
END ;
str := DescribeStop (s0, s1, s2) ;
RETURN str
END GetMissingTokenMessage ;
(*
ErrorMissingToken - generates an error message about a missing token, t.
*)
PROCEDURE ErrorMissingToken (t: toktype) ;
VAR
str: String ;
BEGIN
str := GetMissingTokenMessage (t) ;
str := ConCat (InitString ('syntax error,'), Mark (str)) ;
MetaErrorStringT0 (GetTokenNo (), str)
END ErrorMissingToken ;
(*
WarnMissingToken - generates a warning message about a missing token, t.
*)
PROCEDURE WarnMissingToken (t: toktype) ;
VAR
str: String ;
BEGIN
str := GetMissingTokenMessage (t) ;
str := ConCat (InitString ('{%W}syntax warning,'), Mark (str)) ;
MetaErrorStringT0 (GetTokenNo (), str) ;
IF DebugRecover
THEN
printf0 ("warning note created\n")
END
END WarnMissingToken ;
(*
MissingToken - generates a warning message about a missing token, t.
*)
PROCEDURE MissingToken (t: toktype) ;
BEGIN
IF (InsertCount<MaxInsert) AND
((t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok))
THEN
IF DebugRecover
THEN
printf0 ("missing token detected and going to be inserted: ");
DisplayToken (t)
END ;
WarnMissingToken (t) ;
INC (InsertCount) ;
IF DebugRecover
THEN
printf0 ('inserting token\n')
END ;
InsertToken (t)
ELSE
IF DebugRecover
THEN
printf0 ("missing token detected but cannot be inserted: ");
DisplayToken (t)
END ;
ErrorMissingToken (t)
END
END MissingToken ;
(*
CheckInsertCandidate -
*)
PROCEDURE CheckInsertCandidate (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
BEGIN
IF ((ORD(t)<32) AND (t IN stopset0)) OR
((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
((ORD(t)>=64) AND (t IN stopset2))
THEN
INC (InsertCount) ;
IF InsertCount < MaxInsert
THEN
WarnMissingToken (t) ;
IF DebugRecover
THEN
printf0 ('buffer before\n') ;
DumpTokens
END ;
InsertTokenAndRewind (t) ;
IF DebugRecover
THEN
printf0 ('inserting token: buffer after insertion\n') ;
DumpTokens
END ;
RETURN TRUE
END
END ;
RETURN FALSE
END CheckInsertCandidate ;
(*
InStopSet
*)
PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
BEGIN
IF ((ORD(t)<32) AND (t IN stopset0)) OR
((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
((ORD(t)>=64) AND (t IN stopset2))
THEN
RETURN( TRUE )
ELSE
RETURN( FALSE )
END
END InStopSet ;
(*
PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
If it is not then it will insert a token providing the token
is one of ; ] ) } . OF END ,
if the stopset contains <identtok> then we do not insert a token
*)
PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
(* and again (see above re: ORD)
*)
IF (NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR
((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
(NOT InStopSet(identtok, stopset0, stopset1, stopset2))
THEN
(* SyntaxCheck will fail since currentoken is not part of the stopset
we check to see whether one of the following is in the stopset and
if not emit a warning and also the token. *)
IF CheckInsertCandidate (semicolontok, stopset0, stopset1, stopset2) OR
CheckInsertCandidate (rsbratok, stopset0, stopset1, stopset2) OR
CheckInsertCandidate (rparatok, stopset0, stopset1, stopset2) OR
CheckInsertCandidate (rcbratok, stopset0, stopset1, stopset2) OR
CheckInsertCandidate (periodtok, stopset0, stopset1, stopset2) OR
CheckInsertCandidate (oftok, stopset0, stopset1, stopset2) OR
CheckInsertCandidate (endtok, stopset0, stopset1, stopset2) OR
CheckInsertCandidate (commatok, stopset0, stopset1, stopset2)
THEN
END
END
END PeepToken ;
(*
DetectImport - checks whether the next token is an import or from and if so
generates an error message. This is called after an export
statement to notify the user that the ordering is incorrect.
*)
PROCEDURE DetectImport ;
BEGIN
IF (currenttoken = importtok) OR (currenttoken = fromtok)
THEN
ErrorArray ('an {%AkIMPORT} statement must preceed an {%kEXPORT} statement')
END
END DetectImport ;
(*
Expect -
*)
PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
IF currenttoken=t
THEN
GetToken ;
IF EnableImportCheck
THEN
DetectImport
END ;
IF Pass0
THEN
PeepToken (stopset0, stopset1, stopset2)
END
ELSE
MissingToken (t)
END ;
SyntaxCheck (stopset0, stopset1, stopset2)
END Expect ;
(*
CompilationUnit - returns TRUE if the input was correct enough to parse
in future passes.
*)
PROCEDURE CompilationUnit () : BOOLEAN ;
BEGIN
seenError := FALSE ;
EnableImportCheck := FALSE ;
InsertCount := 0 ;
FileUnit (SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
RETURN NOT seenError
END CompilationUnit ;
(*
Ident - error checking varient of Ident
*)
PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
LastIdent := makekey (currentstring) ;
IF IsAutoPushOn ()
THEN
PushTFtok (LastIdent, identtok, GetTokenNo())
END ;
Expect (identtok, stopset0, stopset1, stopset2)
END Ident ;
(*
string -
*)
PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
IF IsAutoPushOn ()
THEN
PushTF (makekey (currentstring), stringtok) ;
BuildString
END ;
Expect (stringtok, stopset0, stopset1, stopset2)
END string ;
(*
Integer -
*)
PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
IF IsAutoPushOn()
THEN
PushTFtok (makekey (currentstring), integertok, GetTokenNo ()) ;
BuildNumber
END ;
Expect(integertok, stopset0, stopset1, stopset2)
END Integer ;
(*
Real -
*)
PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
IF IsAutoPushOn()
THEN
PushTFtok (makekey (currentstring), realtok, GetTokenNo ()) ;
BuildNumber
END ;
Expect(realtok, stopset0, stopset1, stopset2)
END Real ;
% module P0SyntaxCheck end
END P0SyntaxCheck.
% rules
error 'ErrorArray' 'ErrorString'
tokenfunc 'currenttoken'
token '' eoftok -- internal token
token '+' plustok
token '-' minustok
token '*' timestok
token '/' dividetok
token ':=' becomestok
token '&' ambersandtok
token "." periodtok
token "," commatok
token ";" semicolontok
token '(' lparatok
token ')' rparatok
token '[' lsbratok -- left square brackets
token ']' rsbratok -- right square brackets
token '{' lcbratok -- left curly brackets
token '}' rcbratok -- right curly brackets
token '^' uparrowtok
token "'" singlequotetok
token '=' equaltok
token '#' hashtok
token '<' lesstok
token '>' greatertok
token '<>' lessgreatertok
token '<=' lessequaltok
token '>=' greaterequaltok
token '<*' ldirectivetok
token '*>' rdirectivetok
token '..' periodperiodtok
token ':' colontok
token '"' doublequotestok
token '|' bartok
token 'AND' andtok
token 'ARRAY' arraytok
token 'BEGIN' begintok
token 'BY' bytok
token 'CASE' casetok
token 'CONST' consttok
token 'DEFINITION' definitiontok
token 'DIV' divtok
token 'DO' dotok
token 'ELSE' elsetok
token 'ELSIF' elsiftok
token 'END' endtok
token 'EXCEPT' excepttok
token 'EXIT' exittok
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
token 'IMPORT' importtok
token 'IN' intok
token 'LOOP' looptok
token 'MOD' modtok
token 'MODULE' moduletok
token 'NOT' nottok
token 'OF' oftok
token 'OR' ortok
token 'PACKEDSET' packedsettok
token 'POINTER' pointertok
token 'PROCEDURE' proceduretok
token 'QUALIFIED' qualifiedtok
token 'UNQUALIFIED' unqualifiedtok
token 'RECORD' recordtok
token 'REM' remtok
token 'REPEAT' repeattok
token 'RETRY' retrytok
token 'RETURN' returntok
token 'SET' settok
token 'THEN' thentok
token 'TO' totok
token 'TYPE' typetok
token 'UNTIL' untiltok
token 'VAR' vartok
token 'WHILE' whiletok
token 'WITH' withtok
token 'ASM' asmtok
token 'VOLATILE' volatiletok
token '...' periodperiodperiodtok
token '__DATE__' datetok
token '__LINE__' linetok
token '__FILE__' filetok
token '__ATTRIBUTE__' attributetok
token '__BUILTIN__' builtintok
token '__INLINE__' inlinetok
token 'integer number' integertok
token 'identifier' identtok
token 'real number' realtok
token 'string' stringtok
special Ident first { < identtok > } follow { }
'@i{is a builtin and checks for an identifier}'
special Integer first { < integertok > } follow { }
'@i{is a builtin and checks for an integer}'
special Real first { < realtok > } follow { }
'@i{is a builtin and checks for an real constant}'
special string first { < stringtok > } follow { }
'@i{is a builtin and checks for an string constant}'
BNF
-- the following are provided by the module m2flex and also hand built procedures below
-- Ident := Letter { ( Letter | Digit ) } =:
-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
-- Digit { HexDigit } " H " =:
-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
-- Digit := OctalDigit | " 8 " | " 9 " =:
-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
-- String
FileUnit := % PushAutoOff %
( DefinitionModule | ImplementationOrProgramModule ) % PopAuto %
=:
ProgramModule := "MODULE" % PushAutoOn ; %
% M2Error.DefaultProgramModule %
Ident % RegisterProgramModule ; %
% PushAutoOff ; %
[ Priority ]
";"
% PushAutoOn ; %
{ Import % RegisterImports %
} % PopAuto %
Block % PopAuto %
Ident "." % EndModule %
% PopAuto %
=:
ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
"MODULE" % PushAutoOn ; %
Ident % RegisterImplementationModule ; %
% PushAutoOff ; %
[ Priority ] ";" % PushAutoOn ; %
{ Import % RegisterImports %
} % PopAuto %
Block % PopAuto %
Ident % EndModule %
% PopAuto %
"." =:
ImplementationOrProgramModule := ImplementationModule | ProgramModule =:
Number := Integer | Real =:
Qualident := Ident { "." Ident } =:
ConstantDeclaration := Ident "=" ConstExpression =:
ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ] =:
Relation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
UnaryOrConstTerm := "+" ConstTerm | "-" ConstTerm | ConstTerm =:
AddOperator := "+" | "-" | "OR" =:
ConstTerm := ConstFactor { MulOperator ConstFactor } =:
MulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
"(" ConstExpression ")" | "NOT" ConstFactor |
ConstAttribute =:
-- to help satisfy LL1
ConstString := string =:
ComponentElement := ConstExpression [ ".." ConstExpression ] =:
ComponentValue := ComponentElement [ 'BY' ConstExpression ] =:
ArraySetRecordValue := ComponentValue { ',' ComponentValue } =:
Constructor := '{' [ ArraySetRecordValue ] '}' =:
ConstSetOrQualidentOrFunction := Constructor | Qualident
[ Constructor | ConstActualParameters ] =:
ConstActualParameters := "(" [ ExpList ] ")" =:
ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:
ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =:
ByteAlignment := '<*' AttributeExpression '*>' =:
-- AlignmentExpression := "(" ConstExpression ")" =:
Alignment := [ ByteAlignment ] =:
TypeDeclaration := Ident "=" Type Alignment =:
Type := SimpleType | ArrayType | RecordType | SetType |
PointerType | ProcedureType =:
SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
Enumeration := "(" IdentList ")" =:
IdentList := Ident % VAR
on: BOOLEAN ;
n : CARDINAL ; %
% on := IsAutoPushOn() ;
IF on
THEN
n := 1
END %
{ "," Ident % IF on
THEN
INC(n)
END %
} % IF on
THEN
PushT(n)
END %
=:
SubrangeType := "[" ConstExpression ".." ConstExpression "]" =:
ArrayType := "ARRAY" SimpleType { "," SimpleType } "OF" Type =:
RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
RecordFieldPragma := [ '<*' FieldPragmaExpression
{ ',' FieldPragmaExpression } '*>' ] =:
FieldPragmaExpression := Ident [ '(' ConstExpression ')' ] =:
AttributeExpression := Ident '(' ConstExpression ')' =:
FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
FieldListStatement := [ FieldList ] =:
FieldList := IdentList ":" Type RecordFieldPragma
|
"CASE" CaseTag "OF" Varient { "|" Varient }
[ "ELSE" FieldListSequence ] "END"
=:
TagIdent := [ Ident ] =:
CaseTag := TagIdent [ ":" Qualident ] =:
Varient := [ VarientCaseLabelList ":" FieldListSequence ] =:
VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
VarientCaseLabels := ConstExpression [ ".." ConstExpression ] =:
CaseLabelList := CaseLabels { "," CaseLabels } =:
CaseLabels := ConstExpression [ ".." ConstExpression ] =:
SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
PointerType := "POINTER" "TO" Type =:
ProcedureType := "PROCEDURE" [ FormalTypeList ] =:
FormalTypeList := "(" ( ")" FormalReturn |
ProcedureParameters ")" FormalReturn ) =:
FormalReturn := [ ":" OptReturnType ] =:
OptReturnType := "[" Qualident "]" | Qualident =:
ProcedureParameters := ProcedureParameter
{ "," ProcedureParameter } =:
ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
VarIdent := Ident [ "[" ConstExpression "]" ]
=:
VariableDeclaration := VarIdentList ":" Type Alignment =:
VarIdentList := VarIdent % VAR
on: BOOLEAN ;
n : CARDINAL ; %
% on := IsAutoPushOn() ;
IF on
THEN
n := 1
END %
{ "," VarIdent % IF on
THEN
INC(n)
END %
} % IF on
THEN
PushT(n)
END %
=:
Designator := Qualident { SubDesignator } =:
SubDesignator := "." Ident | "[" ExpList "]" | "^" =:
ExpList := Expression { "," Expression } =:
Expression := SimpleExpression [ Relation SimpleExpression ] =:
SimpleExpression := [ "+" | "-" ] Term { AddOperator Term } =:
Term := Factor { MulOperator Factor } =:
Factor := Number | string | SetOrDesignatorOrFunction |
"(" Expression ")" | "NOT" Factor | ConstAttribute =:
SetOrDesignatorOrFunction := ( Qualident [ Constructor |
SimpleDes [ ActualParameters ]
] | Constructor
)
=:
SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
ActualParameters := "(" [ ExpList ] ")" =:
Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
WhileStatement | RepeatStatement | LoopStatement |
ForStatement | WithStatement | AsmStatement |
"EXIT" | "RETURN" [ Expression ] | RetryStatement ] =:
RetryStatement := "RETRY" =:
AssignmentOrProcedureCall := Designator ( ":=" Expression |
ActualParameters | % (* epsilon *) %
) =:
-- these two break LL1 as both start with a Designator
-- ProcedureCall := Designator [ ActualParameters ] =:
-- Assignment := Designator ":=" Expression =:
StatementSequence := Statement { ";" Statement } =:
IfStatement := "IF" Expression "THEN" StatementSequence
{ "ELSIF" Expression "THEN" StatementSequence }
[ "ELSE" StatementSequence ] "END" =:
CaseStatement := "CASE" Expression "OF" Case { "|" Case }
[ "ELSE" StatementSequence ] "END" =:
Case := [ CaseLabelList ":" StatementSequence ] =:
WhileStatement := "WHILE" Expression "DO" StatementSequence "END" =:
RepeatStatement := "REPEAT" StatementSequence "UNTIL" Expression =:
ForStatement := "FOR" Ident ":=" Expression "TO" Expression
[ "BY" ConstExpression ] "DO"
StatementSequence "END" =:
LoopStatement := "LOOP" StatementSequence "END" =:
WithStatement := "WITH" Designator "DO" StatementSequence "END" =:
ProcedureDeclaration := % VAR top: CARDINAL ; %
% top := Top () %
ProcedureHeading ";" PostProcedureHeading % BlockAssert (top = Top ()) %
=:
PostProcedureHeading := ProperProcedure | ForwardDeclaration =:
ForwardDeclaration := "FORWARD" % EndForward %
=:
ProperProcedure := ProcedureBlock % PushAutoOn %
Ident % EndProcedure %
% PopAuto %
=:
DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" |
"__INLINE__" ] =:
ProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
DefineBuiltinProcedure
( % PushAutoOn %
Ident % RegisterProcedure %
% PopAuto %
[ FormalParameters ] AttributeNoReturn ) =:
AttributeNoReturn := [ "<*" Ident "*>" ] =:
AttributeUnused := [ "<*" Ident "*>" ] =:
-- note that we do need to know whether builtins are used as they
-- determine whether we need to parse the implementation module
-- the same is true for hidden types
Builtin := [ "__BUILTIN__" % PutModuleContainsBuiltin %
| "__INLINE__" ] =:
DefProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
Builtin
( Ident [ DefFormalParameters ] AttributeNoReturn )
% M2Error.LeaveErrorScope %
=:
-- introduced procedure block so we can produce more informative
-- error messages
ProcedureBlock := { Declaration } [ "BEGIN" BlockBody ] "END" =:
Block := { Declaration } InitialBlock FinalBlock "END" =:
InitialBlock := [ "BEGIN" BlockBody ] =:
FinalBlock := [ "FINALLY" BlockBody ] =:
BlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
NormalPart := StatementSequence =:
ExceptionalPart := StatementSequence =:
Declaration := "CONST" { ConstantDeclaration ";" } |
"TYPE" { TypeDeclaration ";" } |
"VAR" { VariableDeclaration ";" } |
ProcedureDeclaration ";" |
ModuleDeclaration ";" =:
DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
DefMultiFPSection := DefExtendedFP |
FPSection [ ";" DefMultiFPSection ] =:
FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
MultiFPSection := ExtendedFP |
FPSection [ ";" MultiFPSection ] =:
FPSection := NonVarFPSection | VarFPSection =:
DefExtendedFP := DefOptArg | "..." =:
ExtendedFP := OptArg | "..." =:
VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
OptArg := "[" Ident ":" FormalType [ "=" ConstExpression ] "]" =:
DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
FormalType := { "ARRAY" "OF" } Qualident =:
ModuleDeclaration := "MODULE" % PushAutoOn %
% M2Error.DefaultInnerModule %
Ident % RegisterInnerModule %
% PushAutoOff %
[ Priority ] ";" % PushAutoOn %
{ Import % RegisterInnerImports %
} % PopAuto %
[ Export ] Block % PopAuto %
Ident % EndModule %
% PopAuto %
=:
Priority := "[" ConstExpression "]" =:
Export := "EXPORT" ( "QUALIFIED" IdentList |
"UNQUALIFIED" IdentList |
IdentList
) % EnableImportCheck := TRUE %
";" % EnableImportCheck := FALSE %
=:
Import := "FROM" Ident "IMPORT" IdentList ";" |
"IMPORT" % PushTtok (ImportTok, GetTokenNo () -1)
(* determines whether Ident or Module *) %
IdentList ";" =:
DefinitionModule := % VAR forC: BOOLEAN ; %
% forC := FALSE %
"DEFINITION" % M2Error.DefaultDefinitionModule %
"MODULE" [ "FOR" string % forC := TRUE %
] % PushAutoOn %
Ident % RegisterDefinitionModule (forC) %
";"
{ Import % RegisterImports %
} % PushAutoOff %
[ Export
]
{ Definition } % PopAuto %
"END" Ident % EndModule %
"." % PopAuto %
=:
Definition := "CONST" { ConstantDeclaration ";" } |
"TYPE" { Ident
( ";" % PutHiddenTypeDeclared %
| "=" Type Alignment ";" ) }
|
"VAR" { VariableDeclaration ";" } |
DefProcedureHeading ";" =:
AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
NamedOperand := '[' Ident ']' =:
AsmOperandName := [ NamedOperand ] =:
AsmOperands := ConstExpression [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
=:
AsmList := [ AsmElement ] { ',' AsmElement } =:
AsmElement := AsmOperandName ConstExpression '(' Expression ')'
=:
TrashList := [ ConstExpression ] { ',' ConstExpression } =:
FNB