summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/Parser.elna1174
-rw-r--r--source/Transpiler.elna631
2 files changed, 0 insertions, 1805 deletions
diff --git a/source/Parser.elna b/source/Parser.elna
deleted file mode 100644
index 1225750..0000000
--- a/source/Parser.elna
+++ /dev/null
@@ -1,1174 +0,0 @@
-(* 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.
diff --git a/source/Transpiler.elna b/source/Transpiler.elna
deleted file mode 100644
index 5a65036..0000000
--- a/source/Transpiler.elna
+++ /dev/null
@@ -1,631 +0,0 @@
-(* 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 File, WriteNBytes, WriteLine, WriteChar, WriteString;
-from NumberIO import IntToStr;
-
-import common, Parser;
-
-type
- TranspilerContext* = record
- input_name: String;
- output: File;
- definition: File;
- indentation: Word
- end;
-
-proc indent(context: ^TranspilerContext);
-var
- count: Word;
-begin
- count := 0;
-
- while count < context^.indentation do
- WriteString(context^.output, " ");
- count := count + 1u
- end
-end;
-
-(* Write a semicolon followed by a newline. *)
-proc write_semicolon(output: File);
-begin
- WriteChar(output, ';');
- WriteLine(output)
-end;
-
-proc transpile_import_statement(context: ^TranspilerContext, import_statement: ^AstImportStatement);
-var
- current_symbol: ^Identifier;
-begin
- WriteString(context^.output, "FROM ");
- transpile_identifier(context, import_statement^.package);
-
- WriteString(context^.output, " IMPORT ");
-
- current_symbol := import_statement^.symbols;
- transpile_identifier(context, current_symbol^);
- current_symbol := current_symbol + 1;
-
- while current_symbol^[1] <> '\0' do
- WriteString(context^.output, ", ");
- transpile_identifier(context, current_symbol^);
- current_symbol := current_symbol + 1;
- end;
- write_semicolon(context^.output)
-end;
-
-proc transpile_import_part(context: ^TranspilerContext, imports: ^^AstImportStatement);
-var
- import_statement: ^AstImportStatement;
-begin
- while imports^ <> nil do
- transpile_import_statement(context, imports^);
- imports := imports + 1
- end;
- WriteLine(context^.output)
-end;
-
-proc transpile_constant_declaration(context: ^TranspilerContext, declaration: ^AstConstantDeclaration);
-var
- buffer: [20]Char;
-begin
- WriteString(context^.output, " ");
- transpile_identifier(context, declaration^.constant_name);
-
- WriteString(context^.output, " = ");
-
- IntToStr(declaration^.constant_value, 0, buffer);
- WriteString(context^.output, buffer);
-
- write_semicolon(context^.output)
-end;
-
-proc transpile_constant_part(context: ^TranspilerContext, declarations: ^^AstConstantDeclaration, extra_newline: Bool);
-var
- current_declaration: ^^AstConstantDeclaration;
-begin
- if declarations^ <> nil then
- WriteString(context^.output, "CONST");
- WriteLine(context^.output);
-
- current_declaration := declarations;
- while current_declaration^ <> nil do
- transpile_constant_declaration(context, current_declaration^);
-
- current_declaration := current_declaration + 1
- end;
- if extra_newline then
- WriteLine(context^.output)
- end
- end
-end;
-
-proc transpile_module(context: ^TranspilerContext, result: ^AstModule);
-begin
- if result^.main = false then
- WriteString(context^.output, "IMPLEMENTATION ")
- end;
- WriteString(context^.output, "MODULE ");
-
- (* Write the module name and end the line with a semicolon and newline. *)
- transpile_module_name(context);
-
- write_semicolon(context^.output);
- WriteLine(context^.output);
-
- (* Write the module body. *)
-
- transpile_import_part(context, result^.imports);
- transpile_constant_part(context, result^.constants, true);
- transpile_type_part(context, result^.types);
- transpile_variable_part(context, result^.variables, true);
- transpile_procedure_part(context, result^.procedures);
- transpile_statement_part(context, result^.statements);
-
- WriteString(context^.output, "END ");
- transpile_module_name(context);
-
- WriteChar(context^.output, ".");
- WriteLine(context^.output)
-end;
-
-proc transpile_type_fields(context: ^TranspilerContext, fields: ^AstFieldDeclaration);
-var
- current_field: ^AstFieldDeclaration;
-begin
- current_field := fields;
-
- while current_field^.field_name[1] <> '\0' do
- WriteString(context^.output, " ");
- transpile_identifier(context, current_field^.field_name);
-
- WriteString(context^.output, ": ");
- transpile_type_expression(context, current_field^.field_type);
-
- current_field := current_field + 1;
-
- if current_field^.field_name[1] <> '\0' then
- WriteChar(context^.output, ';')
- end;
- WriteLine(context^.output)
- end
-end;
-
-proc transpile_record_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
-begin
- WriteString(context^.output, "RECORD");
- WriteLine(context^.output);
- transpile_type_fields(context, type_expression^.fields);
- WriteString(context^.output, " END")
-end;
-
-proc transpile_pointer_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
-begin
- WriteString(context^.output, "POINTER TO ");
-
- transpile_type_expression(context, type_expression^.target)
-end;
-
-proc transpile_array_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
-var
- buffer: [20]Char;
-begin
- WriteString(context^.output, "ARRAY");
-
- if type_expression^.length <> 0 then
- WriteString(context^.output, "[1..");
-
- IntToStr(type_expression^.length, 0, buffer);
- WriteString(context^.output, buffer);
-
- WriteChar(context^.output, ']')
- end;
- WriteString(context^.output, " OF ");
-
- transpile_type_expression(context, type_expression^.base)
-end;
-
-proc transpile_enumeration_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
-var
- current_case: ^Identifier;
-begin
- current_case := type_expression^.cases;
-
- WriteString(context^.output, "(");
- WriteLine(context^.output);
- WriteString(context^.output, " ");
- transpile_identifier(context, current_case^);
- current_case := current_case + 1;
-
- while current_case^[1] <> '\0' do
- WriteChar(context^.output, ',');
- WriteLine(context^.output);
- WriteString(context^.output, " ");
- transpile_identifier(context, current_case^);
-
- current_case := current_case + 1
- end;
- WriteLine(context^.output);
- WriteString(context^.output, " )")
-end;
-
-proc transpile_identifier(context: ^TranspilerContext, identifier: Identifier);
-var
- written_bytes: Word;
-begin
- written_bytes := WriteNBytes(context^.output, cast(identifier[1]: Word), @identifier[2])
-end;
-
-proc transpile_procedure_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
-var
- result: ^AstTypeExpression;
- current_parameter: ^^AstTypeExpression;
- parameter_count: Word;
-begin
- WriteString(context^.output, "PROCEDURE(");
- current_parameter := type_expression^.parameters;
-
- while current_parameter^ <> nil do
- transpile_type_expression(context, current_parameter^);
-
- current_parameter := current_parameter + 1;
-
- if current_parameter^ <> nil then
- WriteString(context^.output, ", ")
- end
- end;
- WriteChar(context^.output, ')')
-end;
-
-proc transpile_type_expression(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
-begin
- if type_expression^.kind = astTypeExpressionKindRecord then
- transpile_record_type(context, type_expression)
- end;
- if type_expression^.kind = astTypeExpressionKindEnumeration then
- transpile_enumeration_type(context, type_expression)
- end;
- if type_expression^.kind = astTypeExpressionKindArray then
- transpile_array_type(context, type_expression)
- end;
- if type_expression^.kind = astTypeExpressionKindPointer then
- transpile_pointer_type(context, type_expression)
- end;
- if type_expression^.kind = astTypeExpressionKindProcedure then
- transpile_procedure_type(context, type_expression)
- end;
- if type_expression^.kind = astTypeExpressionKindNamed then
- transpile_identifier(context, type_expression^.name)
- end
-end;
-
-proc transpile_type_declaration(context: ^TranspilerContext, declaration: ^AstTypedDeclaration);
-var
- written_bytes: Word;
-begin
- WriteString(context^.output, " ");
-
- transpile_identifier(context^.output, declaration^.identifier);
- WriteString(context^.output, " = ");
-
- transpile_type_expression(context, declaration^.type_expression);
- write_semicolon(context^.output)
-end;
-
-proc transpile_type_part(context: ^TranspilerContext, declarations: ^^AstTypedDeclaration);
-var
- current_declaration: ^^AstTypedDeclaration;
-begin
- if declarations^ <> nil then
- WriteString(context^.output, "TYPE");
- WriteLine(context^.output);
-
- current_declaration := declarations;
- while current_declaration^ <> nil do
- transpile_type_declaration(context, current_declaration^);
-
- current_declaration := current_declaration + 1
- end;
- WriteLine(context^.output)
- end
-end;
-
-proc transpile_variable_declaration(context: ^TranspilerContext, declaration: ^AstVariableDeclaration);
-begin
- WriteString(context^.output, " ");
- transpile_identifier(context, declaration^.variable_name);
-
- WriteString(context^.output, ": ");
-
- transpile_type_expression(context, declaration^.variable_type);
- write_semicolon(context^.output)
-end;
-
-proc transpile_variable_part(context: ^TranspilerContext, declarations: ^^AstVariableDeclaration, extra_newline: Bool);
-var
- current_declaration: ^^AstVariableDeclaration;
-begin
- if declarations^ <> nil then
- WriteString(context^.output, "VAR");
- WriteLine(context^.output);
-
- current_declaration := declarations;
- while current_declaration^ <> nil do
- transpile_variable_declaration(context, current_declaration^);
-
- current_declaration := current_declaration + 1
- end;
- if extra_newline then
- WriteLine(context^.output)
- end
- end
-end;
-
-proc transpile_procedure_heading(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration);
-var
- parameter_index: Word;
- current_parameter: ^AstTypedDeclaration;
-begin
- WriteString(context^.output, "PROCEDURE ");
- transpile_identifier(context, declaration^.name);
- WriteChar(context^.output, '(');
-
- parameter_index := 0;
- current_parameter := declaration^.parameters;
-
- while parameter_index < declaration^.parameter_count do
- transpile_identifier(context, current_parameter^.identifier);
- WriteString(context^.output, ": ");
- transpile_type_expression(context, current_parameter^.type_expression);
-
- parameter_index := parameter_index + 1u;
- current_parameter := current_parameter + 1;
-
- if parameter_index <> declaration^.parameter_count then
- WriteString(context^.output, "; ")
- end
- end;
-
- WriteString(context^.output, ")");
-
- (* Check for the return type and write it. *)
- if declaration^.return_type <> nil then
- WriteString(context^.output, ": ");
- transpile_type_expression(context, declaration^.return_type)
- end;
- write_semicolon(context^.output)
-end;
-
-proc transpile_unary_operator(context: ^TranspilerContext, operator: AstUnaryOperator);
-begin
- if operator = AstUnaryOperator.minus then
- WriteChar(context^.output, '-')
- end;
- if operator = AstUnaryOperator.not then
- WriteChar(context^.output, '~')
- end
-end;
-
-proc transpile_binary_operator(context: ^TranspilerContext, operator: AstBinaryOperator);
-begin
- case operator of
- AstBinaryOperator.sum: WriteChar(context^.output, '+')
- | AstBinaryOperator.subtraction: WriteChar(context^.output, '-')
- | AstBinaryOperator.multiplication: WriteChar(context^.output, '*')
- | AstBinaryOperator.equals: WriteChar(context^.output, '=')
- | AstBinaryOperator.not_equals: WriteChar(context^.output, '#')
- | AstBinaryOperator.less: WriteChar(context^.output, '<')
- | AstBinaryOperator.greater: WriteChar(context^.output, '>')
- | AstBinaryOperator.less_equal: WriteString(context^.output, "<=")
- | AstBinaryOperator.greater_equal: WriteString(context^.output, ">=")
- | AstBinaryOperator.disjunction: WriteString(context^.output, "OR")
- | AstBinaryOperatorConjunction: WriteString(context^.output, "AND")
- end
-end;
-
-proc transpile_expression(context: ^TranspilerContext, expression: ^AstExpression);
-var
- literal: ^AstLiteral;
- buffer: [20]Char;
- argument_index: Word;
- current_argument: ^^AstExpression;
-begin
- if expression^.kind = astExpressionKindLiteral then
- literal := expression^.literal;
-
- if literal^.kind = AstLiteralKind.integer then
- IntToStr(literal^.integer, 0, buffer);
- WriteString(context^.output, buffer)
- end;
- if literal^.kind = AstLiteralKind.string then
- WriteString(context^.output, literal^.string)
- end;
- if literal^.kind = AstLiteralKind.null then
- WriteString(context^.output, "NIL")
- end;
- if (literal^.kind = AstLiteralKind.boolean) & literal^.boolean then
- WriteString(context^.output, "TRUE")
- end;
- if (literal^.kind = AstLiteralKind.boolean) & (literal^.boolean = false) then
- WriteString(context^.output, "FALSE")
- end
- end;
- if expression^.kind = astExpressionKindIdentifier then
- transpile_identifier(context, expression^.identifier)
- end;
- if expression^.kind = astExpressionKindDereference then
- transpile_expression(context, expression^.reference);
- WriteChar(context^.output, '^')
- end;
- if expression^.kind = astExpressionKindArrayAccess then
- transpile_expression(context, expression^.array);
- WriteChar(context^.output, '[');
- transpile_expression(context, expression^.index);
- WriteChar(context^.output, ']')
- end;
- if expression^.kind = astExpressionKindFieldAccess then
- transpile_expression(context, expression^.aggregate);
- WriteChar(context^.output, '.');
- transpile_identifier(contextexpression^.field)
- end;
- if expression^.kind = astExpressionKindUnary then
- transpile_unary_operator(context, expression^.unary_operator);
- transpile_expression(context, expression^.unary_operand)
- end;
- if expression^.kind = astExpressionKindBinary then
- WriteChar(context^.output, '(');
- transpile_expression(context, expression^.lhs);
- WriteChar(context^.output, ' ');
- transpile_binary_operator(context, expression^.binary_operator);
- WriteChar(context^.output, ' ');
- transpile_expression(context, expression^.rhs);
- WriteChar(context^.output, ')')
- end;
- if expression^.kind = astExpressionKindCall then
- transpile_expression(context, expression^.callable);
- WriteChar(context^.output, '(');
-
- current_argument := expression^.arguments;
- if expression^.argument_count > 0 then
- transpile_expression(context, current_argument^);
-
- argument_index := 1u;
- current_argument := current_argument + 1;
-
- while argument_index < expression^.argument_count do
- WriteString(context^.output, ", ");
-
- transpile_expression(context, current_argument^);
-
- current_argument := current_argument + 1;
- argument_index := argument_index + 1u
- end
- end;
- WriteChar(context^.output, ')')
- end
-end;
-
-proc transpile_if_statement(context: ^TranspilerContext, statement: ^AstStatement);
-begin
- WriteString(context^.output, "IF ");
- transpile_expression(context, statement^.if_condition);
-
- WriteString(context^.output, " THEN");
- WriteLine(context^.output);
- context^.indentation := context^.indentation + 1u;
-
- transpile_compound_statement(context, statement^.if_branch);
- context^.indentation := context^.indentation - 1u;
- indent(context);
- WriteString(context^.output, "END")
-end;
-
-proc transpile_while_statement(context: ^TranspilerContext, statement: ^AstStatement);
-begin
- WriteString(context^.output, "WHILE ");
- transpile_expression(context, statement^.while_condition);
-
- WriteString(context^.output, " DO");
- WriteLine(context^.output);
- context^.indentation := context^.indentation + 1u;
-
- transpile_compound_statement(context, statement^.while_body);
- context^.indentation := context^.indentation - 1u;
- indent(context);
- WriteString(context^.output, "END")
-end;
-
-proc transpile_assignment_statement(context: ^TranspilerContext, statement: ^AstStatement);
-begin
- transpile_expression(context, statement^.assignee);
- WriteString(context^.output, " := ");
- transpile_expression(context, statement^.assignment)
-end;
-
-proc transpile_return_statement(context: ^TranspilerContext, statement: ^AstStatement);
-begin
- WriteString(context^.output, "RETURN ");
-
- transpile_expression(context, statement^.returned)
-end;
-
-proc transpile_compound_statement(context: ^TranspilerContext, statement: AstCompoundStatement);
-var
- current_statement: ^^AstStatement;
- index: Word;
-begin
- index := 0;
- current_statement := statement.statements;
-
- while index < statement.count do
- transpile_statement(context, current_statement^);
-
- current_statement := current_statement + 1;
- index := index + 1u;
-
- if index <> statement.count then
- WriteChar(context^.output, ';')
- end;
- WriteLine(context^.output)
- end
-end;
-
-proc transpile_statement(context: ^TranspilerContext, statement: ^AstStatement);
-begin
- indent(context);
-
- if statement^.kind = astStatementKindIf then
- transpile_if_statement(context, statement)
- end;
- if statement^.kind = astStatementKindWhile then
- transpile_while_statement(context, statement)
- end;
- if statement^.kind = astStatementKindReturn then
- transpile_return_statement(context, statement)
- end;
- if statement^.kind = astStatementKindAssignment then
- transpile_assignment_statement(context, statement)
- end;
- if statement^.kind = astStatementKindCall then
- transpile_expression(context, statement^.call)
- end
-end;
-
-proc transpile_statement_part(context: ^TranspilerContext, compound: AstCompoundStatement);
-begin
- if compound.count > 0 then
- WriteString(context^.output, "BEGIN");
- WriteLine(context^.output);
-
- context^.indentation := context^.indentation + 1u;
- transpile_compound_statement(context, compound);
- context^.indentation := context^.indentation - 1u;
- end
-end;
-
-proc transpile_procedure_declaration(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration);
-begin
- transpile_procedure_heading(context, declaration);
-
- transpile_constant_part(context, declaration^.constants, false);
- transpile_variable_part(context, declaration^.variables, false);
- transpile_statement_part(context, declaration^.statements);
-
- WriteString(context^.output, "END ");
- transpile_identifier(context^.output, declaration^.name);
-
- write_semicolon(context^.output)
-end;
-
-proc transpile_procedure_part(context: ^TranspilerContext, declaration: ^^AstProcedureDeclaration);
-begin
- while declaration^ <> nil do
- transpile_procedure_declaration(context, declaration^);
- WriteLine(context^.output);
-
- declaration := declaration + 1
- end
-end;
-
-proc transpile_module_name(context: ^TranspilerContext);
-var
- counter: Word;
- last_slash: Word;
-begin
- counter := 1u;
- last_slash := 0u;
-
- while context^.input_name[counter] <> '.' & context^.input_name[counter] <> '\0' do
- if context^.input_name[counter] = '/' then
- last_slash := counter
- end;
- counter := counter + 1u
- end;
-
- if last_slash = 0u then
- counter := 1u
- end;
- if last_slash <> 0u then
- counter := last_slash + 1u
- end;
- while context^.input_name[counter] <> '.' & context^.input_name[counter] <> '\0' do
- WriteChar(context^.output, context^.input_name[counter]);
- counter := counter + 1u
- end
-end;
-
-proc transpile*(ast_module: ^AstModule, output: File, definition: File, input_name: String);
-var
- context: TranspilerContext;
-begin
- context.input_name := input_name;
- context.output := output;
- context.definition := definition;
- context.indentation := 0u;
-
- transpile_module(@context, ast_module)
-end;
-
-end.
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 19:24:41 +0000