elna/source/Parser.elna

(* This Source Code Form is subject to the terms of the Mozilla Public License,
  v. 2.0. If a copy of the MPL was not distributed with this file, You can
  obtain one at https://mozilla.org/MPL/2.0/. *)
module;

from FIO import ReadNBytes;

from MemUtils import MemZero;
from Storage import ALLOCATE, REALLOCATE;

from Common import Identifier, ShortString;
from Lexer import Lexer, LexerKind, LexerToken, lexer_current, lexer_lex;

type
  Parser = record
    lexer: ^Lexer
  end;

  AstLiteralKind* = (
    integer,
    string,
    null,
    boolean
  );
  AstLiteral* = record
    kind: AstLiteralKind;
    value: union
      integer: Int;
      string: ShortString;
      boolean: Bool
    end
  end;

  AstUnaryOperator* = (
    reference,
    not,
    minus
  );
  AstBinaryOperator* = (
    sum,
    subtraction,
    multiplication,
    division,
    remainder,
    equals,
    not_equals,
    less,
    greater,
    less_equal,
    greater_equal,
    disjunction,
    conjunction,
    exclusive_disjunction,
    shift_left,
    shift_right
  );

  AstExpressionKind* = (
    literal,
    identifier,
    array_access,
    dereference,
    field_access,
    unary,
    binary,
    call
  );
  AstExpression* = record 
    kind: AstExpressionKind
    value: union
      literal: ^AstLiteral;
      identifier: Identifier;
      reference: ^AstExpression;
      array_access: record
        array: ^AstExpression;
        index: ^AstExpression
      end;
      field_access: record
        aggregate: ^AstExpression;
        field: Identifier
      end;
      unary: record
        operator: AstUnaryOperator;
        operand: ^AstExpression
      end;
      binary: record
        operator: AstBinaryOperator;
        lhs: ^AstExpression;
        rhs: ^AstExpression
      end;
      call: record
        callable: ^AstExpression;
        argument_count: Word;
        arguments: ^^AstExpression
      end
    end
  end;

  ConditionalStatement = record
	condition: ^AstExpression;
	branch: AstCompoundStatement
  end;

  AstStatementKind* = (
    if_statement,
    while_statement,
    assignment_statement,
    return_statement,
    call_statement
  );
  AstStatement* = record
    kind: AstStatementKind
    value: union
      if_statement: ConditionalStatement;
      while_statement: ConditionalStatement;
      assignment_statement: record
        assignee: ^AstExpression;
        assignment: ^AstExpression
      end;
      return_statement: ^AstExpression;
      call_statement: ^AstExpression
    end
  end;
  AstCompoundStatement* = record
    count: Word;
    statements: ^^AstStatement
  end;

  AstImportStatement* = record
    package: Identifier;
    symbols: ^Identifier
  end;

  AstConstantDeclaration* = record
    constant_name: Identifier;
    constant_value: Int
  end;

  AstFieldDeclaration* = record
    field_name: Identifier;
    field_type: ^AstTypeExpression
  end;

  AstTypeExpressionKind* = (
    named_expression,
    record_expression,
    enumeration_expression,
    array_expression,
    pointer_expression,
    procedure_expression
  );
  AstTypeExpression* = record
    kind: AstTypeExpressionKind;
    value: union
      name: Identifier;
      cases: ^Identifier;
      target: ^AstTypeExpression;
      fields: ^AstFieldDeclaration;
      array_expression: record
        base: ^AstTypeExpression;
        length: Word
      end;
      parameters: ^^AstTypeExpression
    end
  end;

  AstTypedDeclaration* = record
    identifier: Identifier;
    type_expression: ^AstTypeExpression
  end;

  AstVariableDeclaration* = record
    variable_name: Identifier;
    variable_type: ^AstTypeExpression
  end;

  AstProcedureDeclaration* = record
    name: Identifier;
    parameter_count: Word;
    parameters: ^AstTypedDeclaration;
    return_type: ^AstTypeExpression;
    constants: ^^AstConstantDeclaration;
    variables: ^^AstVariableDeclaration;
    statements: AstCompoundStatement
  end;

  AstModule* = record
    main: Bool;
    imports: ^^AstImportStatement;
    constants: ^^AstConstantDeclaration;
    types: ^^AstTypedDeclaration;
    variables: ^^AstVariableDeclaration;
    procedures: ^^AstProcedureDeclaration;
    statements: AstCompoundStatement
  end;

(* Calls lexer_lex() but skips the comments. *)
proc parser_lex(lexer: ^Lexer) -> LexerToken;
var
  result: LexerToken;
begin
  result := lexer_lex(lexer);

  while result.kind = lexerKindComment do
    result := lexer_lex(lexer)
  end;

  return result
end;

proc parse_type_fields(parser: ^Parser) -> ^AstFieldDeclaration;
var
  token: LexerToken;
  field_declarations: ^AstFieldDeclaration;
  field_count: Word;
  current_field: ^AstFieldDeclaration;
begin
  ALLOCATE(field_declarations, #size(AstFieldDeclaration));
  token := parser_lex(parser^.lexer);
  field_count := 0;

  while token.kind <> lexerKindEnd do
    field_count := field_count + 2u;

    REALLOCATE(field_declarations, #size(AstFieldDeclaration) * field_count);
    field_count := field_count - 1u;
    current_field := field_declarations;
    INC(current_field , #size(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, #size(AstFieldDeclaration));
  MemZero(current_field, #size(AstFieldDeclaration));

  return field_declarations
end;

proc parse_record_type(parser: ^Parser) -> ^AstTypeExpression;
var
  result: ^AstTypeExpression;
begin
  NEW(result);
  result^.kind := AstTypeExpressionKind.record_expression;
  result^.fields := parse_type_fields(parser);

  return result
end;

proc parse_pointer_type(parser: ^Parser) -> ^AstTypeExpression;
var
  token: LexerToken;
  result: ^AstTypeExpression;
begin
  NEW(result);
  result^.kind := AstTypeExpressionKind.pointer_expression;

  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;

proc parse_array_type(parser: ^Parser) -> ^AstTypeExpression;
var
  token: LexerToken;
  buffer: [20]CHAR;
  result: ^AstTypeExpression;
begin
  NEW(result);
  result^.kind := AstTypeExpressionKind.array_expression;
  result^.array_expression.length := 0u;

  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^.array_expression.length := token.integerKind;

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

  return result
end;

proc parse_enumeration_type(parser: ^Parser) -> ^AstTypeExpression;
var
  token: LexerToken;
  result: ^AstTypeExpression;
  current_case: ^Identifier;
  case_count: Word;
begin
  NEW(result);
  result^.kind := AstTypeExpressionKind.enumeration_expression;

  case_count := 1;
  ALLOCATE(result^.cases, #size(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);

    case_count := case_count + 2u;

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

    token := parser_lex(parser^.lexer)
  end;
  INC(current_case, #size(Identifier));
  MemZero(current_case, #size(Identifier));

  return result
end;

proc parse_named_type(parser: ^Parser) -> ^AstTypeExpression;
var
  token: LexerToken;
  result: ^AstTypeExpression;
begin
  token := lexer_current(parser^.lexer);
  NEW(result);

  result^.kind := AstTypeExpressionKind.named_expression;
  result^.name := token.identifierKind;

  return result
end;

proc parse_procedure_type(parser: ^Parser) -> ^AstTypeExpression;
var
  token: LexerToken;
  result: ^AstTypeExpression;
  current_parameter: ^^AstTypeExpression;
  parameter_count: Word;
begin
  parameter_count := 0;
  NEW(result);
  result^.kind := AstTypeExpressionKind.procedure_expression;

  ALLOCATE(result^.parameters, 1);

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

  while token.kind <> lexerKindRightParen do
    parameter_count := parameter_count + 2u;

    REALLOCATE(result^.parameters, #size(^AstTypeExpression) * parameter_count);
    parameter_count := parameter_count - 1u;
    current_parameter := result^.parameters;
    INC(current_parameter, #size(^AstTypeExpression) * (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, #size(^AstTypeExpression) * parameter_count);
  current_parameter^ := nil;

  return result
end;

proc parse_type_expression(parser: ^Parser) -> ^AstTypeExpression;
var
  token: LexerToken;
  result: ^AstTypeExpression;
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;

proc parse_type_declaration(parser: ^Parser) -> ^AstTypedDeclaration;
var
  token: LexerToken;
  result: ^AstTypedDeclaration;
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;

proc parse_type_part(parser: ^Parser) -> ^^AstTypedDeclaration;
var
  token: LexerToken;
  result: ^^AstTypedDeclaration;
  current_declaration: ^^AstTypedDeclaration;
  declaration_count: Word;
begin
  token := lexer_current(parser^.lexer);

  ALLOCATE(result, #size(^AstTypedDeclaration));
  current_declaration := result;
  declaration_count := 0u;

  if token.kind = lexerKindType then
    token := parser_lex(parser^.lexer);

    while token.kind = lexerKindIdentifier do
      declaration_count := declaration_count + 1u;

      REALLOCATE(result, #size(^AstTypedDeclaration) * (declaration_count + 1));
      current_declaration := result;
      INC(current_declaration, #size(^AstTypedDeclaration) * (declaration_count - 1));

      current_declaration^ := parse_type_declaration(parser);
      token := parser_lex(parser^.lexer)
    end
  end;
  if declaration_count <> 0u then
    INC(current_declaration, #size(^AstTypedDeclaration))
  end;
  current_declaration^ := nil;

  return result
end;

proc parse_variable_declaration(parser: ^Parser) -> ^AstVariableDeclaration;
var
  token: LexerToken;
  result: ^AstVariableDeclaration;
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;

proc parse_variable_part(parser: ^Parser) -> ^^AstVariableDeclaration;
var
  token: LexerToken;
  result: ^^AstVariableDeclaration;
  current_declaration: ^^AstVariableDeclaration;
  declaration_count: Word;
begin
  token := lexer_current(parser^.lexer);

  ALLOCATE(result, #size(^AstVariableDeclaration));
  current_declaration := result;
  declaration_count := 0;

  if token.kind = lexerKindVar then
    token := parser_lex(parser^.lexer);

    while token.kind = lexerKindIdentifier do
      declaration_count := declaration_count + 1u;

      REALLOCATE(result, #size(^AstVariableDeclaration) * (declaration_count + 1));
      current_declaration := result;
      INC(current_declaration, #size(^AstVariableDeclaration) * (declaration_count - 1));

      current_declaration^ := parse_variable_declaration(parser);
      token := parser_lex(parser^.lexer)
    end
  end;
  if declaration_count <> 0 then
    INC(current_declaration, #size(^AstVariableDeclaration))
  end;
  current_declaration^ := nil;

  return result
end;

proc parse_constant_declaration(parser: ^Parser) -> ^AstConstantDeclaration;
var
  token: LexerToken;
  result: ^AstConstantDeclaration;
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;

proc parse_constant_part(parser: ^Parser) -> ^^AstConstantDeclaration;
var
  token: LexerToken;
  result: ^^AstConstantDeclaration;
  current_declaration: ^^AstConstantDeclaration;
  declaration_count: Word;
begin
  token := lexer_current(parser^.lexer);

  ALLOCATE(result, #size(^AstConstantDeclaration));
  current_declaration := result;
  declaration_count := 0;

  if token.kind = lexerKindConst then
    token := parser_lex(parser^.lexer);

    while token.kind = lexerKindIdentifier do
      declaration_count := declaration_count + 1u;

      REALLOCATE(result, #size(^AstConstantDeclaration) * (declaration_count + 1));
      current_declaration := result;
      INC(current_declaration, #size(^AstConstantDeclaration) * (declaration_count - 1));

      current_declaration^ := parse_constant_declaration(parser);
      token := parser_lex(parser^.lexer)
    end
  end;
  if declaration_count <> 0 then
    INC(current_declaration, #size(^AstConstantDeclaration))
  end;
  current_declaration^ := nil;

  return result
end;

proc parse_import_statement(parser: ^Parser) -> ^AstImportStatement;
var
  result: ^AstImportStatement;
  token: LexerToken;
  symbol_count: Word;
  current_symbol: ^Identifier;
begin
  NEW(result);
  symbol_count := 1u;

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

  token := parser_lex(parser^.lexer);
  ALLOCATE(result^.symbols, #size(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);
    symbol_count := symbol_count + 1u;

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

    current_symbol^ := token.identifierKind;
    token := parser_lex(parser^.lexer)
  end;
  INC(current_symbol, #size(Identifier));
  MemZero(current_symbol, #size(Identifier));

  token := parser_lex(parser^.lexer);

  return result
end;

proc parse_import_part(parser: ^Parser) -> ^^AstImportStatement;
var
  token: LexerToken;
  import_statement: ^^AstImportStatement;
  result: ^^AstImportStatement;
  import_count: Word;
begin
  token := lexer_current(parser^.lexer);
  ALLOCATE(result, #size(^AstImportStatement));
  import_statement := result;
  import_count := 0u;

  while token.kind = lexerKindFrom do
    import_count := import_count + 1u;

    REALLOCATE(result, #size(^AstImportStatement) * (import_count + 1));
    import_statement := result;
    INC(import_statement, #size(^AstImportStatement) * (import_count - 1));

    import_statement^ := parse_import_statement(parser);
    token := lexer_current(parser^.lexer)
  end;
  if import_count > 0 then
    INC(import_statement, #size(^AstImportStatement))
  end;
  import_statement^ := nil;

  return result
end;

proc parse_literal(parser: ^Parser) -> ^AstLiteral;
var
  literal: ^AstLiteral;
  token: LexerToken;
begin
  literal := nil;
  token := lexer_current(parser^.lexer);

  if token.kind = lexerKindInteger then
    NEW(literal);

    literal^.kind := AstLiteralKind.integer;
    literal^.integer := token.integerKind
  end;
  if (token.kind = lexerKindCharacter) or (token.kind = lexerKindString) then
    NEW(literal);

    literal^.kind := AstLiteralKind.string;
    literal^.string := token.stringKind
  end;
  if token.kind = lexerKindNull then
    NEW(literal);

    literal^.kind := AstLiteralKind.null
  end;
  if token.kind = lexerKindBoolean then
    NEW(literal);

    literal^.kind := AstLiteralKind.boolean;
    literal^.boolean := token.booleanKind
  end;
  if literal <> nil then
    token := parser_lex(parser^.lexer)
  end;

  return literal
end;

proc parse_factor(parser: ^Parser) -> ^AstExpression;
var
  next_token: LexerToken;
  result: ^AstExpression;
  literal: ^AstLiteral;
begin
  result := nil;
  next_token := lexer_current(parser^.lexer);

  literal := parse_literal(parser);

  if (result = nil) & (literal <> nil) then
    NEW(result);

    result^.kind := AstExpressionKind.literal;
    result^.literal := literal
  end;
  if (result = nil) & (next_token.kind = lexerKindMinus) then
    NEW(result);
    next_token := parser_lex(parser^.lexer);

    result^.kind := AstExpressionKind.unary;
    result^.unary.operator := AstUnaryOperator.minus;
    result^.unary.operand := parse_factor(parser)
  end;
  if (result = nil) & (next_token.kind = lexerKindTilde) then
    NEW(result);
    next_token := parser_lex(parser^.lexer);

    result^.kind := AstExpressionKind.unary;
    result^.unary.operator := AstUnaryOperator.not;
    result^.unary.operand := parse_factor(parser)
  end;
  if (result = nil) & (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) & (next_token.kind = lexerKindIdentifier) then
    NEW(result);

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

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

  return result
end;

proc parse_designator(parser: ^Parser) -> ^AstExpression;
var
  next_token: LexerToken;
  inner_expression: ^AstExpression;
  designator: ^AstExpression;
  arguments: ^^AstExpression;
  handled: Bool;
begin
  designator := parse_factor(parser);
  handled := designator <> nil;
  next_token := lexer_current(parser^.lexer);

  while handled do
    inner_expression := designator;
    handled := false;

    if ~handled & (next_token.kind = lexerKindHat) then
      NEW(designator);

      designator^.kind := AstExpressionKind.dereference;
      designator^.reference := inner_expression;

      next_token := parser_lex(parser^.lexer);
      handled := true
    end;
    if ~handled & (next_token.kind = lexerKindLeftSquare) then
      NEW(designator);
      next_token := parser_lex(parser^.lexer);

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

      next_token := parser_lex(parser^.lexer);
      handled := true
    end;
    if ~handled & (next_token.kind = lexerKindDot) then
      NEW(designator);
      next_token := parser_lex(parser^.lexer);

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

      next_token := parser_lex(parser^.lexer);
      handled := true
    end;
    if ~handled & (next_token.kind = lexerKindLeftParen) then
      NEW(designator);
      next_token := parser_lex(parser^.lexer);

      designator^.kind := AstExpressionKind.call;
      designator^.call.callable := inner_expression;
      designator^.call.argument_count := 0;
      designator^.call.arguments := nil;

      if next_token.kind <> lexerKindRightParen then
        ALLOCATE(designator^.arguments, #size(^AstExpression));
        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, #size(^AstExpression) * designator^.argument_count);
          arguments := designator^.arguments;
          INC(arguments, #size(^AstExpression) * (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;

proc parse_binary_expression(parser: ^Parser, left: ^AstExpression, operator: AstBinaryOperator) -> ^AstExpression;
var
  next_token: LexerToken;
  result: ^AstExpression;
  right: ^AstExpression;
begin
  next_token := parser_lex(parser^.lexer);
  right := parse_designator(parser);
  result := nil;

  if right <> nil then
    NEW(result);
    result^.kind := AstExpressionKind.binary;
    result^.binary.operator := operator;
    result^.binary.lhs := left;
    result^.binary.rhs := right
  end;

  return result
end;

proc parse_expression(parser: ^Parser) -> ^AstExpression;
var
  next_token: LexerToken;
  left: ^AstExpression;
  result: ^AstExpression;
  written_bytes: Word;
begin
  left := parse_designator(parser);
  result := nil;
  next_token := lexer_current(parser^.lexer);

  if left <> nil then
    if (result = nil) & (next_token.kind = lexerKindNotEqual) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.not_equals)
    end;
    if (result = nil) & (next_token.kind = lexerKindEqual) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.equals)
    end;
    if (result = nil) & (next_token.kind = lexerKindGreaterThan) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.greater)
    end;
    if (result = nil) & (next_token.kind = lexerKindLessThan) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.less)
    end;
    if (result = nil) & (next_token.kind = lexerKindGreaterEqual) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.greater_equal)
    end;
    if (result = nil) & (next_token.kind = lexerKindLessEqual) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.less_equal)
    end;
    if (result = nil) & (next_token.kind = lexerKindAnd) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.conjunction)
    end;
    if (result = nil) & (next_token.kind = lexerKindOr) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.disjunction)
    end;
    if (result = nil) & (next_token.kind = lexerKindMinus) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.subtraction)
    end;
    if (result = nil) & (next_token.kind = lexerKindPlus) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.sum)
    end;
    if (result = nil) & (next_token.kind = lexerKindAsterisk) then
      result := parse_binary_expression(parser, left, AstBinaryOperator.multiplication)
    end
  end;
  if (result = nil) & (left <> nil) then
    result := left
  end;

  return result
end;

proc parse_return_statement(parser: ^Parser) -> ^AstStatement;
var
  token: LexerToken;
  result: ^AstStatement;
begin
  NEW(result);
  result^.kind := AstStatementKind.return_statement;

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

  return result
end;

proc parse_assignment_statement(parser: ^Parser, assignee: ^AstExpression) -> ^AstStatement;
var
  token: LexerToken;
  result: ^AstStatement;
begin
  NEW(result);
  result^.kind := AstStatementKind.assignment_statement;
  result^.assignment_statement.assignee := assignee;

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

  return result
end;

proc parse_call_statement(parser: ^Parser, call: ^AstExpression) -> ^AstStatement;
var
  result: ^AstStatement;
begin
  NEW(result);
  result^.kind := AstStatementKind.call_statement;
  result^.call_statement := call;

  return result
end;

proc parse_compound_statement(parser: ^Parser) -> AstCompoundStatement;
var
  result: AstCompoundStatement;
  token: LexerToken;
  current_statement: ^^AstStatement;
  old_count: Word;
begin
  result.count := 0u;
  result.statements := nil;

  token := lexer_current(parser^.lexer);

  while token.kind <> lexerKindEnd do
    old_count := result.count;
    result.count := result.count + 1u;

    REALLOCATE(result.statements, #size(^AstStatement) * result.count);
    current_statement := result.statements;

    INC(current_statement, #size(^AstStatement) * old_count);
    current_statement^ := parse_statement(parser);

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

  return result
end;

proc parse_statement(parser: ^Parser) -> ^AstStatement;
var
  token: LexerToken;
  statement: ^AstStatement;
  designator: ^AstExpression;
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;

proc parse_if_statement(parser: ^Parser) -> ^AstStatement;
var
  token: LexerToken;
  result: ^AstStatement;
begin
  NEW(result);
  result^.kind := AstStatementKind.if_statement;

  token := parser_lex(parser^.lexer);
  result^.if_statement.condition := parse_expression(parser);
  result^.if_statement.branch := parse_compound_statement(parser);

  token := parser_lex(parser^.lexer);
  return result
end;

proc parse_while_statement(parser: ^Parser) -> ^AstStatement;
var
  token: LexerToken;
  result: ^AstStatement;
begin
  NEW(result);
  result^.kind := AstStatementKind.while_statement;

  token := parser_lex(parser^.lexer);
  result^.while_statement.condition := parse_expression(parser);
  result^.while_statement.body := parse_compound_statement(parser);

  token := parser_lex(parser^.lexer);
  return result
end;

proc parse_statement_part(parser: ^Parser) -> 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;

proc parse_procedure_heading(parser: ^Parser) -> ^AstProcedureDeclaration;
var
  token: LexerToken;
  declaration: ^AstProcedureDeclaration;
  parameter_index: Word;
  current_parameter: ^AstTypedDeclaration;
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, #size(AstTypedDeclaration) * declaration^.parameter_count);

    current_parameter := declaration^.parameters;
    INC(current_parameter, #size(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;

proc parse_procedure_declaration(parser: ^Parser) -> ^AstProcedureDeclaration;
var
  token: LexerToken;
  declaration: ^AstProcedureDeclaration;
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;

proc parse_procedure_part(parser: ^Parser) -> ^^AstProcedureDeclaration;
var
  token: LexerToken;
  current_declaration: ^^AstProcedureDeclaration;
  result: ^^AstProcedureDeclaration;
  declaration_count: Word;
  declaration_index: Word;
begin
  token := lexer_current(parser^.lexer);
  declaration_count := 0u;
  declaration_index := 0u;

  ALLOCATE(result, #size(^AstProcedureDeclaration));

  while token.kind = lexerKindProc do
    declaration_count := declaration_count + 1u;
    REALLOCATE(result, #size(^AstProcedureDeclaration) * (declaration_count + 1));
    current_declaration := result;
    INC(current_declaration, #size(^AstProcedureDeclaration) * declaration_index);

    current_declaration^ := parse_procedure_declaration(parser);
    token := lexer_current(parser^.lexer);
    declaration_index := declaration_count
  end;
  current_declaration := result;
  INC(current_declaration, #size(^AstProcedureDeclaration) * declaration_index);
  current_declaration^ := nil;

  return result
end;

proc parse_module(parser: ^Parser) -> ^AstModule;
var
  token: LexerToken;
  result: ^AstModule;
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;

proc parse*(lexer: ^Lexer) -> ^AstModule;
var
  parser: Parser;
begin
  parser.lexer := lexer;

  return parse_module(@parser)
end;

end.