diff options
Diffstat (limited to 'source/Transpiler.elna')
| -rw-r--r-- | source/Transpiler.elna | 631 |
1 files changed, 0 insertions, 631 deletions
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. |