IMPLEMENTATION MODULE Parser;

FROM FIO IMPORT ReadNBytes;
FROM SYSTEM IMPORT TSIZE, ADR;

FROM MemUtils IMPORT MemZero;
FROM Storage IMPORT ALLOCATE, REALLOCATE;

FROM Lexer IMPORT Lexer, LexerKind, LexerToken, lexer_current, lexer_lex;

(* Calls lexer_lex() but skips the comments. *)
PROCEDURE parser_lex(lexer: PLexer): LexerToken;
VAR
  result: LexerToken;
BEGIN
  result := lexer_lex(lexer);

  WHILE result.kind = lexerKindComment DO
    result := lexer_lex(lexer)
  END;

  RETURN result
END parser_lex;
PROCEDURE parse_type_fields(parser: PParser): PAstFieldDeclaration;
VAR
  token: LexerToken;
  field_declarations: PAstFieldDeclaration;
  field_count: CARDINAL;
  current_field: PAstFieldDeclaration;
BEGIN
  ALLOCATE(field_declarations, TSIZE(AstFieldDeclaration));
  token := parser_lex(parser^.lexer);
  field_count := 0;

  WHILE token.kind <> lexerKindEnd DO
    INC(field_count);
    INC(field_count);
    REALLOCATE(field_declarations, TSIZE(AstFieldDeclaration) * field_count);
    DEC(field_count);
    current_field := field_declarations;
    INC(current_field , TSIZE(AstFieldDeclaration) * (field_count - 1));

    token := parser_lex(parser^.lexer);

    current_field^.field_name := token.identifierKind;

    token := parser_lex(parser^.lexer);
    current_field^.field_type := parse_type_expression(parser);
    token := parser_lex(parser^.lexer);

    IF token.kind = lexerKindSemicolon THEN
      token := parser_lex(parser^.lexer)
    END
  END;
  INC(current_field, TSIZE(AstFieldDeclaration));
  MemZero(current_field, TSIZE(AstFieldDeclaration));

  RETURN field_declarations
END parse_type_fields;
PROCEDURE parse_record_type(parser: PParser): PAstTypeExpression;
VAR
  result: PAstTypeExpression;
BEGIN
  NEW(result);
  result^.kind := astTypeExpressionKindRecord;
  result^.fields := parse_type_fields(parser);

  RETURN result
END parse_record_type;
PROCEDURE parse_pointer_type(parser: PParser): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
BEGIN
  NEW(result);
  result^.kind := astTypeExpressionKindPointer;

  token := lexer_current(parser^.lexer);

  IF token.kind = lexerKindPointer THEN
    token := parser_lex(parser^.lexer)
  END;
  token := lexer_current(parser^.lexer);
  result^.target := parse_type_expression(parser);

  RETURN result
END parse_pointer_type;
PROCEDURE parse_array_type(parser: PParser): PAstTypeExpression;
VAR
  token: LexerToken;
  buffer: ARRAY[1..20] OF CHAR;
  result: PAstTypeExpression;
BEGIN
  NEW(result);
  result^.kind := astTypeExpressionKindArray;
  result^.length := 0;

  token := lexer_current(parser^.lexer);

  IF token.kind = lexerKindArray THEN
    token := parser_lex(parser^.lexer)
  END;
  IF token.kind <> lexerKindOf THEN
    token := parser_lex(parser^.lexer);

    result^.length := token.integerKind;

    token := parser_lex(parser^.lexer)
  END;
  token := parser_lex(parser^.lexer);
  result^.base := parse_type_expression(parser);

  RETURN result
END parse_array_type;
PROCEDURE parse_enumeration_type(parser: PParser): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
  current_case: PIdentifier;
  case_count: CARDINAL;
BEGIN
  NEW(result);
  result^.kind := astTypeExpressionKindEnumeration;

  case_count := 1;
  ALLOCATE(result^.cases, TSIZE(Identifier) * 2);
  token := parser_lex(parser^.lexer);
  current_case := result^.cases;
  current_case^ := token.identifierKind;

  token := parser_lex(parser^.lexer);

  WHILE token.kind = lexerKindComma DO
    token := parser_lex(parser^.lexer);

    INC(case_count);
    INC(case_count);
    REALLOCATE(result^.cases, TSIZE(Identifier) * case_count);
    DEC(case_count);
    current_case := result^.cases;
    INC(current_case, TSIZE(Identifier) * (case_count - 1));
    current_case^ := token.identifierKind;

    token := parser_lex(parser^.lexer)
  END;
  INC(current_case, TSIZE(Identifier));
  MemZero(current_case, TSIZE(Identifier));

  RETURN result
END parse_enumeration_type;
PROCEDURE parse_named_type(parser: PParser): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
BEGIN
  token := lexer_current(parser^.lexer);
  NEW(result);

  result^.kind := astTypeExpressionKindNamed;
  result^.name := token.identifierKind;

  RETURN result
END parse_named_type;
PROCEDURE parse_procedure_type(parser: PParser): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
  current_parameter: PPAstTypeExpression;
  parameter_count: CARDINAL;
BEGIN
  parameter_count := 0;
  NEW(result);
  result^.kind := astTypeExpressionKindProcedure;

  ALLOCATE(result^.parameters, 1);

  token := parser_lex(parser^.lexer);
  token := parser_lex(parser^.lexer);

  WHILE token.kind <> lexerKindRightParen DO
    INC(parameter_count);
    INC(parameter_count);
    REALLOCATE(result^.parameters, TSIZE(PAstTypeExpression) * parameter_count);
    DEC(parameter_count);
    current_parameter := result^.parameters;
    INC(current_parameter, TSIZE(PAstTypeExpression) * (parameter_count - 1));

    current_parameter^ := parse_type_expression(parser);

    token := parser_lex(parser^.lexer);
    IF token.kind = lexerKindComma THEN
      token := parser_lex(parser^.lexer)
    END
  END;
  current_parameter := result^.parameters;
  INC(current_parameter, TSIZE(PAstTypeExpression) * parameter_count);
  current_parameter^ := NIL;

  RETURN result
END parse_procedure_type;
PROCEDURE parse_type_expression(parser: PParser): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
BEGIN
  result := NIL;
  token := lexer_current(parser^.lexer);

  IF token.kind = lexerKindRecord THEN
    result := parse_record_type(parser)
  END;
  IF token.kind = lexerKindLeftParen THEN
    result := parse_enumeration_type(parser)
  END;
  IF (token.kind = lexerKindArray) OR (token.kind = lexerKindLeftSquare) THEN
    result := parse_array_type(parser)
  END;
  IF token.kind = lexerKindHat THEN
    result := parse_pointer_type(parser)
  END;
  IF token.kind = lexerKindProc THEN
    result := parse_procedure_type(parser)
  END;
  IF token.kind = lexerKindIdentifier THEN
    result := parse_named_type(parser)
  END;
  RETURN result
END parse_type_expression;
PROCEDURE parse_type_declaration(parser: PParser): PAstTypedDeclaration;
VAR
  token: LexerToken;
  result: PAstTypedDeclaration;
BEGIN
  token := lexer_current(parser^.lexer);

  NEW(result);
  result^.identifier := token.identifierKind;

  token := parser_lex(parser^.lexer);
  token := parser_lex(parser^.lexer);

  result^.type_expression := parse_type_expression(parser);
  token := parser_lex(parser^.lexer);

  RETURN result
END parse_type_declaration;
PROCEDURE parse_type_part(parser: PParser): PPAstTypedDeclaration;
VAR
  token: LexerToken;
  result: PPAstTypedDeclaration;
  current_declaration: PPAstTypedDeclaration;
  declaration_count: CARDINAL;
BEGIN
  token := lexer_current(parser^.lexer);

  ALLOCATE(result, TSIZE(PAstTypedDeclaration));
  current_declaration := result;
  declaration_count := 0;

  IF token.kind = lexerKindType THEN
    token := parser_lex(parser^.lexer);

    WHILE token.kind = lexerKindIdentifier DO
      INC(declaration_count);

      REALLOCATE(result, TSIZE(PAstTypedDeclaration) * (declaration_count + 1));
      current_declaration := result;
      INC(current_declaration, TSIZE(PAstTypedDeclaration) * (declaration_count - 1));

      current_declaration^ := parse_type_declaration(parser);
      token := parser_lex(parser^.lexer)
    END
  END;
  IF declaration_count <> 0 THEN
    INC(current_declaration, TSIZE(PAstTypedDeclaration))
  END;
  current_declaration^ := NIL;

  RETURN result
END parse_type_part;
PROCEDURE parse_variable_declaration(parser: PParser): PAstVariableDeclaration;
VAR
  token: LexerToken;
  result: PAstVariableDeclaration;
BEGIN
  NEW(result);

  token := lexer_current(parser^.lexer);
  result^.variable_name := token.identifierKind;

  token := parser_lex(parser^.lexer);

  token := parser_lex(parser^.lexer);
  result^.variable_type := parse_type_expression(parser);

  token := parser_lex(parser^.lexer);
  RETURN result
END parse_variable_declaration;
PROCEDURE parse_variable_part(parser: PParser): PPAstVariableDeclaration;
VAR
  token: LexerToken;
  result: PPAstVariableDeclaration;
  current_declaration: PPAstVariableDeclaration;
  declaration_count: CARDINAL;
BEGIN
  token := lexer_current(parser^.lexer);

  ALLOCATE(result, TSIZE(PAstVariableDeclaration));
  current_declaration := result;
  declaration_count := 0;

  IF token.kind = lexerKindVar THEN
    token := parser_lex(parser^.lexer);

    WHILE token.kind = lexerKindIdentifier DO
      INC(declaration_count);

      REALLOCATE(result, TSIZE(PAstVariableDeclaration) * (declaration_count + 1));
      current_declaration := result;
      INC(current_declaration, TSIZE(PAstVariableDeclaration) * (declaration_count - 1));

      current_declaration^ := parse_variable_declaration(parser);
      token := parser_lex(parser^.lexer)
    END
  END;
  IF declaration_count <> 0 THEN
    INC(current_declaration, TSIZE(PAstVariableDeclaration))
  END;
  current_declaration^ := NIL;

  RETURN result
END parse_variable_part;
PROCEDURE parse_constant_declaration(parser: PParser): PAstConstantDeclaration;
VAR
  token: LexerToken;
  result: PAstConstantDeclaration;
BEGIN
  NEW(result);

  token := lexer_current(parser^.lexer);
  result^.constant_name := token.identifierKind;

  token := parser_lex(parser^.lexer);

  token := parser_lex(parser^.lexer);
  result^.constant_value := token.integerKind;

  token := parser_lex(parser^.lexer);

  RETURN result
END parse_constant_declaration;
PROCEDURE parse_constant_part(parser: PParser): PPAstConstantDeclaration;
VAR
  token: LexerToken;
  result: PPAstConstantDeclaration;
  current_declaration: PPAstConstantDeclaration;
  declaration_count: CARDINAL;
BEGIN
  token := lexer_current(parser^.lexer);

  ALLOCATE(result, TSIZE(PAstConstantDeclaration));
  current_declaration := result;
  declaration_count := 0;

  IF token.kind = lexerKindConst THEN
    token := parser_lex(parser^.lexer);

    WHILE token.kind = lexerKindIdentifier DO
      INC(declaration_count);

      REALLOCATE(result, TSIZE(PAstConstantDeclaration) * (declaration_count + 1));
      current_declaration := result;
      INC(current_declaration, TSIZE(PAstConstantDeclaration) * (declaration_count - 1));

      current_declaration^ := parse_constant_declaration(parser);
      token := parser_lex(parser^.lexer)
    END
  END;
  IF declaration_count <> 0 THEN
    INC(current_declaration, TSIZE(PAstConstantDeclaration))
  END;
  current_declaration^ := NIL;

  RETURN result
END parse_constant_part;
PROCEDURE parse_import_statement(parser: PParser): PAstImportStatement;
VAR
  result: PAstImportStatement;
  token: LexerToken;
  symbol_count: CARDINAL;
  current_symbol: PIdentifier;
BEGIN
  NEW(result);
  symbol_count := 1;

  token := parser_lex(parser^.lexer);
  result^.package := token.identifierKind;

  token := parser_lex(parser^.lexer);
  ALLOCATE(result^.symbols, TSIZE(Identifier) * 2);

  current_symbol := result^.symbols;

  token := parser_lex(parser^.lexer);
  current_symbol^ := token.identifierKind;

  token := parser_lex(parser^.lexer);
  WHILE token.kind <> lexerKindSemicolon DO
    token := parser_lex(parser^.lexer);
    INC(symbol_count);

    REALLOCATE(result^.symbols, TSIZE(Identifier) * (symbol_count + 1));
    current_symbol := result^.symbols;
    INC(current_symbol, TSIZE(Identifier) * (symbol_count - 1));

    current_symbol^ := token.identifierKind;
    token := parser_lex(parser^.lexer)
  END;
  INC(current_symbol, TSIZE(Identifier));
  MemZero(current_symbol, TSIZE(Identifier));

  token := parser_lex(parser^.lexer);

  RETURN result
END parse_import_statement;
PROCEDURE parse_import_part(parser: PParser): PPAstImportStatement;
VAR
  token: LexerToken;
  import_statement: PPAstImportStatement;
  result: PPAstImportStatement;
  import_count: CARDINAL;
BEGIN
  token := lexer_current(parser^.lexer);
  ALLOCATE(result, TSIZE(PAstImportStatement));
  import_statement := result;
  import_count := 0;

  WHILE token.kind = lexerKindFrom DO
    INC(import_count);

    REALLOCATE(result, TSIZE(PAstImportStatement) * (import_count + 1));
    import_statement := result;
    INC(import_statement, TSIZE(PAstImportStatement) * (import_count - 1));

    import_statement^ := parse_import_statement(parser);
    token := lexer_current(parser^.lexer)
  END;
  IF import_count > 0 THEN
    INC(import_statement, TSIZE(PAstImportStatement))
  END;
  import_statement^ := NIL;

  RETURN result
END parse_import_part;
PROCEDURE parse_literal(parser: PParser): PAstLiteral;
VAR
  literal: PAstLiteral;
  token: LexerToken;
BEGIN
  literal := NIL;
  token := lexer_current(parser^.lexer);

  IF token.kind = lexerKindInteger THEN
    NEW(literal);

    literal^.kind := astLiteralKindInteger;
    literal^.integer := token.integerKind
  END;
  IF (token.kind = lexerKindCharacter) OR (token.kind = lexerKindString) THEN
    NEW(literal);

    literal^.kind := astLiteralKindString;
    literal^.string := token.stringKind
  END;
  IF token.kind = lexerKindNull THEN
    NEW(literal);

    literal^.kind := astLiteralKindNull
  END;
  IF token.kind = lexerKindBoolean THEN
    NEW(literal);

    literal^.kind := astLiteralKindBoolean;
    literal^.boolean := token.booleanKind
  END;
  IF literal <> NIL THEN
    token := parser_lex(parser^.lexer)
  END;

  RETURN literal
END parse_literal;
PROCEDURE parse_factor(parser: PParser): PAstExpression;
VAR
  next_token: LexerToken;
  result: PAstExpression;
  literal: PAstLiteral;
BEGIN
  result := NIL;
  next_token := lexer_current(parser^.lexer);

  literal := parse_literal(parser);

  IF (result = NIL) AND (literal <> NIL) THEN
    NEW(result);

    result^.kind := astExpressionKindLiteral;
    result^.literal := literal
  END;
  IF (result = NIL) AND (next_token.kind = lexerKindMinus) THEN
    NEW(result);
    next_token := parser_lex(parser^.lexer);

    result^.kind := astExpressionKindUnary;
    result^.unary_operator := astUnaryOperatorMinus;
    result^.unary_operand := parse_factor(parser)
  END;
  IF (result = NIL) AND (next_token.kind = lexerKindTilde) THEN
    NEW(result);
    next_token := parser_lex(parser^.lexer);

    result^.kind := astExpressionKindUnary;
    result^.unary_operator := astUnaryOperatorNot;
    result^.unary_operand := parse_factor(parser)
  END;
  IF (result = NIL) AND (next_token.kind = lexerKindLeftParen) THEN
    next_token := parser_lex(parser^.lexer);
    result := parse_expression(parser);
    IF result <> NIL THEN
      next_token := parser_lex(parser^.lexer)
    END
  END;
  IF (result = NIL) AND (next_token.kind = lexerKindIdentifier) THEN
    NEW(result);

    result^.kind := astExpressionKindIdentifier;
    result^.identifier := next_token.identifierKind;

    next_token := parser_lex(parser^.lexer)
  END;

  RETURN result
END parse_factor;
PROCEDURE parse_designator(parser: PParser): PAstExpression;
VAR
  next_token: LexerToken;
  inner_expression: PAstExpression;
  designator: PAstExpression;
  arguments: PPAstExpression;
  handled: BOOLEAN;
BEGIN
  designator := parse_factor(parser);
  handled := designator <> NIL;
  next_token := lexer_current(parser^.lexer);

  WHILE handled DO
    inner_expression := designator;
    handled := FALSE;

    IF ~handled AND (next_token.kind = lexerKindHat) THEN
      NEW(designator);

      designator^.kind := astExpressionKindDereference;
      designator^.reference := inner_expression;

      next_token := parser_lex(parser^.lexer);
      handled := TRUE
    END;
    IF ~handled AND (next_token.kind = lexerKindLeftSquare) THEN
      NEW(designator);
      next_token := parser_lex(parser^.lexer);

      designator^.kind := astExpressionKindArrayAccess;
      designator^.array := inner_expression;
      designator^.index := parse_expression(parser);

      next_token := parser_lex(parser^.lexer);
      handled := TRUE
    END;
    IF ~handled AND (next_token.kind = lexerKindDot) THEN
      NEW(designator);
      next_token := parser_lex(parser^.lexer);

      designator^.kind := astExpressionKindFieldAccess;
      designator^.aggregate := inner_expression;
      designator^.field := next_token.identifierKind;

      next_token := parser_lex(parser^.lexer);
      handled := TRUE
    END;
    IF ~handled AND (next_token.kind = lexerKindLeftParen) THEN
      NEW(designator);
      next_token := parser_lex(parser^.lexer);

      designator^.kind := astExpressionKindCall;
      designator^.callable := inner_expression;
      designator^.argument_count := 0;
      designator^.arguments := NIL;

      IF next_token.kind <> lexerKindRightParen THEN
        ALLOCATE(designator^.arguments, TSIZE(PAstExpression));
        designator^.argument_count := 1;
        designator^.arguments^ := parse_expression(parser);

        next_token := lexer_current(parser^.lexer);

        WHILE next_token.kind = lexerKindComma DO
          next_token := parser_lex(parser^.lexer);

          designator^.argument_count := designator^.argument_count + 1;
          REALLOCATE(designator^.arguments, TSIZE(PAstExpression) * designator^.argument_count);
          arguments := designator^.arguments;
          INC(arguments, TSIZE(PAstExpression) * (designator^.argument_count - 1));
          arguments^ := parse_expression(parser);

          next_token := lexer_current(parser^.lexer)
        END
      END;

      next_token := parser_lex(parser^.lexer);
      handled := TRUE
    END
  END;

  RETURN designator
END parse_designator;
PROCEDURE parse_binary_expression(parser: PParser; left: PAstExpression; operator: AstBinaryOperator): PAstExpression;
VAR
  next_token: LexerToken;
  result: PAstExpression;
  right: PAstExpression;
BEGIN
  next_token := parser_lex(parser^.lexer);
  right := parse_designator(parser);
  result := NIL;

  IF right <> NIL THEN
    NEW(result);
    result^.kind := astExpressionKindBinary;
    result^.binary_operator := operator;
    result^.lhs := left;
    result^.rhs := right
  END;

  RETURN result
END parse_binary_expression;
PROCEDURE parse_expression(parser: PParser): PAstExpression;
VAR
  next_token: LexerToken;
  left: PAstExpression;
  result: PAstExpression;
  written_bytes: CARDINAL;
BEGIN
  left := parse_designator(parser);
  result := NIL;
  next_token := lexer_current(parser^.lexer);

  IF left <> NIL THEN
    IF (result = NIL) AND (next_token.kind = lexerKindNotEqual) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorNotEquals)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindEqual) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorEquals)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindGreaterThan) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorGreater)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindLessThan) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorLess)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindGreaterEqual) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorGreaterEqual)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindLessEqual) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorLessEqual)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindAnd) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorConjunction)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindOr) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorDisjunction)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindMinus) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorSubtraction)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindPlus) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorSum)
    END;
    IF (result = NIL) AND (next_token.kind = lexerKindAsterisk) THEN
      result := parse_binary_expression(parser, left, astBinaryOperatorMultiplication)
    END
  END;
  IF (result = NIL) AND (left <> NIL) THEN
    result := left
  END;

  RETURN result
END parse_expression;
PROCEDURE parse_return_statement(parser: PParser): PAstStatement;
VAR
  token: LexerToken;
  result: PAstStatement;
BEGIN
  NEW(result);
  result^.kind := astStatementKindReturn;

  token := parser_lex(parser^.lexer);
  result^.returned := parse_expression(parser);

  RETURN result
END parse_return_statement;
PROCEDURE parse_assignment_statement(parser: PParser; assignee: PAstExpression): PAstStatement;
VAR
  token: LexerToken;
  result: PAstStatement;
BEGIN
  NEW(result);
  result^.kind := astStatementKindAssignment;
  result^.assignee := assignee;

  token := parser_lex(parser^.lexer);
  result^.assignment := parse_expression(parser);

  RETURN result
END parse_assignment_statement;
PROCEDURE parse_call_statement(parser: PParser; call: PAstExpression): PAstStatement;
VAR
  result: PAstStatement;
BEGIN
  NEW(result);
  result^.kind := astStatementKindCall;
  result^.call := call;

  RETURN result
END parse_call_statement;
PROCEDURE parse_compound_statement(parser: PParser): AstCompoundStatement;
VAR
  result: AstCompoundStatement;
  token: LexerToken;
  current_statement: PPAstStatement;
  old_count: CARDINAL;
BEGIN
  result.count := 0;
  result.statements := NIL;

  token := lexer_current(parser^.lexer);

  WHILE token.kind <> lexerKindEnd DO
    old_count := result.count;
    INC(result.count);

    REALLOCATE(result.statements, TSIZE(PAstStatement) * result.count);
    current_statement := result.statements;

    INC(current_statement, TSIZE(PAstStatement) * old_count);
    current_statement^ := parse_statement(parser);

    token := lexer_current(parser^.lexer)
  END;

  RETURN result
END parse_compound_statement;
PROCEDURE parse_statement(parser: PParser): PAstStatement;
VAR
  token: LexerToken;
  statement: PAstStatement;
  designator: PAstExpression;
BEGIN
  statement := NIL;
  token := parser_lex(parser^.lexer);

  IF token.kind = lexerKindIf THEN
    statement := parse_if_statement(parser)
  END;
  IF token.kind = lexerKindWhile THEN
    statement := parse_while_statement(parser)
  END;
  IF token.kind = lexerKindReturn THEN
    statement := parse_return_statement(parser)
  END;
  IF token.kind = lexerKindIdentifier THEN
    designator := parse_designator(parser);
    token := lexer_current(parser^.lexer);

    IF token.kind = lexerKindAssignment THEN
      statement := parse_assignment_statement(parser, designator)
    END;
    IF token.kind <> lexerKindAssignment THEN
      statement := parse_call_statement(parser, designator)
    END
  END;
  RETURN statement
END parse_statement;
PROCEDURE parse_if_statement(parser: PParser): PAstStatement;
VAR
  token: LexerToken;
  result: PAstStatement;
BEGIN
  NEW(result);
  result^.kind := astStatementKindIf;

  token := parser_lex(parser^.lexer);
  result^.if_condition := parse_expression(parser);
  result^.if_branch := parse_compound_statement(parser);

  token := parser_lex(parser^.lexer);
  RETURN result
END parse_if_statement;
PROCEDURE parse_while_statement(parser: PParser): PAstStatement;
VAR
  token: LexerToken;
  result: PAstStatement;
BEGIN
  NEW(result);
  result^.kind := astStatementKindWhile;

  token := parser_lex(parser^.lexer);
  result^.while_condition := parse_expression(parser);
  result^.while_body := parse_compound_statement(parser);

  token := parser_lex(parser^.lexer);
  RETURN result
END parse_while_statement;
PROCEDURE parse_statement_part(parser: PParser): AstCompoundStatement;
VAR
  token: LexerToken;
  compound: AstCompoundStatement;
BEGIN
  compound.count := 0;
  compound.statements := NIL;
  token := lexer_current(parser^.lexer);

  IF token.kind = lexerKindBegin THEN
    compound := parse_compound_statement(parser)
  END;

  RETURN compound
END parse_statement_part;
PROCEDURE parse_procedure_heading(parser: PParser): PAstProcedureDeclaration;
VAR
  token: LexerToken;
  declaration: PAstProcedureDeclaration;
  parameter_index: CARDINAL;
  current_parameter: PAstTypedDeclaration;
BEGIN
  NEW(declaration);

  token := parser_lex(parser^.lexer);
  declaration^.name := token.identifierKind;

  token := parser_lex(parser^.lexer);

  declaration^.parameters := NIL;
  declaration^.parameter_count := 0;

  token := parser_lex(parser^.lexer);
  WHILE token.kind <> lexerKindRightParen DO
    parameter_index := declaration^.parameter_count;
    INC(declaration^.parameter_count);
    REALLOCATE(declaration^.parameters, TSIZE(AstTypedDeclaration) * declaration^.parameter_count);

    current_parameter := declaration^.parameters;
    INC(current_parameter, TSIZE(AstTypedDeclaration) * parameter_index);

    current_parameter^.identifier := token.identifierKind;

    token := parser_lex(parser^.lexer);
    token := parser_lex(parser^.lexer);

    current_parameter^.type_expression := parse_type_expression(parser);

    token := parser_lex(parser^.lexer);
    IF token.kind = lexerKindComma THEN
      token := parser_lex(parser^.lexer)
    END
  END;
  token := parser_lex(parser^.lexer);
  declaration^.return_type := NIL;

  (* Check for the return type and write it. *)
  IF token.kind = lexerKindArrow THEN
    token := parser_lex(parser^.lexer);
    declaration^.return_type := parse_type_expression(parser);
    token := parser_lex(parser^.lexer)
  END;
  token := parser_lex(parser^.lexer);

  RETURN declaration
END parse_procedure_heading;
PROCEDURE parse_procedure_declaration(parser: PParser): PAstProcedureDeclaration;
VAR
  token: LexerToken;
  declaration: PAstProcedureDeclaration;
BEGIN
  declaration := parse_procedure_heading(parser);

  declaration^.constants := parse_constant_part(parser);
  declaration^.variables := parse_variable_part(parser);
  declaration^.statements := parse_statement_part(parser);

  token := parser_lex(parser^.lexer);
  token := parser_lex(parser^.lexer);

  RETURN declaration
END parse_procedure_declaration;
PROCEDURE parse_procedure_part(parser: PParser): PPAstProcedureDeclaration;
VAR
  token: LexerToken;
  current_declaration: PPAstProcedureDeclaration;
  result: PPAstProcedureDeclaration;
  declaration_count: CARDINAL;
  declaration_index: CARDINAL;
BEGIN
  token := lexer_current(parser^.lexer);
  declaration_count := 0;
  declaration_index := 0;

  ALLOCATE(result, TSIZE(PAstProcedureDeclaration));

  WHILE token.kind = lexerKindProc DO
    INC(declaration_count);
    REALLOCATE(result, TSIZE(PAstProcedureDeclaration) * (declaration_count + 1));
    current_declaration := result;
    INC(current_declaration, TSIZE(PAstProcedureDeclaration) * declaration_index);

    current_declaration^ := parse_procedure_declaration(parser);
    token := lexer_current(parser^.lexer);
    declaration_index := declaration_count
  END;
  current_declaration := result;
  INC(current_declaration, TSIZE(PAstProcedureDeclaration) * declaration_index);
  current_declaration^ := NIL;

  RETURN result
END parse_procedure_part;
PROCEDURE parse_module(parser: PParser): PAstModule;
VAR
  token: LexerToken;
  result: PAstModule;
BEGIN
  NEW(result);
  token := parser_lex(parser^.lexer);
  result^.main := TRUE;

  IF token.kind = lexerKindModule THEN
    result^.main := FALSE
  END;
  token := parser_lex(parser^.lexer);

  (* Write the module body. *)
  token := parser_lex(parser^.lexer);

  result^.imports := parse_import_part(parser);
  result^.constants := parse_constant_part(parser);
  result^.types := parse_type_part(parser);

  result^.variables := parse_variable_part(parser);
  result^.procedures := parse_procedure_part(parser);
  result^.statements := parse_statement_part(parser);

  token := parser_lex(parser^.lexer);
  token := parser_lex(parser^.lexer);

  RETURN result
END parse_module;
PROCEDURE parse(lexer: PLexer): PAstModule;
VAR
  parser: Parser;
BEGIN
  parser.lexer := lexer;

  RETURN parse_module(ADR(parser))
END parse;
END Parser.