diff options
Diffstat (limited to 'source/Transpiler.elna')
| -rw-r--r-- | source/Transpiler.elna | 631 |
1 files changed, 631 insertions, 0 deletions
diff --git a/source/Transpiler.elna b/source/Transpiler.elna new file mode 100644 index 0000000..5a65036 --- /dev/null +++ b/source/Transpiler.elna @@ -0,0 +1,631 @@ +(* 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. |