module;

from FIO import WriteNBytes, WriteLine, WriteChar, WriteString;
from SYSTEM import ADR, TSIZE;

from NumberIO import IntToStr;

from Common import Identifier, PIdentifier, ShortString;
from Parser import AstTypeExpressionKind, AstExpressionKind, AstLiteralKind, AstUnaryOperator, AstBinaryOperator,
  PAstModule, PPAstExpression, PAstExpression, PAstLiteral, PPAstProcedureDeclaration,
  PAstConstantDeclaration, PPAstConstantDeclaration, PPAstStatement, PAstStatement, AstStatementKind,
  AstTypedDeclaration, PAstTypedDeclaration, PPAstTypedDeclaration, AstCompoundStatement, PAstProcedureDeclaration,
  PAstVariableDeclaration, PPAstVariableDeclaration, PAstImportStatement, PPAstImportStatement,
  PAstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration;

proc indent(context: PTranspilerContext);
var
  count: CARDINAL;
begin
  count := 0;

  while count < context^.indentation do
    WriteString(context^.output, '  ');
    INC(count)
  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: PTranspilerContext, import_statement: PAstImportStatement);
var
  written_bytes: CARDINAL;
  current_symbol: PIdentifier;
begin
  WriteString(context^.output, 'FROM ');
  written_bytes := WriteNBytes(context^.output, ORD(import_statement^.package[1]), ADR(import_statement^.package[2]));

  WriteString(context^.output, ' IMPORT ');

  current_symbol := import_statement^.symbols;
  written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2]));
  INC(current_symbol, TSIZE(Identifier));

  while ORD(current_symbol^[1]) <> 0 do
    WriteString(context^.output, ', ');
    written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2]));
    INC(current_symbol, TSIZE(Identifier))
  end;
  write_semicolon(context^.output)
end;

proc transpile_import_part(context: PTranspilerContext, imports: PPAstImportStatement);
var
  import_statement: PAstImportStatement;
begin
  while imports^ <> nil do
    transpile_import_statement(context, imports^);
    INC(imports, TSIZE(PAstImportStatement))
  end;
  WriteLine(context^.output)
end;

proc transpile_constant_declaration(context: PTranspilerContext, declaration: PAstConstantDeclaration);
var
  buffer: [20]CHAR;
  written_bytes: CARDINAL;
begin
  WriteString(context^.output, '  ');
  written_bytes := WriteNBytes(context^.output, ORD(declaration^.constant_name[1]), ADR(declaration^.constant_name[2]));

  WriteString(context^.output, ' = ');

  IntToStr(declaration^.constant_value, 0, buffer);
  WriteString(context^.output, buffer);

  write_semicolon(context^.output)
end;

proc transpile_constant_part(context: PTranspilerContext, declarations: PPAstConstantDeclaration, extra_newline: BOOLEAN);
var
  current_declaration: PPAstConstantDeclaration;
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^);

      INC(current_declaration, TSIZE(PAstConstantDeclaration))
    end;
    if extra_newline then
      WriteLine(context^.output)
    end
  end
end;

proc transpile_module(context: PTranspilerContext, result: PAstModule);
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: PTranspilerContext, fields: PAstFieldDeclaration);
var
  written_bytes: CARDINAL;
  current_field: PAstFieldDeclaration;
begin
  current_field := fields;

  while ORD(current_field^.field_name[1]) <> 0 do
    WriteString(context^.output, '    ');
    written_bytes := WriteNBytes(context^.output, ORD(current_field^.field_name[1]), ADR(current_field^.field_name[2]));

    WriteString(context^.output, ': ');
    transpile_type_expression(context, current_field^.field_type);

    INC(current_field , TSIZE(AstFieldDeclaration));

    if ORD(current_field^.field_name[1]) <> 0 then
      WriteChar(context^.output, ';')
    end;
    WriteLine(context^.output)
  end
end;

proc transpile_record_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
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: PTranspilerContext, type_expression: PAstTypeExpression);
begin
  WriteString(context^.output, 'POINTER TO ');

  transpile_type_expression(context, type_expression^.target)
end;

proc transpile_array_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
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: PTranspilerContext, type_expression: PAstTypeExpression);
var
  current_case: PIdentifier;
  written_bytes: CARDINAL;
begin
  current_case := type_expression^.cases;

  WriteString(context^.output, '(');
  WriteLine(context^.output);
  WriteString(context^.output, '    ');
  written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2]));
  INC(current_case, TSIZE(Identifier));

  while ORD(current_case^[1]) <> 0 do
    WriteChar(context^.output, ',');
    WriteLine(context^.output);
    WriteString(context^.output, '    ');
    written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2]));

    INC(current_case, TSIZE(Identifier))
  end;
  WriteLine(context^.output);
  WriteString(context^.output, '  )')
end;

proc transpile_named_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
var
  written_bytes: CARDINAL;
begin
  written_bytes := WriteNBytes(context^.output, ORD(type_expression^.name[1]), ADR(type_expression^.name[2]))
end;

proc transpile_procedure_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
var
  result: PAstTypeExpression;
  current_parameter: PPAstTypeExpression;
  parameter_count: CARDINAL;
begin
  WriteString(context^.output, 'PROCEDURE(');
  current_parameter := type_expression^.parameters;

  while current_parameter^ <> nil do
    transpile_type_expression(context, current_parameter^);

    INC(current_parameter, TSIZE(PAstTypeExpression));

    if current_parameter^ <> nil then
      WriteString(context^.output, ', ')
    end
  end;
  WriteChar(context^.output, ')')
end;

proc transpile_type_expression(context: PTranspilerContext, type_expression: PAstTypeExpression);
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_named_type(context, type_expression)
  end
end;

proc transpile_type_declaration(context: PTranspilerContext, declaration: PAstTypedDeclaration);
var
  written_bytes: CARDINAL;
begin
  WriteString(context^.output, '  ');

  written_bytes := WriteNBytes(context^.output, ORD(declaration^.identifier[1]), ADR(declaration^.identifier[2]));
  WriteString(context^.output, ' = ');

  transpile_type_expression(context, declaration^.type_expression);
  write_semicolon(context^.output)
end;

proc transpile_type_part(context: PTranspilerContext, declarations: PPAstTypedDeclaration);
var
  current_declaration: PPAstTypedDeclaration;
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^);

      INC(current_declaration, TSIZE(PAstTypedDeclaration))
    end;
    WriteLine(context^.output)
  end
end;

proc transpile_variable_declaration(context: PTranspilerContext, declaration: PAstVariableDeclaration);
var
  written_bytes: CARDINAL;
begin
  WriteString(context^.output, '  ');
  written_bytes := WriteNBytes(context^.output, ORD(declaration^.variable_name[1]), ADR(declaration^.variable_name[2]));

  WriteString(context^.output, ': ');

  transpile_type_expression(context, declaration^.variable_type);
  write_semicolon(context^.output)
end;

proc transpile_variable_part(context: PTranspilerContext, declarations: PPAstVariableDeclaration, extra_newline: BOOLEAN);
var
  current_declaration: PPAstVariableDeclaration;
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^);

      INC(current_declaration, TSIZE(PAstVariableDeclaration))
    end;
    if extra_newline then
      WriteLine(context^.output)
    end
  end
end;

proc transpile_procedure_heading(context: PTranspilerContext, declaration: PAstProcedureDeclaration);
var
  written_bytes: CARDINAL;
  parameter_index: CARDINAL;
  current_parameter: PAstTypedDeclaration;
begin
  WriteString(context^.output, 'PROCEDURE ');
  written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2]));
  WriteChar(context^.output, '(');

  parameter_index := 0;
  current_parameter := declaration^.parameters;

  while parameter_index < declaration^.parameter_count do
    written_bytes := WriteNBytes(context^.output, ORD(current_parameter^.identifier[1]), ADR(current_parameter^.identifier[2]));
    WriteString(context^.output, ': ');
    transpile_type_expression(context, current_parameter^.type_expression);

    INC(parameter_index);
    INC(current_parameter, TSIZE(AstTypedDeclaration));

    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: PTranspilerContext, operator: AstUnaryOperator);
begin
  if operator = astUnaryOperatorMinus then
    WriteChar(context^.output, '-')
  end;
  if operator = astUnaryOperatorNot then
    WriteChar(context^.output, '~')
  end
end;

proc transpile_binary_operator(context: PTranspilerContext, operator: AstBinaryOperator);
begin
  if operator = astBinaryOperatorSum then
    WriteChar(context^.output, '+')
  end;
  if operator = astBinaryOperatorSubtraction then
    WriteChar(context^.output, '-')
  end;
  if operator = astBinaryOperatorMultiplication then
    WriteChar(context^.output, '*')
  end;
  if operator = astBinaryOperatorEquals then
    WriteChar(context^.output, '=')
  end;
  if operator = astBinaryOperatorNotEquals then
    WriteChar(context^.output, '#')
  end;
  if operator = astBinaryOperatorLess then
    WriteChar(context^.output, '<')
  end;
  if operator = astBinaryOperatorGreater then
    WriteChar(context^.output, '>')
  end;
  if operator = astBinaryOperatorLessEqual then
    WriteString(context^.output, '<=')
  end;
  if operator = astBinaryOperatorGreaterEqual then
    WriteString(context^.output, '>=')
  end;
  if operator = astBinaryOperatorDisjunction then
    WriteString(context^.output, 'OR')
  end;
  if operator = astBinaryOperatorConjunction then
    WriteString(context^.output, 'AND')
  end
end;

proc transpile_expression(context: PTranspilerContext, expression: PAstExpression);
var
  literal: PAstLiteral;
  buffer: [20]CHAR;
  written_bytes: CARDINAL;
  argument_index: CARDINAL;
  current_argument: PPAstExpression;
begin
  if expression^.kind = astExpressionKindLiteral then
    literal := expression^.literal;

    if literal^.kind = astLiteralKindInteger then
      IntToStr(literal^.integer, 0, buffer);
      WriteString(context^.output, buffer)
    end;
    if literal^.kind = astLiteralKindString then
      WriteString(context^.output, literal^.string)
    end;
    if literal^.kind = astLiteralKindNull then
      WriteString(context^.output, 'NIL')
    end;
    if (literal^.kind = astLiteralKindBoolean) & literal^.boolean then
      WriteString(context^.output, 'TRUE')
    end;
    if (literal^.kind = astLiteralKindBoolean) & (literal^.boolean = false) then
      WriteString(context^.output, 'FALSE')
    end
  end;
  if expression^.kind = astExpressionKindIdentifier then
    written_bytes := WriteNBytes(context^.output, ORD(expression^.identifier[1]), ADR(expression^.identifier[2]))
  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, '.');
    written_bytes := WriteNBytes(context^.output, ORD(expression^.field[1]), ADR(expression^.field[2]))
  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 := 1;
      INC(current_argument, TSIZE(PAstExpression));

      while argument_index < expression^.argument_count do
        WriteString(context^.output, ', ');

        transpile_expression(context, current_argument^);

        INC(current_argument, TSIZE(PAstExpression));
        INC(argument_index)
      end
    end;
    WriteChar(context^.output, ')')
  end
end;

proc transpile_if_statement(context: PTranspilerContext, statement: PAstStatement);
begin
  WriteString(context^.output, 'IF ');
  transpile_expression(context, statement^.if_condition);

  WriteString(context^.output, ' THEN');
  WriteLine(context^.output);
  INC(context^.indentation);

  transpile_compound_statement(context, statement^.if_branch);
  DEC(context^.indentation);
  indent(context);
  WriteString(context^.output, 'END')
end;

proc transpile_while_statement(context: PTranspilerContext, statement: PAstStatement);
begin
  WriteString(context^.output, 'WHILE ');
  transpile_expression(context, statement^.while_condition);

  WriteString(context^.output, ' DO');
  WriteLine(context^.output);
  INC(context^.indentation);

  transpile_compound_statement(context, statement^.while_body);
  DEC(context^.indentation);
  indent(context);
  WriteString(context^.output, 'END')
end;

proc transpile_assignment_statement(context: PTranspilerContext, statement: PAstStatement);
begin
  transpile_expression(context, statement^.assignee);
  WriteString(context^.output, ' := ');
  transpile_expression(context, statement^.assignment)
end;

proc transpile_return_statement(context: PTranspilerContext, statement: PAstStatement);
begin
  WriteString(context^.output, 'RETURN ');

  transpile_expression(context, statement^.returned)
end;

proc transpile_compound_statement(context: PTranspilerContext, statement: AstCompoundStatement);
var
  current_statement: PPAstStatement;
  index: CARDINAL;
begin
  index := 0;
  current_statement := statement.statements;

  while index < statement.count do
    transpile_statement(context, current_statement^);

    INC(current_statement, TSIZE(PAstStatement));
    INC(index);

    if index <> statement.count then
      WriteChar(context^.output, ';')
    end;
    WriteLine(context^.output)
  end
end;

proc transpile_statement(context: PTranspilerContext, statement: PAstStatement);
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: PTranspilerContext, compound: AstCompoundStatement);
begin
  if compound.count > 0 then
    WriteString(context^.output, 'BEGIN');
    WriteLine(context^.output);

    INC(context^.indentation);
    transpile_compound_statement(context, compound);
    DEC(context^.indentation)
  end
end;

proc transpile_procedure_declaration(context: PTranspilerContext, declaration: PAstProcedureDeclaration);
var
  written_bytes: CARDINAL;
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 ');
  written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2]));

  write_semicolon(context^.output)
end;

proc transpile_procedure_part(context: PTranspilerContext, declaration: PPAstProcedureDeclaration);
begin
  while declaration^ <> nil do
    transpile_procedure_declaration(context, declaration^);
    WriteLine(context^.output);

    INC(declaration, TSIZE(PAstProcedureDeclaration))
  end
end;

proc transpile_module_name(context: PTranspilerContext);
var
  counter: CARDINAL;
  last_slash: CARDINAL;
begin
  counter := 1;
  last_slash := 0;

  while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
    if context^.input_name[counter] = '/' then
      last_slash := counter
    end;
    INC(counter)
  end;

  if last_slash = 0 then
    counter := 1
  end;
  if last_slash <> 0 then
    counter := last_slash + 1
  end;
  while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
    WriteChar(context^.output, context^.input_name[counter]);
    INC(counter)
  end
end;

proc transpile(ast_module: PAstModule, output: File, definition: File, input_name: ShortString);
var
  context: TranspilerContext;
begin
  context.input_name := input_name;
  context.output := output;
  context.definition := definition;
  context.indentation := 0;

  transpile_module(ADR(context), ast_module)
end;

end.