Initial commit

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.