MODULE FoxIntermediateParser;

IMPORT
  Basic := FoxBasic, 
  Scanner := FoxIntermediateScanner, 
  Fs	:= FoxScanner,
  D := Debugging, 
  SyntaxTree := FoxSyntaxTree, 
(*  Global := FoxGlobal,  *)
  Diagnostics;

CONST
  Trace = TRUE;
(*  CascadedWithSupport = FALSE;*)

(**
  Module        = 'module' SymbolName [Import] { Section } .
  Import        = 'imports' SymbolName { ',' SymbolName } .
  SectionOffset = 'offset' '=' Int .
  Section       = 'bodycode' SymbolName SectionOffset { Stmt }
                | 'inlinecode' SymbolName SectionOffset { Stmt }
                | 'initcode' SymbolName SectionOffset { Stmt }
                | 'var' SymbolName SectionOffset { Var }
                | 'const' SymbolName SectionOffset { Const }
                | 'code' SymbolName SectionOffset { Stmt }
                .
  Var           = 'reserve' Int .
  Const         = 'data' Operand .
  Stmt          = 'nop'
                | 'mov'     Operand ',' Operand [ ',' Operand ]
                | 'conv'    Operand ',' Operand
                | 'call'    Operand ',' Operand
                | 'enter'   Operand ',' Operand
                | 'leave'   Operand
                | 'return'  Operand
                | 'exit'    Operand
                | 'result'  Operand
                | 'trap'    Operand
                | 'br'      Operand
                | 'breq'    Operand ',' Operand ',' Operand
                | 'brne'    Operand ',' Operand ',' Operand
                | 'brlt'    Operand ',' Operand ',' Operand
                | 'brge'    Operand ',' Operand ',' Operand
                | 'pop'     Operand
                | 'push'    Operand
                | 'not'     Operand ',' Operand
                | 'neg'     Operand ',' Operand
                | 'abs'     Operand ',' Operand
                | 'mul'     Operand ',' Operand ',' Operand
                | 'div'     Operand ',' Operand ',' Operand
                | 'mod'     Operand ',' Operand ',' Operand
                | 'sub'     Operand ',' Operand ',' Operand
                | 'add'     Operand ',' Operand ',' Operand
                | 'and'     Operand ',' Operand ',' Operand
                | 'or'      Operand ',' Operand ',' Operand
                | 'xor'     Operand ',' Operand ',' Operand
                | 'shl'     Operand ',' Operand ',' Operand
                | 'shr'     Operand ',' Operand ',' Operand
                | 'rol'     Operand ',' Operand ',' Operand
                | 'ror'     Operand ',' Operand ',' Operand
                | 'copy'    Operand ',' Operand ',' Operand
                | 'fill'    Operand ',' Operand ',' Operand
                | 'asm'     String
                .
  Operand       = Type '[' MemoryAddr ']'       ; Memory Operand
                | Type Register [ Int ]         ; Register Operand
                | Type OpImmediate              ; Immediate Operand
                | Type String                   ; String Operand
                | Int                           ; Number Operand
                .
  OpImmediate   = Symbol
                | Int
                | Hex
                | Float
                .
  MemoryAddr    = Register [ Int ]
                | Symbol
                | Int
                .
  Register      = '$' 'SP'
                | '$' 'FP'
                | '$' Int
                | '$' 'R' '#' Int
                .
  Symbol        = SymbolName ':' Int [ SymbolOffset ] .
  SymbolOffset  = '(' '@' Int ')' .
  SymbolName    = Id
                | '$' Id
                | '$' '$' Id
                .
  Type          = Id .
  Int           = ['-'|'+']('0'..'9')+           ; Integer
  Hex           = ('0'..'9')('0'..'9'|'A'..'F')+'H'
  Float         = ['-']('0'..'9')+'.'('0'..'9')+['E'('-'|'+')('0'..'9')+]
  Id            = ('a'..'z'|'A'..'Z')('a'..'z'|'A'..'Z'|'0'..'9'|'_'|'.'|'@'|'$')+  ; Identifier
  String        = '\'' { (Byte - '\'')|'\\\'' }  '\''

**)

TYPE
  Parser* = OBJECT
  VAR 
    scanner: Scanner.AssemblerScanner;
    symbol-: Fs.Symbol;
    diagnostics: Diagnostics.Diagnostics;
    currentScope: SyntaxTree.Scope;
    recentSymbol: SyntaxTree.Symbol;
    recentComment: SyntaxTree.Comment;
    moduleScope: SyntaxTree.ModuleScope;
    error-: BOOLEAN;

    indent: LONGINT;   (* for debugging purposes only *)

    PROCEDURE S( CONST s: ARRAY OF CHAR );   (* for debugging purposes only *)
    VAR i: LONGINT;
    BEGIN
      D.Ln;  INC( indent );  D.Int( indent,1 );
      FOR i := 1 TO indent DO D.Str( "  " );  END;
      D.Str( "start: " );  D.Str( s );  D.Str( " at pos " );  D.Int( symbol.start,1 );
    END S;

    PROCEDURE E( CONST s: ARRAY OF CHAR );   (* for debugging purposes only *)
    VAR i: LONGINT;
    BEGIN
      D.Ln;  D.Int( indent,1 );
      FOR i := 1 TO indent DO D.Str( "  " );  END;
      D.Str( "end : " );  D.Str( s );  D.Str( " at pos " );  D.Int( symbol.start,1 );
    END E;

(*    PROCEDURE EE( CONST s, t: ARRAY OF CHAR );   (* for debugging purposes only *)
    VAR i: LONGINT;
    BEGIN
      D.Ln;  D.Int( indent,1 );
      FOR i := 1 TO indent DO D.Str( "  " );  END;
      D.Str( "end : " );  D.Str( s );  D.Str( " (" );  D.Str( t );  D.Str( ") at pos " );
    END EE;*)

    (** constructor, init parser with scanner providing input and with diagnostics for error output *)
    PROCEDURE & Init*( scanner: Scanner.AssemblerScanner; diagnostics: Diagnostics.Diagnostics );
    BEGIN
      SELF.scanner := scanner;
      SELF.diagnostics := diagnostics;
      error := ~scanner.GetNextSymbol(symbol);
      recentSymbol := NIL; recentComment := NIL;
      (* debugging *)
      indent := 0;
    END Init;

    (** output error message and / or given code *)
    PROCEDURE Error(position: LONGINT; code: LONGINT; CONST message: ARRAY OF CHAR);
    VAR errorMessage: ARRAY 256 OF CHAR;
    BEGIN
      IF diagnostics # NIL THEN
        Basic.GetErrorMessage(code,message,errorMessage);
        diagnostics.Error(scanner.source, position, code, errorMessage);
      END;
      error := TRUE
    END Error;

    (** helper procedures interfacing to the scanner **)

    (** Get next symbol from scanner and store it in object-local variable 'symbol' *)
    PROCEDURE NextSymbol;
    VAR comment: SyntaxTree.Comment;
    BEGIN
      error := ~scanner.GetNextSymbol(symbol) OR error;
      WHILE ~error & (symbol.token = Scanner.TK_Comment) DO
        comment := SyntaxTree.NewComment(symbol.start, currentScope, symbol.source^,symbol.stringLength);
        moduleScope.AddComment(comment);
        recentComment := comment; comment.SetPreviousSymbol(recentSymbol);
        error := ~scanner.GetNextSymbol(symbol);
      END;
    END NextSymbol;

    (** Check if current symbol equals sym. If yes then return true, return false otherwise *)
    PROCEDURE Peek(token: Fs.Token): BOOLEAN;
    VAR comment: SyntaxTree.Comment;
    BEGIN
      WHILE ~error & (symbol.token = Scanner.TK_Comment) DO
        comment := SyntaxTree.NewComment(symbol.start, currentScope, symbol.source^,symbol.stringLength);
        moduleScope.AddComment(comment);
        recentComment := comment; comment.SetPreviousSymbol(recentSymbol);
        error := ~scanner.GetNextSymbol(symbol);
      END;
      RETURN symbol.token = token
    END Peek;

    (** Check if the current symbol equals sym.If yes then read next symbol, report error otherwise. returns success value  *)
    PROCEDURE Mandatory( token: Fs.Token): BOOLEAN;
    BEGIN
      ASSERT( token # Scanner.TK_Identifier );  ASSERT( token # Scanner.TK_String );  ASSERT( token # Scanner.TK_Number );   (* because of NextSymbol ! *)
      IF ~Peek(token) THEN
        Error( symbol.start, token, "" );
        RETURN FALSE
      ELSE
        NextSymbol;
        RETURN TRUE
      END
    END Mandatory;

    PROCEDURE MandatoryInteger( VAR value: HUGEINT ): BOOLEAN;
    BEGIN
      IF Peek( Scanner.TK_Number ) THEN
        value := symbol.integer;
        NextSymbol;
        RETURN	TRUE;
      ELSE
        Error( symbol.start, Scanner.TK_Number, "" );
        value := 0;
        RETURN FALSE;
      END;
    END MandatoryInteger;


(*    (** Check if the current symbol equals sym. If yes then read next symbol, report error otherwise  *)
    PROCEDURE Check( token: Scanner.Token );
    VAR b: BOOLEAN;
    BEGIN
      b := Mandatory( token );
    END Check;*)

    (** Check if current symbol is an identifier. If yes then copy identifier to name and get next symbol,
    report error otherwise and set name to empty name. returns success value *)
    PROCEDURE MandatoryIdentifier( VAR name: Fs.StringType): BOOLEAN;
    BEGIN
      IF Peek(Scanner.TK_Identifier) THEN
        name := symbol.string;
        NextSymbol;
        RETURN TRUE
      ELSE
        Error( symbol.start, Scanner.TK_Identifier, "" );
        name := "";
        RETURN FALSE
      END
    END MandatoryIdentifier;

    (** Expect an identifier (using MandatoryIdentifier) and return identifier object **)
    PROCEDURE Identifier(): SyntaxTree.Identifier;
    VAR position: LONGINT; name: Fs.StringType; identifier: SyntaxTree.Identifier;
    BEGIN
      position := symbol.start;
      IF MandatoryIdentifier(name) THEN
        identifier := SyntaxTree.NewIdentifier(position,name);
      ELSE
        identifier := SyntaxTree.invalidIdentifier;
      END;
      RETURN identifier
    END Identifier;

    (** Check if current symbol is a string (or string-like character). If yes then copy identifier to name and get next symbol,
    report error otherwise and set name to empty name. returns success value*)
(*    PROCEDURE MandatoryString( VAR name: Fs.StringType ): BOOLEAN;
    BEGIN
      IF Peek( Scanner.TK_String) THEN
        name := symbol.string;
        NextSymbol;
        RETURN TRUE
      ELSIF Peek( Scanner.TK_Character) THEN (* for compatibility with release: characters treated as strings *)
        name := symbol.string;
        NextSymbol;
        RETURN TRUE
      ELSE
        Error( symbol.start, Scanner.TK_String, "" );
        name := "";
        RETURN FALSE
      END
    END MandatoryString;*)

    (** Check if current symbol is an identifier and if the name matches. If yes then get next symbol, report error otherwise. returns success value*)
(*    PROCEDURE ExpectThisIdentifier( name: SyntaxTree.Identifier ): BOOLEAN;
    VAR string: ARRAY 64 OF CHAR;
    BEGIN
      IF name = NIL THEN (* nothing to be expected *)
        RETURN TRUE
      ELSIF (symbol.token # Scanner.TK_Identifier) OR (Basic.MakeString(symbol.string) #  name.name) THEN
        Basic.GetString(name.name,string);
        Error( symbol.start, Scanner.TK_Identifier, string );
        RETURN FALSE
      ELSE
        NextSymbol;
        RETURN TRUE
      END
    END ExpectThisIdentifier;*)

    (** Check if current symbol is an identifier and if the name matches. If yes then get next symbol, report error otherwise. returns success value*)
(*    PROCEDURE ExpectThisString( CONST name: ARRAY OF CHAR ): BOOLEAN;
    BEGIN
      IF (Peek(Scanner.TK_String) OR Peek(Scanner.TK_Character) OR Peek(Scanner.TK_Identifier)) & (symbol.string = name) THEN
        NextSymbol;
        RETURN TRUE
      ELSE
        Error( symbol.start, Scanner.TK_String, name );
        RETURN FALSE
      END
    END ExpectThisString;*)

    (** Check if current symbol equals sym. If yes then get next symbol, return false otherwise *)
    PROCEDURE Optional( token: Fs.Token ): BOOLEAN;
    BEGIN
      (* do not use for Identifier, String or Number, if the result is needed ! *)
      IF Peek(token) THEN
        NextSymbol;
        RETURN TRUE
      ELSE
        RETURN FALSE
      END
    END Optional;

(*    (* ignore one ore more symbols of type token *)
    PROCEDURE Ignore(token: Scanner.Token);
    BEGIN WHILE Optional(token) DO END;
    END Ignore;

    (** Parsing according to the EBNF **)

    (** QualifiedIdentifier = Identifier ['.' Identifier]. **)
    PROCEDURE QualifiedIdentifier( ): SyntaxTree.QualifiedIdentifier;
    VAR prefix,suffix: SyntaxTree.Identifier; qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;  position: LONGINT;
    BEGIN
      IF Trace THEN S( "QualifiedIdentifier" ) END;
      position:= symbol.start;
      prefix := Identifier();
      IF prefix # SyntaxTree.invalidIdentifier THEN
        IF ~Optional( Scanner.Period )THEN
          suffix := prefix;  prefix := NIL;   (* empty *)
        ELSE
           suffix := Identifier();
        END;
        qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier( position, prefix,suffix);
      ELSE
        qualifiedIdentifier := SyntaxTree.invalidQualifiedIdentifier;
      END;
      IF Trace THEN E( "QualifiedIdentifier" ) END;
      RETURN qualifiedIdentifier
    END QualifiedIdentifier;

    (** IdentifierDefinition = Identifier [ '*' | '-' ].  **)
    PROCEDURE IdentifierDefinition( VAR name: SyntaxTree.Identifier;  VAR access: SET; allowedReadOnly: BOOLEAN);
    BEGIN
      IF Trace THEN S( "IdentifierDefinition" ) END;
      name := Identifier();

      IF Optional( Scanner.Times ) THEN
        access := SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal;
      ELSIF Optional( Scanner.Minus ) THEN
        IF ~allowedReadOnly THEN
          Error( symbol.start, Diagnostics.Invalid, "may not be defined read-only" )
        ELSE
          access :=  SyntaxTree.ReadOnly + {SyntaxTree.InternalWrite};
        END;
      ELSE
        access := SyntaxTree.Internal;
      END;
      IF Trace THEN E( "IdentifierDefinition") END;
    END IdentifierDefinition;

    (**    Statement =
                     [
                     Designator [':=' Expression]
                     | 'if' Expression 'then' StatementSequence
                        {'elsif' Expression 'then' StatementSequence} 'end'
                     | 'with' Identifier ':' QualifiedIdentifier 'do'
                         StatementSequence 'end'
                     | 'case' Expression 'of' ['|'] Case {'|' Case} ['else' StatementSequence] 'end'
                     | 'while' Expression 'do' StatementSequence 'end'
                     | 'repeat' StatementSequence 'until' Expression
                     | 'for' Identifier ':=' Expression 'to' Expression ['by' Expression] 'do'
                         StatementSequence 'end'
                     | 'loop' StatementSequence 'end'
                     | 'exit'
                     | 'return' [Expression]
                     | 'await' Expression
                     | 'begin' StatementBlock 'end'
                     | 'code' {any} 'end'
                     ].
    **)
    PROCEDURE Statement( statements: SyntaxTree.StatementSequence; outer: SyntaxTree.Statement): BOOLEAN;
    VAR qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;  expression: SyntaxTree.Expression; designator: SyntaxTree.Designator;  statement: SyntaxTree.Statement;
      ifStatement: SyntaxTree.IfStatement; elsifPart: SyntaxTree.IfPart;   statementSequence: SyntaxTree.StatementSequence;  withStatement: SyntaxTree.WithStatement;
      withPart: SyntaxTree.WithPart; caller: SyntaxTree.ProcedureCallStatement;
      caseStatement: SyntaxTree.CaseStatement;  whileStatement: SyntaxTree.WhileStatement;  repeatStatement: SyntaxTree.RepeatStatement;  forStatement: SyntaxTree.ForStatement;
      identifier: SyntaxTree.Identifier;  loopStatement: SyntaxTree.LoopStatement;  returnStatement: SyntaxTree.ReturnStatement;  awaitStatement: SyntaxTree.AwaitStatement;
      qualifiedType: SyntaxTree.QualifiedType; code : SyntaxTree.Code; position: LONGINT; result: BOOLEAN;
    BEGIN
      IF Trace THEN S( "Statement" ) END;
      CASE symbol.token OF
      | Scanner.Identifier, Scanner.Self, Scanner.Result:
          designator := Designator();
          position := symbol.start;
          IF Optional( Scanner.Becomes ) THEN
            expression := Expression();
            statement := SyntaxTree.NewAssignment( position, designator, expression,outer )
          ELSE
            caller := SyntaxTree.NewProcedureCallStatement(designator.position, designator,outer);
            statement := caller;
          END;
          statements.AddStatement( statement );
          result := TRUE
      | Scanner.If:
          NextSymbol;
          ifStatement := SyntaxTree.NewIfStatement( symbol.start ,outer);
          expression := Expression();
          ifStatement.ifPart.SetCondition( expression );
          Check( Scanner.Then );
          statementSequence := StatementSequence(ifStatement);
          ifStatement.ifPart.SetStatements( statementSequence );
          WHILE Optional( Scanner.Elsif ) DO
            elsifPart := SyntaxTree.NewIfPart();
            ifStatement.AddElsifPart( elsifPart);
            expression := Expression();
            elsifPart.SetCondition( expression );
            Check( Scanner.Then );
            statementSequence := StatementSequence(ifStatement);
            elsifPart.SetStatements( statementSequence );
          END;
          IF Optional( Scanner.Else ) THEN
            statementSequence := StatementSequence(ifStatement);
            ifStatement.SetElsePart( statementSequence );
          END;
          Check( Scanner.End );  statements.AddStatement( ifStatement );
          result := TRUE
      | Scanner.With:
          withStatement := SyntaxTree.NewWithStatement( symbol.start ,outer);
          NextSymbol;
          REPEAT
            identifier := Identifier();
            IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
              Error(identifier.position,Diagnostics.Invalid,"forbidden qualified identifier in with statement");
            END;
            withPart := SyntaxTree.NewWithPart();
            withStatement.AddWithPart(withPart);
            designator := SyntaxTree.NewIdentifierDesignator(identifier.position,identifier);
            withPart.SetVariable( designator );
            Check( Scanner.Colon );
            qualifiedIdentifier := QualifiedIdentifier();
            qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.suffix.position, currentScope, qualifiedIdentifier);
            withPart.SetType(qualifiedType);
            Check( Scanner.Do );
            statementSequence := StatementSequence(withStatement);
            withPart.SetStatements( statementSequence );
          UNTIL ~Optional(Scanner.Bar) OR ~CascadedWithSupport;
          IF CascadedWithSupport & Optional(Scanner.Else) THEN
            statementSequence := StatementSequence(withStatement);
            withStatement.SetElsePart(statementSequence);
          END;
          Check( Scanner.End );
          statements.AddStatement( withStatement );
          result := TRUE
      | Scanner.Case:
          caseStatement := SyntaxTree.NewCaseStatement( symbol.start,outer );
          NextSymbol;
          expression := Expression();
          Check( Scanner.Of );
          caseStatement.SetVariable( expression );
          IF Optional(Scanner.Bar) THEN END;
          REPEAT
            Case(caseStatement)
          UNTIL ~Optional(Scanner.Bar);
          IF Optional( Scanner.Else ) THEN
            statementSequence := StatementSequence(caseStatement);
            caseStatement.SetElsePart( statementSequence );
          END;
          Check( Scanner.End );
          statements.AddStatement( caseStatement );
          result := TRUE
      | Scanner.While:
          NextSymbol;
          whileStatement := SyntaxTree.NewWhileStatement( symbol.start, outer );
          expression := Expression();
          Check( Scanner.Do );
          whileStatement.SetCondition( expression );
          statementSequence := StatementSequence(whileStatement);
          whileStatement.SetStatements( statementSequence );
          Check( Scanner.End );
          statements.AddStatement( whileStatement );
          result := TRUE
      | Scanner.Repeat:
          NextSymbol;
          repeatStatement := SyntaxTree.NewRepeatStatement( symbol.start, outer );
          statementSequence := StatementSequence(repeatStatement);
          repeatStatement.SetStatements( statementSequence );
          Check( Scanner.Until );
          expression := Expression();
          repeatStatement.SetCondition( expression );
          statements.AddStatement( repeatStatement );
          result := TRUE
      | Scanner.For:
          NextSymbol;
          forStatement := SyntaxTree.NewForStatement( symbol.start, outer);
          identifier := Identifier();
          IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
            Error(identifier.position,Diagnostics.Invalid,"forbidden non-local counter variable");
          END;
          designator := SyntaxTree.NewIdentifierDesignator(identifier.position,identifier);
          forStatement.SetVariable( designator );
          Check( Scanner.Becomes );
          expression := Expression();
          forStatement.SetFrom( expression );
          Check( Scanner.To );
          expression := Expression();
          forStatement.SetTo( expression );
          IF Optional( Scanner.By ) THEN
            expression := Expression();
            forStatement.SetBy( expression );
          END;
          Check( Scanner.Do );
          statementSequence := StatementSequence(forStatement);
          forStatement.SetStatements( statementSequence );
          Check( Scanner.End );
          statements.AddStatement( forStatement );
          result := TRUE
      | Scanner.Loop:
          NextSymbol;
          loopStatement := SyntaxTree.NewLoopStatement( symbol.start ,outer);
          statementSequence := StatementSequence(loopStatement);
          loopStatement.SetStatements( statementSequence );
          Check( Scanner.End );
          statements.AddStatement( loopStatement );
          result := TRUE;
      | Scanner.Exit:
          NextSymbol;
          statement := SyntaxTree.NewExitStatement( symbol.start, outer);
          statements.AddStatement( statement );
          result := TRUE;
      | Scanner.Return:
          NextSymbol;
          returnStatement := SyntaxTree.NewReturnStatement( symbol.start, outer);
          IF (symbol.token >= Scanner.Plus) & (symbol.token <= Scanner.Identifier) THEN
            expression := Expression();
            returnStatement.SetReturnValue( expression );
          END;
          statements.AddStatement( returnStatement );
          result := TRUE;
      | Scanner.Begin:
          NextSymbol;  statement := StatementBlock(outer);  statements.AddStatement( statement );  Check( Scanner.End );
          result := TRUE;
      | Scanner.Await:
          awaitStatement := SyntaxTree.NewAwaitStatement( symbol.start, outer );
          NextSymbol;
          expression := Expression();
          awaitStatement.SetCondition( expression );
          statements.AddStatement( awaitStatement );
          result := TRUE
      | Scanner.Code:
        (* assemble *)
        code := Code(outer);
        Check(Scanner.End);
        statements.AddStatement( code );
        result := TRUE
      | Scanner.End:  result := FALSE (* end of if, with, case, while, for, loop, or statement sequence *)
      | Scanner.Until: result := FALSE  (* end of repeat *)
      | Scanner.Else:  result := FALSE (* else of if or case *)
      | Scanner.Elsif:  result := FALSE (* elsif of if *)
      | Scanner.Bar:  result := FALSE (* next case *)
      | Scanner.Finally: result := FALSE  (* end block by finally statement *)
      | Scanner.Semicolon: result := FALSE (* allow the empty statement *)
      (* builtin pseudo procedures are resolved by checker *)
      ELSE Error( symbol.start, Scanner.Semicolon, "" ); result := FALSE;
      END;
      IF Trace THEN E( "Statement" ) END;
      RETURN result
    END Statement;

    (** StatementSequence = Statement {';' Statement}. **)
    PROCEDURE StatementSequence(outer: SyntaxTree.Statement ): SyntaxTree.StatementSequence;
    VAR statements: SyntaxTree.StatementSequence; b: BOOLEAN;
    BEGIN
      IF Trace THEN S( "StatementSequence" ) END;
      statements := SyntaxTree.NewStatementSequence();
      IF Lax THEN
        WHILE ~Peek(Scanner.Return) & Statement(statements,outer) DO Ignore(Scanner.Semicolon) END;
        IF Peek(Scanner.Return) & Statement(statements,outer) THEN Ignore(Scanner.Semicolon) END; (* return bound to end of statement sequence *)
      ELSE
        REPEAT
          b := Statement( statements,outer )
        UNTIL ~Optional( Scanner.Semicolon );
      END;
      IF Trace THEN E( "StatementSequence" ) END;
      RETURN statements
    END StatementSequence;

    (** StatementBlock = ['{' BlockModifier '}'] StatementSequence. **)
    PROCEDURE StatementBlock(outer: SyntaxTree.Statement): SyntaxTree.StatementBlock;
    VAR block: SyntaxTree.StatementBlock;
    BEGIN
      IF Trace THEN S( "StatementBlock" ) END;
      block := SyntaxTree.NewStatementBlock( symbol.end, outer );
      IF Optional( Scanner.LeftBrace ) THEN
        block.SetModifier(Flags());
      END;
      block.SetStatementSequence( StatementSequence(block) );
      IF Trace THEN E( "StatementBlock" ) END;
      RETURN block
    END StatementBlock;

    (** Code = {  Any \ 'end' } . **)
    PROCEDURE Code(outer: SyntaxTree.Statement): SyntaxTree.Code;
    VAR startPos, endPos, i ,len: LONGINT; codeString: Scanner.SourceString; code: SyntaxTree.Code;
    BEGIN
      startPos := symbol.start;
      IF scanner.SkipToNextEnd(startPos, endPos, symbol) THEN
        codeString := symbol.source;
        code := SyntaxTree.NewCode(startPos,outer);
        i := 0; len := LEN(codeString);
        code.SetSourceCode(codeString,len);
      END;
      RETURN code;
    END Code;

    (** wrapper for a body in records and modules *)
    PROCEDURE BodyProcedure(parentScope: SyntaxTree.Scope): SyntaxTree.Procedure;
    VAR procedureScope: SyntaxTree.ProcedureScope; procedure: SyntaxTree.Procedure;
    BEGIN
      procedureScope := SyntaxTree.NewProcedureScope(parentScope);
      IF parentScope IS SyntaxTree.ModuleScope THEN
        procedure := SyntaxTree.NewProcedure( symbol.start, Global.ModuleBodyName,procedureScope);
        procedure.SetAccess(SyntaxTree.Hidden);
      ELSE
        procedure := SyntaxTree.NewProcedure( symbol.start, Global.RecordBodyName,procedureScope);
        (*! todo: make this a hidden symbol. Problematic when used with paco. *)
        procedure.SetAccess(SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal);
      END;
      parentScope.AddProcedure(procedure);
      procedure.SetType(SyntaxTree.NewProcedureType(-1,parentScope));
      procedure.SetBodyProcedure(TRUE);
      procedureScope.SetBody(Body(procedureScope));
      RETURN procedure
    END BodyProcedure;

    (* ProcedureType = 'procedure' [Flags] [FormalParameters]. *)
    PROCEDURE ProcedureType(position: LONGINT;  parentScope: SyntaxTree.Scope): SyntaxTree.ProcedureType;
    VAR procedureType: SyntaxTree.ProcedureType;
    BEGIN
      IF Trace THEN S( "ProcedureType" ) END;
      (* procedure symbol already consumed *)
      procedureType := SyntaxTree.NewProcedureType( position, parentScope);
      IF Optional(Scanner.LeftBrace) THEN
        procedureType.SetModifiers(Flags());
      END;
      IF Optional(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, parentScope) END;
      IF Trace THEN E( "ProcedureType" )
      END;
      RETURN procedureType;
    END ProcedureType;

    (** ParameterDeclaration = ['var'|'const'] Identifier {',' Identifier}':' Type.**)
    PROCEDURE ParameterDeclaration( procedureType: SyntaxTree.ProcedureType ; parentScope: SyntaxTree.Scope);
    VAR
      type: SyntaxTree.Type; name: SyntaxTree.Identifier;
      firstParameter, parameter: SyntaxTree.Parameter;   kind: LONGINT;
    BEGIN
      IF Trace THEN S( "ParameterDeclaration" ) END;
      IF Optional( Scanner.Var ) THEN (* var parameter *)
        kind := SyntaxTree.VarParameter
      ELSIF Optional( Scanner.Const ) THEN (* const parameter *)
        kind := SyntaxTree.ConstParameter
      ELSIF symbol.token # Scanner.Identifier THEN
        Error(symbol.start,Scanner.Identifier,"");
        RETURN
      ELSE kind := SyntaxTree.ValueParameter
      END;
      firstParameter := procedureType.lastParameter;
      REPEAT
        name := Identifier();
        parameter := SyntaxTree.NewParameter(name.position,procedureType,name,kind);
        procedureType.AddParameter(parameter);
      UNTIL ~Optional( Scanner.Comma );
      Check( Scanner.Colon );
      type := Type( NIL, parentScope);
      ASSERT(type # NIL);
      IF firstParameter # NIL THEN parameter := firstParameter.nextParameter ELSE parameter := procedureType.firstParameter END;
      WHILE parameter # NIL DO
        parameter.SetType( type );
        parameter := parameter.nextParameter;
      END;
      IF Trace THEN E( "ParameterDeclaration" )
      END;
    END ParameterDeclaration;
*)
    PROCEDURE CommentSymbol(symbol: SyntaxTree.Symbol);
    BEGIN
      IF (recentComment # NIL) & (recentComment.nextSymbol = NIL) THEN
        recentComment.SetNextSymbol(symbol);
      END;
      recentSymbol := symbol
    END CommentSymbol;
(*
    (** OperatorDeclaration  = 'operator' String ['*'|'-'] FormalParameters ';'
                             DeclarationSequence [Body] 'end' String.
    **)
    PROCEDURE OperatorDeclaration(parentScope: SyntaxTree.Scope );
    VAR
      string: Scanner.StringType; name: Scanner.StringType;
      procedureScope: SyntaxTree.ProcedureScope;
      procedureType: SyntaxTree.ProcedureType;
      operator: SyntaxTree.Operator;
      access: SET;
      i: LONGINT; ch: CHAR; position: LONGINT;
    BEGIN
      IF Trace THEN S( "Operator" ) END;
      (* symbol operator already consumed *)
      position := symbol.start;
      IF MandatoryString( string ) THEN
        (* copy string to name and check for length. LEN(name)>0, LEN(string)>0 can be presumed  *)
        i := 0;
        REPEAT
          ch := string[i];
          name[i] := ch;
          INC(i);
        UNTIL (ch = 0X) OR (i=LEN(string)) OR (i=LEN(name));
        IF ch # 0X THEN (* string too long to act as operator identifier *)
          Error(symbol.start,Basic.StringTooLong,"");
          name := "";
        END;
      ELSE
        name := "";
      END;
      IF Optional( Scanner.Times ) THEN access := SyntaxTree.ReadOnly;
      ELSIF Optional( Scanner.Minus ) THEN access := SyntaxTree.ReadOnly;
      ELSE access := SyntaxTree.Internal;
      END;
      procedureScope := SyntaxTree.NewProcedureScope(parentScope);
      operator := SyntaxTree.NewOperator( symbol.start, SyntaxTree.NewIdentifier(position,name), procedureScope);
      CommentSymbol(operator);
      operator.SetAccess(access * SyntaxTree.ReadOnly);
      procedureType := SyntaxTree.NewProcedureType(symbol.start,parentScope);
      IF Mandatory(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, procedureScope ) END;
      operator.SetType( procedureType );
      IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check( Scanner.Semicolon ) END;
      DeclarationSequence( procedureScope );
      IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
        procedureScope.SetBody(Body(procedureScope));
      END;
      IF Mandatory(Scanner.End) & ExpectThisString(string) THEN END;
      parentScope.AddProcedure(operator);
      IF parentScope IS SyntaxTree.ModuleScope THEN
        parentScope(SyntaxTree.ModuleScope).AddOperator(operator);
      ELSIF parentScope IS SyntaxTree.RecordScope THEN
        parentScope(SyntaxTree.RecordScope).AddOperator(operator);
      ELSE
        Error(position,Diagnostics.Invalid,"Operators only allowed in module scope");
      END;
      IF Trace THEN EE( "Operator", name ) END;
    END OperatorDeclaration;

    (** VariableNameList = IdentifierDefinition [Flags] {',' IdentifierDefinition [Flags]}.**)
    PROCEDURE VariableNameList( scope: SyntaxTree.Scope );
    VAR varname: SyntaxTree.Identifier;  position: LONGINT; variable: SyntaxTree.Variable;  flags,access: SET;
    BEGIN
      IF Trace THEN S( "VariableNameList" ) END;
      REPEAT
        flags := {};
        position := symbol.start;
        IdentifierDefinition( varname, access,TRUE);
        variable := SyntaxTree.NewVariable( position, varname );
        CommentSymbol(variable);
        IF Optional(Scanner.LeftBrace) THEN variable.SetModifiers(Flags()) END;
        variable.SetAccess(access);
        scope.AddVariable(variable);
      UNTIL ~Optional( Scanner.Comma );
      IF Trace THEN E( "VariableNameList" ) END;
    END VariableNameList;

    (** VariableDeclaration = VariableNameList ':' Type. **)
    PROCEDURE VariableDeclaration(parentScope: SyntaxTree.Scope );
    VAR
      variable, firstVariable: SyntaxTree.Variable; type: SyntaxTree.Type;
    BEGIN
      IF Trace THEN S( "VariableDeclaration" ) END;
      firstVariable := parentScope.lastVariable;
      VariableNameList( parentScope );
      Check( Scanner.Colon );
      type := Type( NIL, parentScope );

      variable := firstVariable;
      IF firstVariable #  NIL THEN variable := firstVariable.nextVariable ELSE variable := parentScope.firstVariable END;
      WHILE variable # NIL  DO
        variable.SetType( type );
        variable := variable.nextVariable;
      END;
      IF Trace THEN E( "VariableDeclaration" ) END;
    END VariableDeclaration;

    (** TypeDeclaration = IdentifierDefinition '=' Type.**)
    PROCEDURE TypeDeclaration(parentScope: SyntaxTree.Scope);
    VAR name: SyntaxTree.Identifier;  position: LONGINT; type: SyntaxTree.Type; typeDeclaration: SyntaxTree.TypeDeclaration;   access: SET;
    BEGIN
      IF Trace THEN S( "TypeDeclaration" ) END;
      position := symbol.start;
      IdentifierDefinition( name, access,FALSE);
      typeDeclaration := SyntaxTree.NewTypeDeclaration( position,name);
      CommentSymbol(typeDeclaration);
      Check( Scanner.Equal );
      type := Type( name , parentScope);
      type.SetTypeDeclaration(typeDeclaration);
      typeDeclaration.SetDeclaredType(type);
      (*
      type.SetName(typeDeclaration.name);  (* don't do that: overwrites global names ! *)
      *)
      typeDeclaration.SetAccess(access * SyntaxTree.ReadOnly);
      parentScope.AddTypeDeclaration( typeDeclaration );
      IF Trace THEN E( "TypeDeclaration" ) END;
    END TypeDeclaration;

    (** ConstDeclaration = IdentifierDefinition '=' Expression. **)
    PROCEDURE ConstDeclaration(parentScope: SyntaxTree.Scope );
    VAR name: SyntaxTree.Identifier;  position: LONGINT; constant: SyntaxTree.Constant;  expression: SyntaxTree.Expression;  access: SET;
    BEGIN
      IF Trace THEN S( "ConstDeclaration" ) END;
      IdentifierDefinition( name, access, FALSE);
      position := symbol.start;
      constant := SyntaxTree.NewConstant( position, name );
      CommentSymbol(constant);
      constant.SetAccess(access * SyntaxTree.ReadOnly);
      Check( Scanner.Equal );
      expression := Expression();
      constant.SetValue( expression );
      parentScope.AddConstant( constant );
      IF Trace THEN E( "ConstDeclaration" ) END;
    END ConstDeclaration;
*)

    PROCEDURE StmtSequence( parentScope: SyntaxTree.Scope );
    VAR
    BEGIN
      IF Trace THEN S( "StmtSequence" ) END;
      IF Trace THEN E( "StmtSequence" ) END;
    END StmtSequence;

(**
  OpImmediate   = Symbol
                | Int
                | Hex
                | Float
                .
**)
    PROCEDURE OpImmediate( parentScope: SyntaxTree.Scope ):BOOLEAN;
    VAR
    BEGIN
      IF Trace THEN S( "OpImmediate" ) END;
      IF Trace THEN E( "OpImmediate" ) END;
    END OpImmediate;

(**
  MemoryAddr    = Register [ Int ]
                | Symbol
                | Int
                .
**)
    PROCEDURE MemoryAddr( parentScope: SyntaxTree.Scope ):BOOLEAN;
    VAR
    BEGIN
      IF Trace THEN S( "MemoryAddr" ) END;
      IF Trace THEN E( "MemoryAddr" ) END;
    END MemoryAddr;

(**
  Register      = '$' 'SP'
                | '$' 'FP'
                | '$' Int
                | '$' 'R' '#' Int
                .
**)
    PROCEDURE Register( parentScope: SyntaxTree.Scope ):BOOLEAN;
    VAR
    BEGIN
      IF Trace THEN S( "Register" ) END;
      IF Trace THEN E( "Register" ) END;
    END Register;

    PROCEDURE String( parentScope: SyntaxTree.Scope ):BOOLEAN;
    VAR
    BEGIN
      IF Trace THEN S( "String" ) END;
      IF Trace THEN E( "String" ) END;
    END String;

(**
  Operand       = Type '[' MemoryAddr ']'       ; Memory Operand
                | Type Register [ Int ]         ; Register Operand
                | Type OpImmediate              ; Immediate Operand
                | Type String                   ; String Operand
                | Int                           ; Number Operand
                .
**)
    PROCEDURE Operand( parentScope: SyntaxTree.Scope );
    VAR
      value	: HUGEINT;
      dummy : BOOLEAN;
      type : Fs.StringType;
    BEGIN
      IF Trace THEN S( "Operand" ) END;
      IF MandatoryIdentifier( type ) THEN
        (* Type *)
        IF Optional( Scanner.TK_LeftBracket ) THEN
        
        ELSIF Register( parentScope ) THEN
        
        ELSIF OpImmediate( parentScope ) THEN
        
        ELSIF String( parentScope ) THEN
        
        ELSE
          Error( symbol.start, symbol.token, "Operand" );
        END;
      ELSE
        (* Number *)
        dummy := MandatoryInteger( value );
	 END;
      IF Trace THEN E( "Operand" ) END;
    END Operand;

(**
  Const         = 'data' Operand .
**)
    PROCEDURE ConstSequence( parentScope: SyntaxTree.Scope );
    VAR
    BEGIN
      IF Trace THEN S( "ConstSequence" ) END;
      WHILE Optional( Scanner.TK_Data ) DO
        Operand( parentScope );
      END;
      IF Trace THEN E( "ConstSequence" ) END;
    END ConstSequence;


(**
  SectionOffset = 'offset' '=' Int .
**)
    PROCEDURE SectionOffset( parentScope: SyntaxTree.Scope);
    VAR
      value : HUGEINT;
    BEGIN
      IF Trace THEN S( "SectionOffset" ) END;
      IF Mandatory( Scanner.TK_Offset ) THEN
        IF Mandatory( Scanner.TK_Becomes ) THEN
          IF MandatoryInteger( value ) THEN
          END;
        END;
      END;
      IF Trace THEN E( "SectionOffset" ) END;
    END SectionOffset;

(**
  Section       = 'bodycode' SymbolName SectionOffset { Stmt }
                | 'inlinecode' SymbolName SectionOffset { Stmt }
                | 'initcode' SymbolName SectionOffset { Stmt }
                | 'var' SymbolName SectionOffset { Var }
                | 'const' SymbolName SectionOffset { Const }
                | 'code' SymbolName SectionOffset { Stmt }
                .
**)
    PROCEDURE Section( parentScope: SyntaxTree.Scope);
    VAR
      previousScope: SyntaxTree.Scope;
      name : SyntaxTree.Identifier;
    BEGIN
      previousScope := currentScope;
      currentScope := parentScope;
      IF Trace THEN S( "Section" ) END;
      LOOP
        IF Optional( Scanner.TK_Bodycode ) THEN
          name := Identifier();
          SectionOffset( parentScope );
          StmtSequence( parentScope );
        ELSIF Optional( Scanner.TK_Inlinecode ) THEN
(*          ...*)
        ELSIF Optional( Scanner.TK_Const ) THEN
          name := Identifier();
          SectionOffset( parentScope );
          ConstSequence( parentScope );
        ELSE EXIT
        END;
      END;
      currentScope := previousScope;
      IF Trace THEN E( "Section" ) END;
    END Section;

(**
  Import        = 'imports' SymbolName { ',' SymbolName } .
**)
    PROCEDURE ImportList( moduleScope: SyntaxTree.ModuleScope );
    VAR
      name : SyntaxTree.Identifier;
      import        : SyntaxTree.Import;
      position      : LONGINT;
    BEGIN
      IF Trace THEN S( "Import" ) END;
      (* import symbol already consumed *)
      REPEAT
        position := symbol.start;
        name := Identifier();
        IF name # SyntaxTree.invalidIdentifier THEN
          import := SyntaxTree.NewImport( position, name, name, TRUE );
          CommentSymbol(import);
          moduleScope.AddImport( import );
        END;
      UNTIL ~Optional( Scanner.TK_Comma );
      IF Trace THEN E( "Import" );  END;
    END ImportList;

(**
  Module        = 'module' SymbolName [Import] { Section } .
**)
    PROCEDURE Module*(): SyntaxTree.Module;
    VAR moduleName: SyntaxTree.Identifier;  module: SyntaxTree.Module;  position: LONGINT; 
    BEGIN
      IF Trace THEN S( "Module" ) END;
      position := symbol.start;
      moduleScope := SyntaxTree.NewModuleScope(); (* needed to feed in comment already before module starts *)
      currentScope := moduleScope;
      IF Mandatory( Scanner.TK_Module ) THEN
        moduleName :=  Identifier();
        module := SyntaxTree.NewModule( scanner.source, moduleName.position, moduleName, moduleScope, 0 );
        module.SetType(SyntaxTree.moduleType);
        CommentSymbol(module);
        IF Optional(Scanner.TK_Imports) THEN
        	ImportList(moduleScope)
        END;
        Section( moduleScope );
      END;
      IF Trace THEN E( "Module" ) END;
      RETURN module
    END Module;

    (** check if another module declaration is available after recent module parsing -> for parsing and compiling multiple modules within a single file **)
    PROCEDURE NextModule*(): BOOLEAN;
    BEGIN
      NextSymbol;
      RETURN Peek(Scanner.TK_Module);
    END NextModule;

  END Parser;

  (* utilities *)
(*  PROCEDURE AppendModifier(VAR list: SyntaxTree.Modifier; modifier: SyntaxTree.Modifier);
  VAR this, next: SyntaxTree.Modifier;
  BEGIN
    IF list = NIL THEN list := modifier
    ELSE
      this := list;
      next := list.nextModifier;
      WHILE next # NIL DO
        this := next;
        next := this.nextModifier;
      END;
      this.SetNext(modifier);
    END;
  END AppendModifier;*)

  (** parser retrieval **)
  PROCEDURE NewParser*( scanner: Scanner.AssemblerScanner;  diagnostics: Diagnostics.Diagnostics): Parser;
  VAR parser: Parser;
  BEGIN
    NEW( parser, scanner, diagnostics );  RETURN parser;
  END NewParser;

END FoxIntermediateParser.