Transpile procedures and statements

This commit is contained in:
2025-05-29 00:24:52 +02:00
parent 24651e7c48
commit 192e7e40c8
3 changed files with 521 additions and 250 deletions

View File

@ -13,31 +13,31 @@ type
end;
(* Calls LexerLex() but skips the comments. *)
PROCEDURE TranspilerLex(ALexer: PLexer): LexerToken;
VAR
proc TranspilerLex(ALexer: PLexer): LexerToken;
var
Result: LexerToken;
BEGIN
begin
Result := LexerLex(ALexer);
WHILE Result.Kind = lexerKindComment DO
while Result.Kind = lexerKindComment do
Result := LexerLex(ALexer)
END;
end;
RETURN Result
return Result
END TranspilerLex;
(* Write a semicolon followed by a newline. *)
PROCEDURE WriteSemicolon();
BEGIN
proc WriteSemicolon();
begin
WriteString(';');
WriteLn()
END WriteSemicolon;
PROCEDURE TranspileImport(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileImport(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString('FROM ');
Token := TranspilerLex(ALexer);
@ -50,34 +50,34 @@ BEGIN
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
WHILE Token.Kind <> lexerKindSemicolon DO
while Token.Kind <> lexerKindSemicolon do
WriteString(', ');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
END;
end;
WriteSemicolon();
Token := TranspilerLex(ALexer)
END TranspileImport;
PROCEDURE TranspileImportPart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileImportPart(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
BEGIN
begin
Token := LexerCurrent(ALexer);
WHILE Token.Kind = lexerKindFrom DO
while Token.Kind = lexerKindFrom do
TranspileImport(AContext, ALexer);
Token := LexerCurrent(ALexer)
END;
end;
WriteLn()
END TranspileImportPart;
PROCEDURE TranspileConstant(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileConstant(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString(' ');
Token := LexerCurrent(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
@ -92,39 +92,42 @@ BEGIN
WriteSemicolon()
END TranspileConstant;
PROCEDURE TranspileConstantPart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileConstantPart(AContext: PTranspilerContext; ALexer: PLexer): BOOLEAN;
var
Token: LexerToken;
BEGIN
Result: BOOLEAN;
begin
Token := LexerCurrent(ALexer);
Result := Token.Kind = lexerKindConst;
IF Token.Kind = lexerKindConst THEN
if Result then
WriteString('CONST');
WriteLn();
Token := TranspilerLex(ALexer);
WHILE Token.Kind = lexerKindIdentifier DO
while Token.Kind = lexerKindIdentifier do
TranspileConstant(AContext, ALexer);
Token := TranspilerLex(ALexer)
END;
WriteLn()
END
end
end;
return Result
END TranspileConstantPart;
PROCEDURE TranspileModule(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileModule(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindDefinition THEN
if Token.Kind = lexerKindDefinition then
WriteString('DEFINITION ');
Token := TranspilerLex(ALexer);
ELSIF Token.Kind = lexerKindImplementation THEN
Token := TranspilerLex(ALexer)
end;
if Token.Kind = lexerKindImplementation then
WriteString('IMPLEMENTATION ');
Token := TranspilerLex(ALexer)
END;
end;
WriteString('MODULE ');
(* Write the module name and end the line with a semicolon and newline. *)
@ -138,28 +141,32 @@ BEGIN
(* Write the module body. *)
Token := TranspilerLex(ALexer);
TranspileImportPart(AContext, ALexer);
TranspileConstantPart(AContext, ALexer);
if TranspileConstantPart(AContext, ALexer) then
WriteLn()
end;
TranspileTypePart(AContext, ALexer);
TranspileVariablePart(AContext, ALexer);
if TranspileVariablePart(AContext, ALexer) then
WriteLn()
end;
TranspileProcedurePart(AContext, ALexer);
Token := LexerCurrent(ALexer);
WHILE Token.Kind <> lexerKindEof DO
while Token.Kind <> lexerKindEof do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
WriteLn();
Token := TranspilerLex(ALexer)
END
end
END TranspileModule;
PROCEDURE TranspileTypeFields(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileTypeFields(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := TranspilerLex(ALexer);
WHILE Token.Kind <> lexerKindEnd DO
while Token.Kind <> lexerKindEnd do
WriteString(' ');
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
@ -167,47 +174,46 @@ BEGIN
TranspileTypeExpression(AContext, ALexer);
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindSemicolon THEN
if Token.Kind = lexerKindSemicolon then
Token := TranspilerLex(ALexer);
WriteSemicolon()
ELSE
WriteLn()
END
END
Write(';')
end;
WriteLn()
end
END TranspileTypeFields;
PROCEDURE TranspileRecordType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileRecordType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
BEGIN
begin
WriteString('RECORD');
WriteLn();
TranspileTypeFields(AContext, ALexer);
WriteString(' END')
END TranspileRecordType;
PROCEDURE TranspilePointerType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspilePointerType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := LexerCurrent(ALexer);
WriteString('POINTER TO ');
IF Token.Kind = lexerKindPointer THEN
if Token.Kind = lexerKindPointer then
Token := TranspilerLex(ALexer)
END;
end;
TranspileTypeExpression(AContext, ALexer)
END TranspilePointerType;
PROCEDURE TranspileArrayType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileArrayType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString('ARRAY');
Token := TranspilerLex(ALexer);
IF Token.Kind <> lexerKindOf THEN
if Token.Kind <> lexerKindOf then
Write('[');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
@ -218,16 +224,16 @@ BEGIN
Token := TranspilerLex(ALexer);
Write(']');
Token := TranspilerLex(ALexer)
END;
end;
WriteString(' OF ');
TranspileTypeExpression(AContext, ALexer)
END TranspileArrayType;
PROCEDURE TranspileEnumerationType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileEnumerationType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString('(');
WriteLn();
WriteString(' ');
@ -237,7 +243,7 @@ BEGIN
Token := TranspilerLex(ALexer);
WHILE Token.Kind = lexerKindComma DO
while Token.Kind = lexerKindComma do
Write(',');
WriteLn();
WriteString(' ');
@ -245,64 +251,69 @@ BEGIN
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
END;
end;
WriteLn();
WriteString(' )')
END TranspileEnumerationType;
PROCEDURE TranspileUnionType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileUnionType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
END TranspileUnionType;
PROCEDURE TranspileProcedureType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileProcedureType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := TranspilerLex(ALexer);
WriteString('PROCEDURE(');
Token := TranspilerLex(ALexer);
WHILE Token.Kind <> lexerKindRightParen DO
while Token.Kind <> lexerKindRightParen do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindComma THEN
if Token.Kind = lexerKindComma then
Token := TranspilerLex(ALexer);
WriteString(', ')
END
END;
end
end;
Write(')')
END TranspileProcedureType;
PROCEDURE TranspileTypeExpression(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileTypeExpression(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindRecord THEN
if Token.Kind = lexerKindRecord then
TranspileRecordType(AContext, ALexer)
ELSIF Token.Kind = lexerKindLeftParen THEN
end;
if Token.Kind = lexerKindLeftParen then
TranspileEnumerationType(AContext, ALexer)
ELSIF Token.Kind = lexerKindArray THEN
end;
if Token.Kind = lexerKindArray then
TranspileArrayType(AContext, ALexer)
ELSIF (Token.Kind = lexerKindPointer) OR (Token.Kind = lexerKindHat) THEN
end;
if (Token.Kind = lexerKindPointer) OR (Token.Kind = lexerKindHat) then
TranspilePointerType(AContext, ALexer)
ELSIF Token.Kind = lexerKindProc THEN
end;
if Token.Kind = lexerKindProc then
TranspileProcedureType(AContext, ALexer)
ELSE
end;
if Token.Kind = lexerKindIdentifier then
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start)
END
end
END TranspileTypeExpression;
PROCEDURE TranspileTypeDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileTypeDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString(' ');
Token := LexerCurrent(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
@ -314,30 +325,30 @@ BEGIN
WriteSemicolon();
END TranspileTypeDeclaration;
PROCEDURE TranspileTypePart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileTypePart(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
BEGIN
begin
Token := LexerCurrent(ALexer);
IF Token.Kind = lexerKindType THEN
if Token.Kind = lexerKindType then
WriteString('TYPE');
WriteLn();
Token := TranspilerLex(ALexer);
WHILE Token.Kind = lexerKindIdentifier DO
while Token.Kind = lexerKindIdentifier do
TranspileTypeDeclaration(AContext, ALexer);
Token := TranspilerLex(ALexer)
END;
end;
WriteLn()
END
end
END TranspileTypePart;
PROCEDURE TranspileVariableDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileVariableDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString(' ');
Token := LexerCurrent(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
@ -349,30 +360,32 @@ BEGIN
WriteSemicolon()
END TranspileVariableDeclaration;
PROCEDURE TranspileVariablePart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileVariablePart(AContext: PTranspilerContext; ALexer: PLexer): BOOLEAN;
var
Token: LexerToken;
BEGIN
Result: BOOLEAN;
begin
Token := LexerCurrent(ALexer);
Result := Token.Kind = lexerKindVar;
IF Token.Kind = lexerKindVar THEN
if Result then
WriteString('VAR');
WriteLn();
Token := TranspilerLex(ALexer);
WHILE Token.Kind = lexerKindIdentifier DO
while Token.Kind = lexerKindIdentifier do
TranspileVariableDeclaration(AContext, ALexer);
Token := TranspilerLex(ALexer)
END;
WriteLn()
END
end
end;
return Result
END TranspileVariablePart;
PROCEDURE TranspileProcedureDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileProcedureHeading(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString('PROCEDURE ');
Token := TranspilerLex(ALexer);
@ -382,52 +395,235 @@ BEGIN
Write('(');
Token := TranspilerLex(ALexer);
WHILE Token.Kind <> lexerKindRightParen DO
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);
TranspileTypeExpression(AContext, ALexer);
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindSemicolon THEN
if Token.Kind = lexerKindSemicolon then
WriteString('; ');
Token := TranspilerLex(ALexer)
END
END;
end
end;
WriteString(')');
Token := TranspilerLex(ALexer);
(* Check for the return type and write it. *)
IF Token.Kind = lexerKindColon THEN
if Token.Kind = lexerKindColon then
WriteString(': ');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
END;
end;
Token := TranspilerLex(ALexer);
WriteSemicolon()
END TranspileProcedureDeclaration;
END TranspileProcedureHeading;
PROCEDURE TranspileProcedurePart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileIfStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
BEGIN
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);
IF Token.Kind = lexerKindProc THEN
TranspileProcedureDeclaration(AContext, ALexer)
END
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;
PROCEDURE Transpile(ALexer: PLexer);
VAR
proc Transpile(ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
Context: TranspilerContext;
BEGIN
begin
TranspileModule(ADR(Context), ALexer)
END Transpile;