belka/elna
1
0
Fork 0
Code Issues 41 Pull Requests Releases Activity

Add A command line parsing procedure

Browse Source
This commit is contained in:
Eugen Wissner
2025-05-31 11:27:23 +02:00
parent a93d12eb50
commit 72e545225b
11 changed files with 386 additions and 245 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
source/CommandLine.def Normal file
View File

@@ -0,0 +1,3 @@
DEFINITION MODULE CommandLine;
END CommandLine.

3
source/CommandLine.mod Normal file
View File

@@ -0,0 +1,3 @@
MODULE CommandLine;
END CommandLine.

15
source/CommandLineInterface.def Normal file
View File

@@ -0,0 +1,15 @@
DEFINITION MODULE CommandLineInterface;
FROM Common IMPORT ShortString;
TYPE
CommandLine = RECORD
input: ShortString;
lex: BOOLEAN;
parse: BOOLEAN
END;
PCommandLine = POINTER TO CommandLine;
PROCEDURE parse_command_line(): PCommandLine;
END CommandLineInterface.

74
source/CommandLineInterface.mod Normal file
View File

@@ -0,0 +1,74 @@
IMPLEMENTATION MODULE CommandLineInterface;
FROM SYSTEM IMPORT ADR, TSIZE;
FROM Args IMPORT GetArg, Narg;
FROM FIO IMPORT WriteString, WriteChar, WriteLine, StdErr;
FROM Storage IMPORT ALLOCATE;
FROM Strings IMPORT CompareStr, Length;
FROM MemUtils IMPORT MemZero;
FROM Common IMPORT ShortString;
PROCEDURE parse_command_line(): PCommandLine;
VAR
parameter: ShortString;
i: CARDINAL;
result: PCommandLine;
parsed: BOOLEAN;
BEGIN
i := 1;
ALLOCATE(result, TSIZE(CommandLine));
result^.lex := FALSE;
result^.parse := FALSE;
MemZero(ADR(result^.input), 256);
WHILE (i < Narg()) AND (result <> NIL) DO
parsed := GetArg(parameter, i);
parsed := FALSE;
IF CompareStr(parameter, '--lex') = 0 THEN
parsed := TRUE;
result^.lex := TRUE
END;
IF CompareStr(parameter, '--parse') = 0 THEN
parsed := TRUE;
result^.parse := TRUE
END;
IF parameter[0] <> '-' THEN
parsed := TRUE;
IF Length(result^.input) > 0 THEN
WriteString(StdErr, 'Fatal error: only one source file can be compiled at once. First given "');
WriteString(StdErr, result^.input);
WriteString(StdErr, '", then "');
WriteString(StdErr, parameter);
WriteString(StdErr, '".');
WriteLine(StdErr);
result := NIL
END;
IF result <> NIL THEN
result^.input := parameter
END
END;
IF parsed = FALSE THEN
WriteString(StdErr, 'Fatal error: unknown command line options: ');
WriteString(StdErr, parameter);
WriteChar(StdErr, '.');
WriteLine(StdErr);
result := NIL
END;
i := i + 1
END;
IF (result <> NIL) AND (Length(result^.input) = 0) THEN
WriteString(StdErr, 'Fatal error: no input files.');
WriteLine(StdErr);
result := NIL
END;
RETURN result
END parse_command_line;
END CommandLineInterface.

6
source/Common.def Normal file
View File

@@ -0,0 +1,6 @@
DEFINITION MODULE Common;
TYPE
ShortString = ARRAY[0..255] OF CHAR;
END Common.

3
source/Common.mod Normal file
View File

@@ -0,0 +1,3 @@
IMPLEMENTATION MODULE Common;
END Common.

42
source/Compiler.mod
View File

@@ -1,18 +1,50 @@
MODULE Compiler; MODULE Compiler;
FROM FIO IMPORT StdIn; FROM FIO IMPORT Close, IsNoError, File, OpenToRead, StdErr, WriteLine, WriteString;
FROM SYSTEM IMPORT ADR; FROM SYSTEM IMPORT ADR;
FROM M2RTS IMPORT HALT, ExitOnHalt;
FROM Lexer IMPORT Lexer, lexer_destroy, lexer_initialize; FROM Lexer IMPORT Lexer, lexer_destroy, lexer_initialize;
FROM Transpiler IMPORT transpile; FROM Transpiler IMPORT transpile;
FROM CommandLineInterface IMPORT PCommandLine, parse_command_line;
VAR
command_line: PCommandLine;
PROCEDURE compile_from_stream();
VAR VAR
lexer: Lexer; lexer: Lexer;
source_input: File;
BEGIN BEGIN
lexer_initialize(ADR(lexer), StdIn); source_input := OpenToRead(command_line^.input);
transpile(ADR(lexer)); IF IsNoError(source_input) = FALSE THEN
WriteString(StdErr, 'Fatal error: failed to read the input file "');
WriteString(StdErr, command_line^.input);
WriteString(StdErr, '".');
WriteLine(StdErr);
lexer_destroy(ADR(lexer)) ExitOnHalt(2)
END;
IF IsNoError(source_input) THEN
lexer_initialize(ADR(lexer), source_input);
transpile(ADR(lexer));
lexer_destroy(ADR(lexer));
Close(source_input)
END
END compile_from_stream;
BEGIN
ExitOnHalt(0);
command_line := parse_command_line();
IF command_line <> NIL THEN
compile_from_stream()
END;
IF command_line = NIL THEN
ExitOnHalt(1)
END;
HALT()
END Compiler. END Compiler.

3
source/Parser.def Normal file
View File

@@ -0,0 +1,3 @@
DEFINITION MODULE Parser;
END Parser.

3
source/Parser.mod Normal file
View File

@@ -0,0 +1,3 @@
MODULE Parser;
END Parser.

12
source/Transpiler.def
View File

@@ -1,6 +1,16 @@
DEFINITION MODULE Transpiler; DEFINITION MODULE Transpiler;
FROM Lexer IMPORT PLexer; FROM FIO IMPORT File;
FROM Lexer IMPORT PLexer, Lexer;
TYPE
TranspilerContext = RECORD
indentation: CARDINAL;
output: File;
lexer: PLexer
END;
PTranspilerContext = POINTER TO TranspilerContext;
PROCEDURE transpile(ALexer: PLexer); PROCEDURE transpile(ALexer: PLexer);

467
source/Transpiler.mod
View File

@@ -1,17 +1,11 @@
IMPLEMENTATION MODULE Transpiler; IMPLEMENTATION MODULE Transpiler;
FROM FIO IMPORT WriteNBytes, StdOut; FROM FIO IMPORT WriteNBytes, StdOut, WriteLine, WriteChar;
FROM SYSTEM IMPORT ADR, ADDRESS; FROM SYSTEM IMPORT ADR, ADDRESS;
FROM Terminal IMPORT Write, WriteLn, WriteString; FROM Terminal IMPORT Write, WriteLn, WriteString;
FROM Lexer IMPORT Lexer, LexerToken, lexer_current, lexer_lex, LexerKind; FROM Lexer IMPORT Lexer, LexerToken, lexer_current, lexer_lex, LexerKind;
TYPE
PTranspilerContext = POINTER TO TranspilerContext;
TranspilerContext = RECORD
Indentation: CARDINAL
END;
(* Calls lexer_lex() but skips the comments. *) (* Calls lexer_lex() but skips the comments. *)
PROCEDURE transpiler_lex(lexer: PLexer): LexerToken; PROCEDURE transpiler_lex(lexer: PLexer): LexerToken;
VAR VAR
@@ -26,394 +20,383 @@ BEGIN
RETURN result RETURN result
END transpiler_lex; END transpiler_lex;
(* Write a semicolon followed by a newline. *) (* Write a semicolon followed by a newline. *)
PROCEDURE write_semicolon(); PROCEDURE write_semicolon(output: File);
BEGIN BEGIN
WriteString(';'); WriteChar(output, ';');
WriteLn() WriteLine(output)
END write_semicolon; END write_semicolon;
PROCEDURE transpile_import(context: PTranspilerContext; lexer: PLexer); PROCEDURE write_current(lexer: PLexer);
VAR VAR
token: LexerToken;
written_bytes: CARDINAL; written_bytes: CARDINAL;
BEGIN BEGIN
WriteString('FROM '); written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start)
token := transpiler_lex(lexer); END write_current;
PROCEDURE transpile_import(context: PTranspilerContext);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start);
token := transpiler_lex(lexer);
WriteString(' IMPORT ');
token := transpiler_lex(lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start);
token := transpiler_lex(lexer);
WHILE token.kind <> lexerKindSemicolon DO
WriteString(', ');
token := transpiler_lex(lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start);
token := transpiler_lex(lexer)
END;
write_semicolon();
token := transpiler_lex(lexer)
END transpile_import;
PROCEDURE transpile_import_part(context: PTranspilerContext; lexer: PLexer);
VAR VAR
token: LexerToken; token: LexerToken;
BEGIN BEGIN
token := lexer_current(lexer); WriteString('FROM ');
token := transpiler_lex(context^.lexer);
write_current(context^.lexer);
token := transpiler_lex(context^.lexer);
WriteString(' IMPORT ');
token := transpiler_lex(context^.lexer);
write_current(context^.lexer);
token := transpiler_lex(context^.lexer);
WHILE token.kind <> lexerKindSemicolon DO
WriteString(', ');
token := transpiler_lex(context^.lexer);
write_current(context^.lexer);
token := transpiler_lex(context^.lexer)
END;
write_semicolon(context^.output);
token := transpiler_lex(context^.lexer)
END transpile_import;
PROCEDURE transpile_import_part(context: PTranspilerContext);
VAR
token: LexerToken;
BEGIN
token := lexer_current(context^.lexer);
WHILE token.kind = lexerKindFrom DO WHILE token.kind = lexerKindFrom DO
transpile_import(context, lexer); transpile_import(context);
token := lexer_current(lexer) token := lexer_current(context^.lexer)
END; END;
WriteLn() WriteLn()
END transpile_import_part; END transpile_import_part;
PROCEDURE transpile_constant(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_constant(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString(' '); WriteString(' ');
token := lexer_current(lexer); token := lexer_current(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WriteString(' = '); WriteString(' = ');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
write_semicolon() write_semicolon(context^.output)
END transpile_constant; END transpile_constant;
PROCEDURE transpile_constant_part(context: PTranspilerContext; lexer: PLexer): BOOLEAN; PROCEDURE transpile_constant_part(context: PTranspilerContext): BOOLEAN;
VAR VAR
token: LexerToken; token: LexerToken;
result: BOOLEAN; result: BOOLEAN;
BEGIN BEGIN
token := lexer_current(lexer); token := lexer_current(context^.lexer);
result := token.kind = lexerKindConst; result := token.kind = lexerKindConst;
IF result THEN IF result THEN
WriteString('CONST'); WriteString('CONST');
WriteLn(); WriteLn();
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind = lexerKindIdentifier DO WHILE token.kind = lexerKindIdentifier DO
transpile_constant(context, lexer); transpile_constant(context);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END END
END; END;
RETURN result RETURN result
END transpile_constant_part; END transpile_constant_part;
PROCEDURE transpile_module(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_module(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
IF token.kind = lexerKindDefinition THEN IF token.kind = lexerKindDefinition THEN
WriteString('DEFINITION '); WriteString('DEFINITION ');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
IF token.kind = lexerKindImplementation THEN IF token.kind = lexerKindImplementation THEN
WriteString('IMPLEMENTATION '); WriteString('IMPLEMENTATION ');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
WriteString('MODULE '); WriteString('MODULE ');
(* Write the module name and end the line with a semicolon and newline. *) (* Write the module name and end the line with a semicolon and newline. *)
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
write_semicolon(); write_semicolon(context^.output);
WriteLn(); WriteLn();
(* Write the module body. *) (* Write the module body. *)
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
transpile_import_part(context, lexer); transpile_import_part(context);
IF transpile_constant_part(context, lexer) THEN IF transpile_constant_part(context) THEN
WriteLn() WriteLn()
END; END;
transpile_type_part(context, lexer); transpile_type_part(context);
IF transpile_variable_part(context, lexer) THEN IF transpile_variable_part(context) THEN
WriteLn() WriteLn()
END; END;
transpile_procedure_part(context, lexer); transpile_procedure_part(context);
transpile_statement_part(context, lexer); transpile_statement_part(context);
WriteString('END '); WriteString('END ');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
Write('.'); Write('.');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WriteLn() WriteLn()
END transpile_module; END transpile_module;
PROCEDURE transpile_type_fields(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_type_fields(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind <> lexerKindEnd DO WHILE token.kind <> lexerKindEnd DO
WriteString(' '); WriteString(' ');
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WriteString(': '); WriteString(': ');
transpile_type_expression(context, lexer); transpile_type_expression(context);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
IF token.kind = lexerKindSemicolon THEN IF token.kind = lexerKindSemicolon THEN
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
Write(';') Write(';')
END; END;
WriteLn() WriteLn()
END END
END transpile_type_fields; END transpile_type_fields;
PROCEDURE transpile_record_type(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_record_type(context: PTranspilerContext);
VAR
token: LexerToken;
BEGIN BEGIN
WriteString('RECORD'); WriteString('RECORD');
WriteLn(); WriteLn();
transpile_type_fields(context, lexer); transpile_type_fields(context);
WriteString(' END') WriteString(' END')
END transpile_record_type; END transpile_record_type;
PROCEDURE transpile_pointer_type(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_pointer_type(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
token := lexer_current(lexer); token := lexer_current(context^.lexer);
WriteString('POINTER TO '); WriteString('POINTER TO ');
IF token.kind = lexerKindPointer THEN IF token.kind = lexerKindPointer THEN
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
transpile_type_expression(context, lexer) transpile_type_expression(context)
END transpile_pointer_type; END transpile_pointer_type;
PROCEDURE transpile_array_type(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_array_type(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString('ARRAY'); WriteString('ARRAY');
token := lexer_current(lexer); token := lexer_current(context^.lexer);
IF token.kind = lexerKindArray THEN IF token.kind = lexerKindArray THEN
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
IF token.kind <> lexerKindOf THEN IF token.kind <> lexerKindOf THEN
WriteString('[1..'); WriteString('[1..');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
Write(']') Write(']')
END; END;
WriteString(' OF '); WriteString(' OF ');
transpile_type_expression(context, lexer) transpile_type_expression(context)
END transpile_array_type; END transpile_array_type;
PROCEDURE transpile_enumeration_type(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_enumeration_type(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString('('); WriteString('(');
WriteLn(); WriteLn();
WriteString(' '); WriteString(' ');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind = lexerKindComma DO WHILE token.kind = lexerKindComma DO
Write(','); Write(',');
WriteLn(); WriteLn();
WriteString(' '); WriteString(' ');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
WriteLn(); WriteLn();
WriteString(' )') WriteString(' )')
END transpile_enumeration_type; END transpile_enumeration_type;
PROCEDURE transpile_union_type(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_union_type(context: PTranspilerContext);
VAR
token: LexerToken;
END transpile_union_type; END transpile_union_type;
PROCEDURE transpile_procedure_type(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_procedure_type(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WriteString('PROCEDURE('); WriteString('PROCEDURE(');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind <> lexerKindRightParen DO WHILE token.kind <> lexerKindRightParen DO
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
IF token.kind = lexerKindComma THEN IF token.kind = lexerKindComma THEN
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WriteString(', ') WriteString(', ')
END END
END; END;
Write(')') Write(')')
END transpile_procedure_type; END transpile_procedure_type;
PROCEDURE transpile_type_expression(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_type_expression(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
IF token.kind = lexerKindRecord THEN IF token.kind = lexerKindRecord THEN
transpile_record_type(context, lexer) transpile_record_type(context)
END; END;
IF token.kind = lexerKindLeftParen THEN IF token.kind = lexerKindLeftParen THEN
transpile_enumeration_type(context, lexer) transpile_enumeration_type(context)
END; END;
IF (token.kind = lexerKindArray) OR (token.kind = lexerKindLeftSquare) THEN IF (token.kind = lexerKindArray) OR (token.kind = lexerKindLeftSquare) THEN
transpile_array_type(context, lexer) transpile_array_type(context)
END; END;
IF token.kind = lexerKindHat THEN IF token.kind = lexerKindHat THEN
transpile_pointer_type(context, lexer) transpile_pointer_type(context)
END; END;
IF token.kind = lexerKindProc THEN IF token.kind = lexerKindProc THEN
transpile_procedure_type(context, lexer) transpile_procedure_type(context)
END; END;
IF token.kind = lexerKindIdentifier THEN IF token.kind = lexerKindIdentifier THEN
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start) write_current(context^.lexer)
END END
END transpile_type_expression; END transpile_type_expression;
PROCEDURE transpile_type_declaration(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_type_declaration(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString(' '); WriteString(' ');
token := lexer_current(lexer); token := lexer_current(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WriteString(' = '); WriteString(' = ');
transpile_type_expression(context, lexer); transpile_type_expression(context);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
write_semicolon(); write_semicolon(context^.output);
END transpile_type_declaration; END transpile_type_declaration;
PROCEDURE transpile_type_part(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_type_part(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
BEGIN BEGIN
token := lexer_current(lexer); token := lexer_current(context^.lexer);
IF token.kind = lexerKindType THEN IF token.kind = lexerKindType THEN
WriteString('TYPE'); WriteString('TYPE');
WriteLn(); WriteLn();
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind = lexerKindIdentifier DO WHILE token.kind = lexerKindIdentifier DO
transpile_type_declaration(context, lexer); transpile_type_declaration(context);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
WriteLn() WriteLn()
END END
END transpile_type_part; END transpile_type_part;
PROCEDURE transpile_variable_declaration(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_variable_declaration(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString(' '); WriteString(' ');
token := lexer_current(lexer); token := lexer_current(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WriteString(': '); WriteString(': ');
transpile_type_expression(context, lexer); transpile_type_expression(context);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
write_semicolon() write_semicolon(context^.output)
END transpile_variable_declaration; END transpile_variable_declaration;
PROCEDURE transpile_variable_part(context: PTranspilerContext; lexer: PLexer): BOOLEAN; PROCEDURE transpile_variable_part(context: PTranspilerContext): BOOLEAN;
VAR VAR
token: LexerToken; token: LexerToken;
result: BOOLEAN; result: BOOLEAN;
BEGIN BEGIN
token := lexer_current(lexer); token := lexer_current(context^.lexer);
result := token.kind = lexerKindVar; result := token.kind = lexerKindVar;
IF result THEN IF result THEN
WriteString('VAR'); WriteString('VAR');
WriteLn(); WriteLn();
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind = lexerKindIdentifier DO WHILE token.kind = lexerKindIdentifier DO
transpile_variable_declaration(context, lexer); transpile_variable_declaration(context);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END END
END; END;
RETURN result RETURN result
END transpile_variable_part; END transpile_variable_part;
PROCEDURE transpile_procedure_heading(context: PTranspilerContext; lexer: PLexer): LexerToken; PROCEDURE transpile_procedure_heading(context: PTranspilerContext): LexerToken;
VAR VAR
token: LexerToken; token: LexerToken;
result: LexerToken; result: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString('PROCEDURE '); WriteString('PROCEDURE ');
result := transpiler_lex(lexer); result := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
Write('('); Write('(');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind <> lexerKindRightParen DO WHILE token.kind <> lexerKindRightParen DO
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WriteString(': '); WriteString(': ');
transpile_type_expression(context, lexer); transpile_type_expression(context);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
IF (token.kind = lexerKindSemicolon) OR (token.kind = lexerKindComma) THEN IF (token.kind = lexerKindSemicolon) OR (token.kind = lexerKindComma) THEN
WriteString('; '); WriteString('; ');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END END
END; END;
WriteString(')'); WriteString(')');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
(* Check for the return type and write it. *) (* Check for the return type and write it. *)
IF token.kind = lexerKindArrow THEN IF token.kind = lexerKindArrow THEN
WriteString(': '); WriteString(': ');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
write_semicolon(); write_semicolon(context^.output);
RETURN result RETURN result
END transpile_procedure_heading; END transpile_procedure_heading;
PROCEDURE transpile_expression(context: PTranspilerContext; lexer: PLexer; trailing_token: LexerKind); PROCEDURE transpile_expression(context: PTranspilerContext; trailing_token: LexerKind);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL; written_bytes: CARDINAL;
BEGIN BEGIN
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE (token.kind <> trailing_token) AND (token.kind <> lexerKindEnd) DO WHILE (token.kind <> trailing_token) AND (token.kind <> lexerKindEnd) DO
written_bytes := 0; written_bytes := 0;
@@ -421,6 +404,14 @@ BEGIN
WriteString('NIL '); WriteString('NIL ');
written_bytes := 1 written_bytes := 1
END; END;
IF (token.kind = lexerKindBoolean) AND token.booleanKind THEN
WriteString('TRUE ');
written_bytes := 1
END;
IF (token.kind = lexerKindBoolean) AND (~token.booleanKind) THEN
WriteString('FALSE ');
written_bytes := 1
END;
IF token.kind = lexerKindOr THEN IF token.kind = lexerKindOr THEN
WriteString('OR '); WriteString('OR ');
written_bytes := 1 written_bytes := 1
@@ -434,149 +425,143 @@ BEGIN
written_bytes := 1 written_bytes := 1
END; END;
IF written_bytes = 0 THEN IF written_bytes = 0 THEN
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
Write(' ') Write(' ')
END; END;
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END END
END transpile_expression; END transpile_expression;
PROCEDURE transpile_if_statement(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_if_statement(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString(' IF '); WriteString(' IF ');
transpile_expression(context, lexer, lexerKindThen); transpile_expression(context, lexerKindThen);
WriteString('THEN'); WriteString('THEN');
WriteLn(); WriteLn();
transpile_statements(context, lexer); transpile_statements(context);
WriteString(' END'); WriteString(' END');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END transpile_if_statement; END transpile_if_statement;
PROCEDURE transpile_while_statement(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_while_statement(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString(' WHILE '); WriteString(' WHILE ');
transpile_expression(context, lexer, lexerKindDo); transpile_expression(context, lexerKindDo);
WriteString('DO'); WriteString('DO');
WriteLn(); WriteLn();
transpile_statements(context, lexer); transpile_statements(context);
WriteString(' END'); WriteString(' END');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END transpile_while_statement; END transpile_while_statement;
PROCEDURE transpile_assignment_statement(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_assignment_statement(context: PTranspilerContext);
BEGIN BEGIN
WriteString(' := '); WriteString(' := ');
transpile_expression(context, lexer, lexerKindSemicolon); transpile_expression(context, lexerKindSemicolon);
END transpile_assignment_statement; END transpile_assignment_statement;
PROCEDURE transpile_call_statement(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_call_statement(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString('('); WriteString('(');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE (token.kind <> lexerKindSemicolon) AND (token.kind <> lexerKindEnd) DO WHILE (token.kind <> lexerKindSemicolon) AND (token.kind <> lexerKindEnd) DO
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END END
END transpile_call_statement; END transpile_call_statement;
PROCEDURE transpile_designator_expression(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_designator_expression(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString(' '); WriteString(' ');
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind = lexerKindLeftSquare DO WHILE token.kind = lexerKindLeftSquare DO
Write('['); Write('[');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind <> lexerKindRightSquare DO WHILE token.kind <> lexerKindRightSquare DO
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
Write(']'); Write(']');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
IF token.kind = lexerKindHat THEN IF token.kind = lexerKindHat THEN
Write('^'); Write('^');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
IF token.kind = lexerKindDot THEN IF token.kind = lexerKindDot THEN
Write('.'); Write('.');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
IF token.kind = lexerKindHat THEN IF token.kind = lexerKindHat THEN
Write('^'); Write('^');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
WHILE token.kind = lexerKindLeftSquare DO WHILE token.kind = lexerKindLeftSquare DO
Write('['); Write('[');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
WHILE token.kind <> lexerKindRightSquare DO WHILE token.kind <> lexerKindRightSquare DO
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END; END;
Write(']'); Write(']');
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END END
END transpile_designator_expression; END transpile_designator_expression;
PROCEDURE transpile_return_statement(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_return_statement(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
WriteString(' RETURN '); WriteString(' RETURN ');
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
written_bytes := WriteNBytes(StdOut, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start); write_current(context^.lexer);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END transpile_return_statement; END transpile_return_statement;
PROCEDURE transpile_statement(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_statement(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
written_bytes: CARDINAL;
BEGIN BEGIN
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
IF token.kind = lexerKindIf THEN IF token.kind = lexerKindIf THEN
transpile_if_statement(context, lexer) transpile_if_statement(context)
END; END;
IF token.kind = lexerKindWhile THEN IF token.kind = lexerKindWhile THEN
transpile_while_statement(context, lexer) transpile_while_statement(context)
END; END;
IF token.kind = lexerKindReturn THEN IF token.kind = lexerKindReturn THEN
transpile_return_statement(context, lexer) transpile_return_statement(context)
END; END;
IF token.kind = lexerKindIdentifier THEN IF token.kind = lexerKindIdentifier THEN
transpile_designator_expression(context, lexer); transpile_designator_expression(context);
token := lexer_current(lexer); token := lexer_current(context^.lexer);
IF token.kind = lexerKindAssignment THEN IF token.kind = lexerKindAssignment THEN
transpile_assignment_statement(context, lexer) transpile_assignment_statement(context)
END; END;
IF token.kind = lexerKindLeftParen THEN IF token.kind = lexerKindLeftParen THEN
transpile_call_statement(context, lexer) transpile_call_statement(context)
END END
END END
END transpile_statement; END transpile_statement;
PROCEDURE transpile_statements(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_statements(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
BEGIN BEGIN
token := lexer_current(lexer); token := lexer_current(context^.lexer);
WHILE token.kind <> lexerKindEnd DO WHILE token.kind <> lexerKindEnd DO
transpile_statement(context, lexer); transpile_statement(context);
token := lexer_current(lexer); token := lexer_current(context^.lexer);
IF token.kind = lexerKindSemicolon THEN IF token.kind = lexerKindSemicolon THEN
Write(';') Write(';')
@@ -584,44 +569,44 @@ BEGIN
WriteLn() WriteLn()
END END
END transpile_statements; END transpile_statements;
PROCEDURE transpile_statement_part(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_statement_part(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
BEGIN BEGIN
token := lexer_current(lexer); token := lexer_current(context^.lexer);
IF token.kind = lexerKindBegin THEN IF token.kind = lexerKindBegin THEN
WriteString('BEGIN'); WriteString('BEGIN');
WriteLn(); WriteLn();
transpile_statements(context, lexer) transpile_statements(context)
END END
END transpile_statement_part; END transpile_statement_part;
PROCEDURE transpile_procedure_declaration(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_procedure_declaration(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
seen_part: BOOLEAN; seen_part: BOOLEAN;
written_bytes: CARDINAL; written_bytes: CARDINAL;
BEGIN BEGIN
token := transpile_procedure_heading(context, lexer); token := transpile_procedure_heading(context);
seen_part := transpile_constant_part(context, lexer); seen_part := transpile_constant_part(context);
seen_part := transpile_variable_part(context, lexer); seen_part := transpile_variable_part(context);
transpile_statement_part(context, lexer); transpile_statement_part(context);
WriteString('END '); WriteString('END ');
written_bytes := WriteNBytes(StdOut, ORD(token.identifierKind[1]), ADR(token.identifierKind[2])); written_bytes := WriteNBytes(StdOut, ORD(token.identifierKind[1]), ADR(token.identifierKind[2]));
token := transpiler_lex(lexer); token := transpiler_lex(context^.lexer);
write_semicolon(); write_semicolon(context^.output);
token := transpiler_lex(lexer) token := transpiler_lex(context^.lexer)
END transpile_procedure_declaration; END transpile_procedure_declaration;
PROCEDURE transpile_procedure_part(context: PTranspilerContext; lexer: PLexer); PROCEDURE transpile_procedure_part(context: PTranspilerContext);
VAR VAR
token: LexerToken; token: LexerToken;
BEGIN BEGIN
token := lexer_current(lexer); token := lexer_current(context^.lexer);
WHILE token.kind = lexerKindProc DO WHILE token.kind = lexerKindProc DO
transpile_procedure_declaration(context, lexer); transpile_procedure_declaration(context);
token := lexer_current(lexer); token := lexer_current(context^.lexer);
WriteLn() WriteLn()
END END
END transpile_procedure_part; END transpile_procedure_part;
@@ -631,6 +616,10 @@ VAR
written_bytes: CARDINAL; written_bytes: CARDINAL;
context: TranspilerContext; context: TranspilerContext;
BEGIN BEGIN
transpile_module(ADR(context), lexer) context.indentation := 0;
context.output := StdOut;
context.lexer := lexer;
transpile_module(ADR(context))
END transpile; END transpile;
END Transpiler. END Transpiler.