summaryrefslogtreecommitdiff
path: root/source/Parser.elna
diff options
context:
space:
mode:
Diffstat (limited to 'source/Parser.elna')
-rw-r--r--source/Parser.elna1174
1 files changed, 1174 insertions, 0 deletions
diff --git a/source/Parser.elna b/source/Parser.elna
new file mode 100644
index 0000000..1225750
--- /dev/null
+++ b/source/Parser.elna
@@ -0,0 +1,1174 @@
+(* 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;
+
+import cstdlib, common, Lexer;
+
+type
+ Parser = record
+ lexer: ^Lexer
+ end;
+
+ AstLiteralKind* = (
+ integer,
+ string,
+ null,
+ boolean
+ );
+ AstLiteral* = record
+ kind: AstLiteralKind;
+ value: union
+ integer: Int;
+ string: String;
+ 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
+ field_declarations := malloc(#size(AstFieldDeclaration));
+ token := parser_lex(parser^.lexer);
+ field_count := 0;
+
+ while token.kind <> lexerKindEnd do
+ field_count := field_count + 2u;
+
+ field_declarations := realloc(field_declarations, #size(AstFieldDeclaration) * field_count);
+ field_count := field_count - 1u;
+ current_field := field_declarations + (field_count - 1u);
+
+ 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;
+ current_field := current_field + 1;
+ memset(current_field, 0, #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 := 1u;
+ result^.cases := malloc(#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;
+
+ result^.cases := realloc(result^.cases, #size(Identifier) * case_count);
+ case_count := case_count - 1u;
+ current_case := result^.cases + (case_count - 1u);
+ current_case^ := token.identifierKind;
+
+ token := parser_lex(parser^.lexer)
+ end;
+ current_case := current_case + 1;
+ memset(current_case, 0, #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 := 0u;
+ NEW(result);
+ result^.kind := AstTypeExpressionKind.procedure_expression;
+
+ result^.parameters := malloc(#size(^AstTypeExpression));
+
+ token := parser_lex(parser^.lexer);
+ token := parser_lex(parser^.lexer);
+
+ while token.kind <> lexerKindRightParen do
+ parameter_count := parameter_count + 2u;
+
+ result^.parameters := realloc(result^.parameters, #size(^AstTypeExpression) * parameter_count);
+ parameter_count := parameter_count - 1u;
+ current_parameter := result^.parameters + (parameter_count - 1u);
+
+ 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 + 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);
+
+ result := malloc(#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;
+
+ result := realloc(result, #size(^AstTypedDeclaration) * (declaration_count + 1));
+ current_declaration := result + (declaration_count - 1u);
+
+ current_declaration^ := parse_type_declaration(parser);
+ token := parser_lex(parser^.lexer)
+ end
+ end;
+ if declaration_count <> 0u then
+ current_declaration := current_declaration + 1
+ 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);
+
+ result := malloc(#size(^AstVariableDeclaration));
+ current_declaration := result;
+ declaration_count := 0u;
+
+ if token.kind = lexerKindVar then
+ token := parser_lex(parser^.lexer);
+
+ while token.kind = lexerKindIdentifier do
+ declaration_count := declaration_count + 1u;
+
+ result := realloc(result, #size(^AstVariableDeclaration) * (declaration_count + 1));
+ current_declaration := result + (declaration_count - 1u);
+
+ current_declaration^ := parse_variable_declaration(parser);
+ token := parser_lex(parser^.lexer)
+ end
+ end;
+ if declaration_count <> 0 then
+ current_declaration := current_declaration + 1
+ 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);
+
+ result := malloc(#size(^AstConstantDeclaration));
+ current_declaration := result;
+ declaration_count := 0u;
+
+ if token.kind = lexerKindConst then
+ token := parser_lex(parser^.lexer);
+
+ while token.kind = lexerKindIdentifier do
+ declaration_count := declaration_count + 1u;
+
+ result := realloc(result, #size(^AstConstantDeclaration) * (declaration_count + 1u));
+ current_declaration := result + (declaration_count - 1u);
+
+ current_declaration^ := parse_constant_declaration(parser);
+ token := parser_lex(parser^.lexer)
+ end
+ end;
+ if declaration_count <> 0 then
+ current_declaration := current_declaration + 1
+ 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);
+ result^.symbols := malloc(#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;
+
+ result^.symbols := realloc(result^.symbols, #size(Identifier) * (symbol_count + 1u));
+ current_symbol := result^.symbols + (symbol_count - 1u);
+
+ current_symbol^ := token.identifierKind;
+ token := parser_lex(parser^.lexer)
+ end;
+ current_symbol := current_symbol + 1;
+ memset(current_symbol, 0, #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);
+ result := malloc(#size(^AstImportStatement));
+ import_statement := result;
+ import_count := 0u;
+
+ while token.kind = lexerKindFrom do
+ import_count := import_count + 1u;
+
+ result := realloc(result, #size(^AstImportStatement) * (import_count + 1u));
+ import_statement := result + (import_count - 1u);
+
+ import_statement^ := parse_import_statement(parser);
+ token := lexer_current(parser^.lexer)
+ end;
+ if import_count > 0u then
+ import_statement := import_count + 1
+ 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
+ designator^.arguments := malloc(#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;
+ designator^.arguments := realloc(designator^.arguments, #size(^AstExpression) * designator^.argument_count);
+ arguments := designator^.arguments + (designator^.argument_count - 1u);
+ 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;
+
+ result.statements := realloc(result.statements, #size(^AstStatement) * result.count);
+ current_statement := result.statements + 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 := 0u;
+
+ token := parser_lex(parser^.lexer);
+ while token.kind <> lexerKindRightParen do
+ parameter_index := declaration^.parameter_count;
+ declaration^.parameter_count := declaration^.parameter_count + 1;
+ declaration^.parameters := realloc(declaration^.parameters, #size(AstTypedDeclaration) * declaration^.parameter_count);
+
+ current_parameter := declaration^.parameters + 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;
+
+ result := malloc(#size(^AstProcedureDeclaration));
+
+ while token.kind = lexerKindProc do
+ declaration_count := declaration_count + 1u;
+ result := realloc(result, #size(^AstProcedureDeclaration) * (declaration_count + 1));
+ current_declaration := result + declaration_index;
+
+ current_declaration^ := parse_procedure_declaration(parser);
+ token := lexer_current(parser^.lexer);
+ declaration_index := declaration_count
+ end;
+ current_declaration := result + 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.