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 = POINTER TO TranspilerContext;
  TranspilerContext = RECORD
    Indentation: CARDINAL
  END;

(* Calls LexerLex() but skips the comments. *)
PROCEDURE 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. *)
PROCEDURE WriteSemicolon();
BEGIN
  WriteString(';');
  WriteLn()
END WriteSemicolon;

PROCEDURE 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;

PROCEDURE 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;

PROCEDURE 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;

PROCEDURE TranspileConstantPart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
  Token: LexerToken;
BEGIN
  Token := LexerCurrent(ALexer);

  IF Token.Kind = lexerKindConst THEN
    WriteString('CONST');
    WriteLn();
    Token := TranspilerLex(ALexer);

    WHILE Token.Kind = lexerKindIdentifier DO
      TranspileConstant(AContext, ALexer);
      Token := TranspilerLex(ALexer)
    END;
    WriteLn()
  END
END TranspileConstantPart;

PROCEDURE TranspileModule(AContext: PTranspilerContext; ALexer: PLexer);
VAR
  Token: LexerToken;
  WrittenBytes: CARDINAL;
BEGIN
  Token := TranspilerLex(ALexer);

  IF Token.Kind = lexerKindDefinition THEN
    WriteString('DEFINITION ');
    Token := TranspilerLex(ALexer);
  ELSIF 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);
  TranspileConstantPart(AContext, ALexer);
  TranspileTypePart(AContext, ALexer);
  TranspileVariablePart(AContext, ALexer);
  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;

PROCEDURE 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);
      WriteSemicolon()
    ELSE
      WriteLn()
    END
  END
END TranspileTypeFields;

PROCEDURE TranspileRecordType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
  Token: LexerToken;
BEGIN
  WriteString('RECORD');
  WriteLn();
  TranspileTypeFields(AContext, ALexer);
  WriteString('  END')
END TranspileRecordType;

PROCEDURE 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;

PROCEDURE 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;

PROCEDURE 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;

PROCEDURE TranspileUnionType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
  Token: LexerToken;
END TranspileUnionType;

PROCEDURE 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;

PROCEDURE TranspileTypeExpression(AContext: PTranspilerContext; ALexer: PLexer);
VAR
  Token: LexerToken;
  WrittenBytes: CARDINAL;
BEGIN
  Token := TranspilerLex(ALexer);
  IF Token.Kind = lexerKindRecord THEN
    TranspileRecordType(AContext, ALexer)
  ELSIF Token.Kind = lexerKindLeftParen THEN
    TranspileEnumerationType(AContext, ALexer)
  ELSIF Token.Kind = lexerKindArray THEN
    TranspileArrayType(AContext, ALexer)
  ELSIF (Token.Kind = lexerKindPointer) OR (Token.Kind = lexerKindHat) THEN
    TranspilePointerType(AContext, ALexer)
  ELSIF Token.Kind = lexerKindProc THEN
    TranspileProcedureType(AContext, ALexer)
  ELSE
    WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start)
  END
END TranspileTypeExpression;

PROCEDURE 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;

PROCEDURE 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;

PROCEDURE 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;

PROCEDURE TranspileVariablePart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
  Token: LexerToken;
BEGIN
  Token := LexerCurrent(ALexer);

  IF Token.Kind = lexerKindVar THEN
    WriteString('VAR');
    WriteLn();
    Token := TranspilerLex(ALexer);

    WHILE Token.Kind = lexerKindIdentifier DO
      TranspileVariableDeclaration(AContext, ALexer);
      Token := TranspilerLex(ALexer)
    END;
    WriteLn()
  END
END TranspileVariablePart;

PROCEDURE TranspileProcedureDeclaration(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(': ');

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

    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 TranspileProcedureDeclaration;

PROCEDURE TranspileProcedurePart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
  Token: LexerToken;
BEGIN
  Token := LexerCurrent(ALexer);

  IF Token.Kind = lexerKindProc THEN
    TranspileProcedureDeclaration(AContext, ALexer)
  END
END TranspileProcedurePart;

PROCEDURE Transpile(ALexer: PLexer);
VAR
  Token: LexerToken;
  WrittenBytes: CARDINAL;
  Context: TranspilerContext;
BEGIN
  TranspileModule(ADR(Context), ALexer)
END Transpile;

END Transpiler.