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