elna/source/Transpiler.elna

implementation module Transpiler;

from FIO import WriteNBytes, StdOut;
from SYSTEM import ADR, ADDRESS;

from Terminal import Write, WriteLn, WriteString;
from Lexer import Lexer, LexerToken, LexerCurrent, LexerLex, LexerKind;

type
  PTranspilerContext = ^TranspilerContext;
  TranspilerContext = record
    Indentation: CARDINAL
  end;

(* Calls LexerLex() but skips the comments. *)
proc TranspilerLex(ALexer: PLexer): LexerToken;
var
  Result: LexerToken;
begin
  Result := LexerLex(ALexer);

  while Result.Kind = lexerKindComment do
    Result := LexerLex(ALexer)
  end;

  return Result
END TranspilerLex;

(* Write a semicolon followed by a newline. *)
proc WriteSemicolon();
begin
  WriteString(';');
  WriteLn()
END WriteSemicolon;

proc TranspileImport(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('FROM ');
  Token := TranspilerLex(ALexer);

  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);
  WriteString(' IMPORT ');

  Token := TranspilerLex(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);
  while Token.Kind <> lexerKindSemicolon do
    WriteString(', ');
    Token := TranspilerLex(ALexer);
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Token := TranspilerLex(ALexer)
  end;
  WriteSemicolon();
  Token := TranspilerLex(ALexer)
END TranspileImport;

proc TranspileImportPart(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
begin
  Token := LexerCurrent(ALexer);

  while Token.Kind = lexerKindFrom do
    TranspileImport(AContext, ALexer);
    Token := LexerCurrent(ALexer)
  end;
  WriteLn()
END TranspileImportPart;

proc TranspileConstant(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('  ');
  Token := LexerCurrent(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);
  WriteString(' = ');

  Token := TranspilerLex(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);
  WriteSemicolon()
END TranspileConstant;

proc TranspileConstantPart(AContext: PTranspilerContext; ALexer: PLexer): BOOLEAN;
var
  Token: LexerToken;
  Result: BOOLEAN;
begin
  Token := LexerCurrent(ALexer);
  Result := Token.Kind = lexerKindConst;

  if Result then
    WriteString('CONST');
    WriteLn();
    Token := TranspilerLex(ALexer);

    while Token.Kind = lexerKindIdentifier do
      TranspileConstant(AContext, ALexer);
      Token := TranspilerLex(ALexer)
    end
  end;
  return Result
END TranspileConstantPart;

proc TranspileModule(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  Token := TranspilerLex(ALexer);

  if Token.Kind = lexerKindDefinition then
    WriteString('DEFINITION ');
    Token := TranspilerLex(ALexer)
  end;
  if Token.Kind = lexerKindImplementation then
    WriteString('IMPLEMENTATION ');
    Token := TranspilerLex(ALexer)
  end;
  WriteString('MODULE ');

  (* Write the module name and end the line with a semicolon and newline. *)
  Token := TranspilerLex(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);
  WriteSemicolon();
  WriteLn();

  (* Write the module body. *)
  Token := TranspilerLex(ALexer);
  TranspileImportPart(AContext, ALexer);
  if TranspileConstantPart(AContext, ALexer) then
    WriteLn()
  end;
  TranspileTypePart(AContext, ALexer);
  if TranspileVariablePart(AContext, ALexer) then
    WriteLn()
  end;
  TranspileProcedurePart(AContext, ALexer);

  Token := LexerCurrent(ALexer);
  while Token.Kind <> lexerKindEof do
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    WriteLn();

    Token := TranspilerLex(ALexer)
  end
END TranspileModule;

proc TranspileTypeFields(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  Token := TranspilerLex(ALexer);

  while Token.Kind <> lexerKindEnd do
    WriteString('    ');
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Token := TranspilerLex(ALexer);
    WriteString(': ');
    TranspileTypeExpression(AContext, ALexer);
    Token := TranspilerLex(ALexer);

    if Token.Kind = lexerKindSemicolon then
      Token := TranspilerLex(ALexer);
      Write(';')
    end;
    WriteLn()
  end
END TranspileTypeFields;

proc TranspileRecordType(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
begin
  WriteString('RECORD');
  WriteLn();
  TranspileTypeFields(AContext, ALexer);
  WriteString('  END')
END TranspileRecordType;

proc TranspilePointerType(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  Token := LexerCurrent(ALexer);
  WriteString('POINTER TO ');
  if Token.Kind = lexerKindPointer then
    Token := TranspilerLex(ALexer)
  end;
  TranspileTypeExpression(AContext, ALexer)
END TranspilePointerType;

proc TranspileArrayType(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('ARRAY');
  Token := TranspilerLex(ALexer);

  if Token.Kind <> lexerKindOf then
    Write('[');
    Token := TranspilerLex(ALexer);
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Token := TranspilerLex(ALexer);
    WriteString('..');
    Token := TranspilerLex(ALexer);
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Token := TranspilerLex(ALexer);
    Write(']');
    Token := TranspilerLex(ALexer)
  end;
  WriteString(' OF ');
  TranspileTypeExpression(AContext, ALexer)
END TranspileArrayType;

proc TranspileEnumerationType(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('(');
  WriteLn();
  WriteString('    ');

  Token := TranspilerLex(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);

  while Token.Kind = lexerKindComma do
    Write(',');
    WriteLn();
    WriteString('    ');
    Token := TranspilerLex(ALexer);
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

    Token := TranspilerLex(ALexer)
  end;
  WriteLn();
  WriteString('  )')
END TranspileEnumerationType;

proc TranspileUnionType(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
END TranspileUnionType;

proc TranspileProcedureType(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  Token := TranspilerLex(ALexer);
  WriteString('PROCEDURE(');

  Token := TranspilerLex(ALexer);

  while Token.Kind <> lexerKindRightParen do
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

    Token := TranspilerLex(ALexer);
    if Token.Kind = lexerKindComma then
      Token := TranspilerLex(ALexer);
      WriteString(', ')
    end
  end;
  Write(')')
END TranspileProcedureType;

proc TranspileTypeExpression(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  Token := TranspilerLex(ALexer);
  if Token.Kind = lexerKindRecord then
    TranspileRecordType(AContext, ALexer)
  end;
  if Token.Kind = lexerKindLeftParen then
    TranspileEnumerationType(AContext, ALexer)
  end;
  if Token.Kind = lexerKindArray then
    TranspileArrayType(AContext, ALexer)
  end;
  if (Token.Kind = lexerKindPointer) OR (Token.Kind = lexerKindHat) then
    TranspilePointerType(AContext, ALexer)
  end;
  if Token.Kind = lexerKindProc then
    TranspileProcedureType(AContext, ALexer)
  end;
  if Token.Kind = lexerKindIdentifier then
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start)
  end
END TranspileTypeExpression;

proc TranspileTypeDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('  ');
  Token := LexerCurrent(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);
  WriteString(' = ');
  TranspileTypeExpression(AContext, ALexer);
  Token := TranspilerLex(ALexer);
  WriteSemicolon();
END TranspileTypeDeclaration;

proc TranspileTypePart(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
begin
  Token := LexerCurrent(ALexer);

  if Token.Kind = lexerKindType then
    WriteString('TYPE');
    WriteLn();
    Token := TranspilerLex(ALexer);

    while Token.Kind = lexerKindIdentifier do
      TranspileTypeDeclaration(AContext, ALexer);
      Token := TranspilerLex(ALexer)
    end;
    WriteLn()
  end
END TranspileTypePart;

proc TranspileVariableDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('  ');
  Token := LexerCurrent(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);
  WriteString(': ');
  TranspileTypeExpression(AContext, ALexer);
  Token := TranspilerLex(ALexer);
  WriteSemicolon()
END TranspileVariableDeclaration;

proc TranspileVariablePart(AContext: PTranspilerContext; ALexer: PLexer): BOOLEAN;
var
  Token: LexerToken;
  Result: BOOLEAN;
begin
  Token := LexerCurrent(ALexer);
  Result := Token.Kind = lexerKindVar;

  if Result then
    WriteString('VAR');
    WriteLn();
    Token := TranspilerLex(ALexer);

    while Token.Kind = lexerKindIdentifier do
      TranspileVariableDeclaration(AContext, ALexer);
      Token := TranspilerLex(ALexer)
    end
  end;
  return Result
END TranspileVariablePart;

proc TranspileProcedureHeading(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('PROCEDURE ');

  Token := TranspilerLex(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

  Token := TranspilerLex(ALexer);
  Write('(');

  Token := TranspilerLex(ALexer);
  while Token.Kind <> lexerKindRightParen do
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);

    Token := TranspilerLex(ALexer);
    WriteString(': ');

    TranspileTypeExpression(AContext, ALexer);

    Token := TranspilerLex(ALexer);
    if Token.Kind = lexerKindSemicolon then
      WriteString('; ');
      Token := TranspilerLex(ALexer)
    end
  end;
  WriteString(')');
  Token := TranspilerLex(ALexer);

  (* Check for the return type and write it. *)
  if Token.Kind = lexerKindColon then
    WriteString(': ');
    Token := TranspilerLex(ALexer);
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Token := TranspilerLex(ALexer)
  end;
  Token := TranspilerLex(ALexer);
  WriteSemicolon()
END TranspileProcedureHeading;

proc TranspileIfStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('  IF ');
  Token := TranspilerLex(ALexer);

  while Token.Kind <> lexerKindThen do
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Write(' ');
    Token := TranspilerLex(ALexer)
  end;
  WriteString('THEN');
  WriteLn();
  TranspileStatements(AContext, ALexer);
  WriteString('  END');
  Token := TranspilerLex(ALexer)
END TranspileIfStatement;

proc TranspileWhileStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('  WHILE ');
  Token := TranspilerLex(ALexer);

  while Token.Kind <> lexerKindDo do
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Write(' ');
    Token := TranspilerLex(ALexer)
  end;
  WriteString('DO');
  WriteLn();
  TranspileStatements(AContext, ALexer);
  WriteString('  END');
  Token := TranspilerLex(ALexer)
END TranspileWhileStatement;

proc TranspileAssignmentStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString(' := ');
  Token := TranspilerLex(ALexer);

  while (Token.Kind <> lexerKindSemicolon) AND (Token.Kind <> lexerKindEnd) do
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Write(' ');
    Token := TranspilerLex(ALexer)
  end
END TranspileAssignmentStatement;

proc TranspileCallStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('(');
  Token := TranspilerLex(ALexer);

  while (Token.Kind <> lexerKindSemicolon) AND (Token.Kind <> lexerKindEnd) do
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Token := TranspilerLex(ALexer)
  end
END TranspileCallStatement;

proc TranspileReturnStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  WriteString('  RETURN ');
  Token := TranspilerLex(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
  Token := TranspilerLex(ALexer)
END TranspileReturnStatement;

proc TranspileStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
begin
  Token := TranspilerLex(ALexer);

  if Token.Kind = lexerKindIf then
    TranspileIfStatement(AContext, ALexer)
  end;
  if Token.Kind = lexerKindWhile then
    TranspileWhileStatement(AContext, ALexer)
  end;
  if Token.Kind = lexerKindReturn then
    TranspileReturnStatement(AContext, ALexer)
  end;
  if Token.Kind = lexerKindIdentifier then
    WriteString('  ');
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
    Token := TranspilerLex(ALexer);

    while Token.Kind = lexerKindLeftSquare do
      Write('[');
      Token := TranspilerLex(ALexer);
      while Token.Kind <> lexerKindRightSquare do
        WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
        Token := TranspilerLex(ALexer)
      end;
      Write(']');
      Token := TranspilerLex(ALexer);
    end;
    if Token.Kind = lexerKindHat then
      Write('^');
      Token := TranspilerLex(ALexer)
    end;
    if Token.Kind = lexerKindDot then
      Write('.');
      Token := TranspilerLex(ALexer);
      WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
      Token := TranspilerLex(ALexer);
    end;
    if Token.Kind = lexerKindHat then
      Write('^');
      Token := TranspilerLex(ALexer)
    end;

    if Token.Kind = lexerKindAssignment then
      TranspileAssignmentStatement(AContext, ALexer)
    end;
    if Token.Kind = lexerKindLeftParen then
      TranspileCallStatement(AContext, ALexer)
    end
  end
END TranspileStatement;

proc TranspileStatements(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
begin
  Token := LexerCurrent(ALexer);

  while Token.Kind <> lexerKindEnd do
    TranspileStatement(AContext, ALexer);
    Token := LexerCurrent(ALexer);

    if Token.Kind = lexerKindSemicolon then
      Write(';')
    end;
    WriteLn()
  end
END TranspileStatements;

proc TranspileStatementPart(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
begin
  Token := LexerCurrent(ALexer);
  if Token.Kind = lexerKindBegin then
    WriteString('BEGIN');
    WriteLn();
    TranspileStatements(AContext, ALexer)
  end
END TranspileStatementPart;

proc TranspileProcedureDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
  SeenPart: BOOLEAN;
  WrittenBytes: CARDINAL;
begin
  TranspileProcedureHeading(AContext, ALexer);
  SeenPart := TranspileConstantPart(AContext, ALexer);
  SeenPart := TranspileVariablePart(AContext, ALexer);
  TranspileStatementPart(AContext, ALexer);
  WriteString('END ');
  Token := TranspilerLex(ALexer);
  WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
  Token := TranspilerLex(ALexer);
  WriteSemicolon();
  Token := TranspilerLex(ALexer)
END TranspileProcedureDeclaration;

proc TranspileProcedurePart(AContext: PTranspilerContext; ALexer: PLexer);
var
  Token: LexerToken;
begin
  Token := LexerCurrent(ALexer);

  while Token.Kind = lexerKindProc do
    TranspileProcedureDeclaration(AContext, ALexer);
    Token := LexerCurrent(ALexer);
    WriteLn()
  end
END TranspileProcedurePart;

proc Transpile(ALexer: PLexer);
var
  Token: LexerToken;
  WrittenBytes: CARDINAL;
  Context: TranspilerContext;
begin
  TranspileModule(ADR(Context), ALexer)
END Transpile;

END Transpiler.