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

Use qualified enumerations in the parser and lexer

Browse Source
This commit is contained in:
Eugen Wissner
2025-08-08 23:58:28 +03:00
parent 5d1804fbc2
commit e37f138b5d
10 changed files with 1088 additions and 1141 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@@ -24,7 +24,7 @@ in the `boot/` directory.
## Build ## Build
The frontend requires GCC 14.2.0 (not tested with other versions). The frontend requires GCC 15.1.0 (not tested with other versions).
Download the GCC source. Copy the contents of this repository into `gcc/elna` Download the GCC source. Copy the contents of this repository into `gcc/elna`
inside GCC. Finally build GCC enabling the frontend with inside GCC. Finally build GCC enabling the frontend with

16
source/CommandLineInterface.def
View File

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

27
source/CommandLineInterface.elna
View File

@@ -1,7 +1,8 @@
(* This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. *)
module; module;
from SYSTEM import ADR, TSIZE;
from Args import GetArg, Narg; from Args import GetArg, Narg;
from FIO import WriteString, WriteChar, WriteLine, StdErr; from FIO import WriteString, WriteChar, WriteLine, StdErr;
from Storage import ALLOCATE; from Storage import ALLOCATE;
@@ -10,18 +11,26 @@ from MemUtils import MemZero;
from Common import ShortString; from Common import ShortString;
proc parse_command_line() -> PCommandLine; type
CommandLine = record
input: ShortString;
output: ShortString;
lex: Bool;
parse: Bool
end;
proc parse_command_line*() -> ^CommandLine;
var var
parameter: ShortString; parameter: ShortString;
i: CARDINAL; i: Word;
result: PCommandLine; result: ^CommandLine;
parsed: BOOLEAN; parsed: Bool;
begin begin
i := 1; i := 1u;
NEW(result); NEW(result);
result^.lex := false; result^.lex := false;
result^.parse := false; result^.parse := false;
MemZero(ADR(result^.input), 256); MemZero(@result^.input, 256);
result^.output[1] := CHAR(0); result^.output[1] := CHAR(0);
while (i < Narg()) & (result <> nil) do while (i < Narg()) & (result <> nil) do
@@ -37,7 +46,7 @@ begin
result^.parse := true result^.parse := true
end; end;
if CompareStr(parameter, '-o') = 0 then if CompareStr(parameter, '-o') = 0 then
INC(i); i := i + 1u;
if i = Narg() then if i = Narg() then
WriteString(StdErr, 'Fatal error: expecting a file name following -o.'); WriteString(StdErr, 'Fatal error: expecting a file name following -o.');

4
source/Common.elna
View File

@@ -1,9 +1,11 @@
(* This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. *)
module; module;
type type
ShortString = [256]Char; ShortString = [256]Char;
Identifier = [256]Char; Identifier = [256]Char;
PIdentifier = ^Identifier;
TextLocation* = record TextLocation* = record
line: Word; line: Word;
column: Word column: Word

18
source/Compiler.elna
View File

@@ -1,25 +1,27 @@
(* This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. *)
program; program;
from FIO import Close, IsNoError, File, OpenToRead, OpenToWrite, StdErr, StdOut, WriteLine, WriteString; from FIO import Close, IsNoError, File, OpenToRead, OpenToWrite, StdErr, StdOut, WriteLine, WriteString;
from SYSTEM import ADR;
from M2RTS import HALT, ExitOnHalt; from M2RTS import HALT, ExitOnHalt;
from Lexer import Lexer, lexer_destroy, lexer_initialize; from Lexer import Lexer, lexer_destroy, lexer_initialize;
from Parser import Parser; from Parser import Parser;
from Transpiler import transpile; from Transpiler import transpile;
from CommandLineInterface import PCommandLine, parse_command_line; from CommandLineInterface import CommandLine, parse_command_line;
from Parser import PAstModule, parse; from Parser import AstModule, parse;
from Strings import Length; from Strings import Length;
var var
command_line: PCommandLine; command_line: ^CommandLine;
proc compile_from_stream(); proc compile_from_stream();
var var
lexer: Lexer; lexer: Lexer;
source_input: File; source_input: File;
source_output: File; source_output: File;
ast_module: PAstModule; ast_module: ^AstModule;
begin begin
source_input := OpenToRead(command_line^.input); source_input := OpenToRead(command_line^.input);
@@ -47,12 +49,12 @@ begin
end; end;
if IsNoError(source_input) then if IsNoError(source_input) then
lexer_initialize(ADR(lexer), source_input); lexer_initialize(@lexer, source_input);
ast_module := parse(ADR(lexer)); ast_module := parse(@lexer);
transpile(ast_module, StdOut, source_output, command_line^.input); transpile(ast_module, StdOut, source_output, command_line^.input);
lexer_destroy(ADR(lexer)); lexer_destroy(@lexer);
Close(source_output); Close(source_output);
Close(source_input) Close(source_input)

991
source/Lexer.elna
View File

File diff suppressed because it is too large Load Diff

200
source/Parser.def
View File

@@ -1,200 +0,0 @@
DEFINITION MODULE Parser;
FROM Common IMPORT Identifier, PIdentifier, ShortString;
FROM Lexer IMPORT PLexer;
TYPE
Parser = RECORD
lexer: PLexer
END;
PParser = POINTER TO Parser;
AstLiteralKind = (
astLiteralKindInteger,
astLiteralKindString,
astLiteralKindNull,
astLiteralKindBoolean
);
AstLiteral = RECORD
CASE kind: AstLiteralKind OF
astLiteralKindInteger: integer: INTEGER |
astLiteralKindString: string: ShortString |
astLiteralKindNull: |
astLiteralKindBoolean: boolean: BOOLEAN
END
END;
PAstLiteral = POINTER TO AstLiteral;
AstUnaryOperator = (
astUnaryOperatorReference,
astUnaryOperatorNot,
astUnaryOperatorMinus
);
AstBinaryOperator = (
astBinaryOperatorSum,
astBinaryOperatorSubtraction,
astBinaryOperatorMultiplication,
astBinaryOperatorDivision,
astBinaryOperatorRemainder,
astBinaryOperatorEquals,
astBinaryOperatorNotEquals,
astBinaryOperatorLess,
astBinaryOperatorGreater,
astBinaryOperatorLessEqual,
astBinaryOperatorGreaterEqual,
astBinaryOperatorDisjunction,
astBinaryOperatorConjunction,
astBinaryOperatorExclusiveDisjunction,
astBinaryOperatorShiftLeft,
astBinaryOperatorShiftRight
);
AstExpressionKind = (
astExpressionKindLiteral,
astExpressionKindIdentifier,
astExpressionKindArrayAccess,
astExpressionKindDereference,
astExpressionKindFieldAccess,
astExpressionKindUnary,
astExpressionKindBinary,
astExpressionKindCall
);
AstExpression = RECORD
CASE kind: AstExpressionKind OF
astExpressionKindLiteral: literal: PAstLiteral |
astExpressionKindIdentifier: identifier: Identifier |
astExpressionKindDereference: reference: PAstExpression |
astExpressionKindArrayAccess:
array: PAstExpression;
index: PAstExpression |
astExpressionKindFieldAccess:
aggregate: PAstExpression;
field: Identifier |
astExpressionKindUnary:
unary_operator: AstUnaryOperator;
unary_operand: PAstExpression |
astExpressionKindBinary:
binary_operator: AstBinaryOperator;
lhs: PAstExpression;
rhs: PAstExpression |
astExpressionKindCall:
callable: PAstExpression;
argument_count: CARDINAL;
arguments: PPAstExpression
END
END;
PAstExpression = POINTER TO AstExpression;
PPAstExpression = POINTER TO PAstExpression;
AstStatementKind = (
astStatementKindIf,
astStatementKindWhile,
astStatementKindAssignment,
astStatementKindReturn,
astStatementKindCall
);
AstStatement = RECORD
CASE kind: AstStatementKind OF
astStatementKindIf:
if_condition: PAstExpression;
if_branch: AstCompoundStatement |
astStatementKindWhile:
while_condition: PAstExpression;
while_body: AstCompoundStatement |
astStatementKindAssignment:
assignee: PAstExpression;
assignment: PAstExpression |
astStatementKindReturn: returned: PAstExpression |
astStatementKindCall: call: PAstExpression
END
END;
PAstStatement = POINTER TO AstStatement;
PPAstStatement = POINTER TO PAstStatement;
AstCompoundStatement = RECORD
count: CARDINAL;
statements: PPAstStatement
END;
AstImportStatement = RECORD
package: Identifier;
symbols: PIdentifier
END;
PAstImportStatement = POINTER TO AstImportStatement;
PPAstImportStatement = POINTER TO PAstImportStatement;
AstConstantDeclaration = RECORD
constant_name: Identifier;
constant_value: INTEGER
END;
PAstConstantDeclaration = POINTER TO AstConstantDeclaration;
PPAstConstantDeclaration = POINTER TO PAstConstantDeclaration;
AstFieldDeclaration = RECORD
field_name: Identifier;
field_type: PAstTypeExpression
END;
PAstFieldDeclaration = POINTER TO AstFieldDeclaration;
AstTypeExpressionKind = (
astTypeExpressionKindNamed,
astTypeExpressionKindRecord,
astTypeExpressionKindEnumeration,
astTypeExpressionKindArray,
astTypeExpressionKindPointer,
astTypeExpressionKindProcedure
);
AstTypeExpression = RECORD
CASE kind: AstTypeExpressionKind OF
astTypeExpressionKindNamed: name: Identifier |
astTypeExpressionKindEnumeration: cases: PIdentifier |
astTypeExpressionKindPointer: target: PAstTypeExpression |
astTypeExpressionKindRecord: fields: PAstFieldDeclaration |
astTypeExpressionKindArray:
base: PAstTypeExpression;
length: CARDINAL |
astTypeExpressionKindProcedure: parameters: PPAstTypeExpression
END
END;
PAstTypeExpression = POINTER TO AstTypeExpression;
PPAstTypeExpression = POINTER TO PAstTypeExpression;
AstTypedDeclaration = RECORD
identifier: Identifier;
type_expression: PAstTypeExpression
END;
PAstTypedDeclaration = POINTER TO AstTypedDeclaration;
PPAstTypedDeclaration = POINTER TO PAstTypedDeclaration;
AstVariableDeclaration = RECORD
variable_name: Identifier;
variable_type: PAstTypeExpression
END;
PAstVariableDeclaration = POINTER TO AstVariableDeclaration;
PPAstVariableDeclaration = POINTER TO PAstVariableDeclaration;
AstProcedureDeclaration = RECORD
name: Identifier;
parameter_count: CARDINAL;
parameters: PAstTypedDeclaration;
return_type: PAstTypeExpression;
constants: PPAstConstantDeclaration;
variables: PPAstVariableDeclaration;
statements: AstCompoundStatement
END;
PAstProcedureDeclaration = POINTER TO AstProcedureDeclaration;
PPAstProcedureDeclaration = POINTER TO PAstProcedureDeclaration;
AstModule = RECORD
main: BOOLEAN;
imports: PPAstImportStatement;
constants: PPAstConstantDeclaration;
types: PPAstTypedDeclaration;
variables: PPAstVariableDeclaration;
procedures: PPAstProcedureDeclaration;
statements: AstCompoundStatement
END;
PAstModule = POINTER TO AstModule;
PROCEDURE parse(lexer: PLexer): PAstModule;
END Parser.

640
source/Parser.elna
View File

File diff suppressed because it is too large Load Diff

20
source/Transpiler.def
View File

@@ -1,20 +0,0 @@
DEFINITION MODULE Transpiler;
FROM FIO IMPORT File;
FROM Common IMPORT ShortString;
FROM Lexer IMPORT PLexer, Lexer;
FROM Parser IMPORT PAstModule;
TYPE
TranspilerContext = RECORD
input_name: ShortString;
output: File;
definition: File;
indentation: CARDINAL
END;
PTranspilerContext = POINTER TO TranspilerContext;
PROCEDURE transpile(ast_module: PAstModule; output: File; definition: File; input_name: ShortString);
END Transpiler.

311
source/Transpiler.elna
View File

@@ -1,27 +1,34 @@
(* This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. *)
module; module;
from FIO import WriteNBytes, WriteLine, WriteChar, WriteString; from FIO import File, WriteNBytes, WriteLine, WriteChar, WriteString;
from SYSTEM import ADR, TSIZE;
from NumberIO import IntToStr; from NumberIO import IntToStr;
from Common import Identifier, PIdentifier, ShortString; from Common import Identifier, ShortString;
from Parser import AstTypeExpressionKind, AstExpressionKind, AstLiteralKind, AstUnaryOperator, AstBinaryOperator, from Parser import AstTypeExpressionKind, AstExpressionKind, AstLiteralKind, AstUnaryOperator, AstBinaryOperator,
PAstModule, PPAstExpression, PAstExpression, PAstLiteral, PPAstProcedureDeclaration, AstModule, AstExpression, AstLiteral, AstConstantDeclaration, AstStatement, AstStatementKind,
PAstConstantDeclaration, PPAstConstantDeclaration, PPAstStatement, PAstStatement, AstStatementKind, AstTypedDeclaration, AstCompoundStatement, AstProcedureDeclaration,
AstTypedDeclaration, PAstTypedDeclaration, PPAstTypedDeclaration, AstCompoundStatement, PAstProcedureDeclaration, AstVariableDeclaration, AstImportStatement, AstTypeExpression, AstFieldDeclaration;
PAstVariableDeclaration, PPAstVariableDeclaration, PAstImportStatement, PPAstImportStatement,
PAstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration;
proc indent(context: PTranspilerContext); type
TranspilerContext* = record
input_name: ShortString;
output: File;
definition: File;
indentation: Word
end;
proc indent(context: ^TranspilerContext);
var var
count: CARDINAL; count: Word;
begin begin
count := 0; count := 0;
while count < context^.indentation do while count < context^.indentation do
WriteString(context^.output, ' '); WriteString(context^.output, ' ');
INC(count) count := count + 1u
end end
end; end;
@@ -32,46 +39,46 @@ begin
WriteLine(output) WriteLine(output)
end; end;
proc transpile_import_statement(context: PTranspilerContext, import_statement: PAstImportStatement); proc transpile_import_statement(context: ^TranspilerContext, import_statement: ^AstImportStatement);
var var
written_bytes: CARDINAL; written_bytes: Word;
current_symbol: PIdentifier; current_symbol: ^Identifier;
begin begin
WriteString(context^.output, 'FROM '); WriteString(context^.output, 'FROM ');
written_bytes := WriteNBytes(context^.output, ORD(import_statement^.package[1]), ADR(import_statement^.package[2])); written_bytes := WriteNBytes(context^.output, ORD(import_statement^.package[1]), @import_statement^.package[2]);
WriteString(context^.output, ' IMPORT '); WriteString(context^.output, ' IMPORT ');
current_symbol := import_statement^.symbols; current_symbol := import_statement^.symbols;
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2])); written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), @current_symbol^[2]);
INC(current_symbol, TSIZE(Identifier)); INC(current_symbol, #size(Identifier));
while ORD(current_symbol^[1]) <> 0 do while ORD(current_symbol^[1]) <> 0 do
WriteString(context^.output, ', '); WriteString(context^.output, ', ');
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2])); written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), @current_symbol^[2]);
INC(current_symbol, TSIZE(Identifier)) INC(current_symbol, #size(Identifier))
end; end;
write_semicolon(context^.output) write_semicolon(context^.output)
end; end;
proc transpile_import_part(context: PTranspilerContext, imports: PPAstImportStatement); proc transpile_import_part(context: ^TranspilerContext, imports: ^^AstImportStatement);
var var
import_statement: PAstImportStatement; import_statement: ^AstImportStatement;
begin begin
while imports^ <> nil do while imports^ <> nil do
transpile_import_statement(context, imports^); transpile_import_statement(context, imports^);
INC(imports, TSIZE(PAstImportStatement)) INC(imports, #size(^AstImportStatement))
end; end;
WriteLine(context^.output) WriteLine(context^.output)
end; end;
proc transpile_constant_declaration(context: PTranspilerContext, declaration: PAstConstantDeclaration); proc transpile_constant_declaration(context: ^TranspilerContext, declaration: ^AstConstantDeclaration);
var var
buffer: [20]CHAR; buffer: [20]CHAR;
written_bytes: CARDINAL; written_bytes: Word;
begin begin
WriteString(context^.output, ' '); WriteString(context^.output, ' ');
written_bytes := WriteNBytes(context^.output, ORD(declaration^.constant_name[1]), ADR(declaration^.constant_name[2])); written_bytes := WriteNBytes(context^.output, ORD(declaration^.constant_name[1]), @declaration^.constant_name[2]);
WriteString(context^.output, ' = '); WriteString(context^.output, ' = ');
@@ -81,9 +88,9 @@ begin
write_semicolon(context^.output) write_semicolon(context^.output)
end; end;
proc transpile_constant_part(context: PTranspilerContext, declarations: PPAstConstantDeclaration, extra_newline: BOOLEAN); proc transpile_constant_part(context: ^TranspilerContext, declarations: ^^AstConstantDeclaration, extra_newline: Bool);
var var
current_declaration: PPAstConstantDeclaration; current_declaration: ^^AstConstantDeclaration;
begin begin
if declarations^ <> nil then if declarations^ <> nil then
WriteString(context^.output, 'CONST'); WriteString(context^.output, 'CONST');
@@ -93,7 +100,7 @@ begin
while current_declaration^ <> nil do while current_declaration^ <> nil do
transpile_constant_declaration(context, current_declaration^); transpile_constant_declaration(context, current_declaration^);
INC(current_declaration, TSIZE(PAstConstantDeclaration)) INC(current_declaration, #size(^AstConstantDeclaration))
end; end;
if extra_newline then if extra_newline then
WriteLine(context^.output) WriteLine(context^.output)
@@ -101,7 +108,7 @@ begin
end end
end; end;
proc transpile_module(context: PTranspilerContext, result: PAstModule); proc transpile_module(context: ^TranspilerContext, result: ^AstModule);
begin begin
if result^.main = false then if result^.main = false then
WriteString(context^.output, 'IMPLEMENTATION ') WriteString(context^.output, 'IMPLEMENTATION ')
@@ -130,21 +137,21 @@ begin
WriteLine(context^.output) WriteLine(context^.output)
end; end;
proc transpile_type_fields(context: PTranspilerContext, fields: PAstFieldDeclaration); proc transpile_type_fields(context: ^TranspilerContext, fields: ^AstFieldDeclaration);
var var
written_bytes: CARDINAL; written_bytes: Word;
current_field: PAstFieldDeclaration; current_field: ^AstFieldDeclaration;
begin begin
current_field := fields; current_field := fields;
while ORD(current_field^.field_name[1]) <> 0 do while ORD(current_field^.field_name[1]) <> 0 do
WriteString(context^.output, ' '); WriteString(context^.output, ' ');
written_bytes := WriteNBytes(context^.output, ORD(current_field^.field_name[1]), ADR(current_field^.field_name[2])); written_bytes := WriteNBytes(context^.output, ORD(current_field^.field_name[1]), @current_field^.field_name[2]);
WriteString(context^.output, ': '); WriteString(context^.output, ': ');
transpile_type_expression(context, current_field^.field_type); transpile_type_expression(context, current_field^.field_type);
INC(current_field , TSIZE(AstFieldDeclaration)); INC(current_field , #size(AstFieldDeclaration));
if ORD(current_field^.field_name[1]) <> 0 then if ORD(current_field^.field_name[1]) <> 0 then
WriteChar(context^.output, ';') WriteChar(context^.output, ';')
@@ -153,7 +160,7 @@ begin
end end
end; end;
proc transpile_record_type(context: PTranspilerContext, type_expression: PAstTypeExpression); proc transpile_record_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
begin begin
WriteString(context^.output, 'RECORD'); WriteString(context^.output, 'RECORD');
WriteLine(context^.output); WriteLine(context^.output);
@@ -161,14 +168,14 @@ begin
WriteString(context^.output, ' END') WriteString(context^.output, ' END')
end; end;
proc transpile_pointer_type(context: PTranspilerContext, type_expression: PAstTypeExpression); proc transpile_pointer_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
begin begin
WriteString(context^.output, 'POINTER TO '); WriteString(context^.output, 'POINTER TO ');
transpile_type_expression(context, type_expression^.target) transpile_type_expression(context, type_expression^.target)
end; end;
proc transpile_array_type(context: PTranspilerContext, type_expression: PAstTypeExpression); proc transpile_array_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var var
buffer: [20]CHAR; buffer: [20]CHAR;
begin begin
@@ -187,43 +194,43 @@ begin
transpile_type_expression(context, type_expression^.base) transpile_type_expression(context, type_expression^.base)
end; end;
proc transpile_enumeration_type(context: PTranspilerContext, type_expression: PAstTypeExpression); proc transpile_enumeration_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var var
current_case: PIdentifier; current_case: ^Identifier;
written_bytes: CARDINAL; written_bytes: Word;
begin begin
current_case := type_expression^.cases; current_case := type_expression^.cases;
WriteString(context^.output, '('); WriteString(context^.output, '(');
WriteLine(context^.output); WriteLine(context^.output);
WriteString(context^.output, ' '); WriteString(context^.output, ' ');
written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2])); written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), @current_case^[2]);
INC(current_case, TSIZE(Identifier)); INC(current_case, #size(Identifier));
while ORD(current_case^[1]) <> 0 do while ORD(current_case^[1]) <> 0 do
WriteChar(context^.output, ','); WriteChar(context^.output, ',');
WriteLine(context^.output); WriteLine(context^.output);
WriteString(context^.output, ' '); WriteString(context^.output, ' ');
written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2])); written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), @current_case^[2]);
INC(current_case, TSIZE(Identifier)) INC(current_case, #size(Identifier))
end; end;
WriteLine(context^.output); WriteLine(context^.output);
WriteString(context^.output, ' )') WriteString(context^.output, ' )')
end; end;
proc transpile_named_type(context: PTranspilerContext, type_expression: PAstTypeExpression); proc transpile_named_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var var
written_bytes: CARDINAL; written_bytes: Word;
begin begin
written_bytes := WriteNBytes(context^.output, ORD(type_expression^.name[1]), ADR(type_expression^.name[2])) written_bytes := WriteNBytes(context^.output, ORD(type_expression^.name[1]), @type_expression^.name[2])
end; end;
proc transpile_procedure_type(context: PTranspilerContext, type_expression: PAstTypeExpression); proc transpile_procedure_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var var
result: PAstTypeExpression; result: ^AstTypeExpression;
current_parameter: PPAstTypeExpression; current_parameter: ^^AstTypeExpression;
parameter_count: CARDINAL; parameter_count: Word;
begin begin
WriteString(context^.output, 'PROCEDURE('); WriteString(context^.output, 'PROCEDURE(');
current_parameter := type_expression^.parameters; current_parameter := type_expression^.parameters;
@@ -231,7 +238,7 @@ begin
while current_parameter^ <> nil do while current_parameter^ <> nil do
transpile_type_expression(context, current_parameter^); transpile_type_expression(context, current_parameter^);
INC(current_parameter, TSIZE(PAstTypeExpression)); INC(current_parameter, #size(^AstTypeExpression));
if current_parameter^ <> nil then if current_parameter^ <> nil then
WriteString(context^.output, ', ') WriteString(context^.output, ', ')
@@ -240,7 +247,7 @@ begin
WriteChar(context^.output, ')') WriteChar(context^.output, ')')
end; end;
proc transpile_type_expression(context: PTranspilerContext, type_expression: PAstTypeExpression); proc transpile_type_expression(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
begin begin
if type_expression^.kind = astTypeExpressionKindRecord then if type_expression^.kind = astTypeExpressionKindRecord then
transpile_record_type(context, type_expression) transpile_record_type(context, type_expression)
@@ -262,22 +269,22 @@ begin
end end
end; end;
proc transpile_type_declaration(context: PTranspilerContext, declaration: PAstTypedDeclaration); proc transpile_type_declaration(context: ^TranspilerContext, declaration: ^AstTypedDeclaration);
var var
written_bytes: CARDINAL; written_bytes: Word;
begin begin
WriteString(context^.output, ' '); WriteString(context^.output, ' ');
written_bytes := WriteNBytes(context^.output, ORD(declaration^.identifier[1]), ADR(declaration^.identifier[2])); written_bytes := WriteNBytes(context^.output, ORD(declaration^.identifier[1]), @declaration^.identifier[2]);
WriteString(context^.output, ' = '); WriteString(context^.output, ' = ');
transpile_type_expression(context, declaration^.type_expression); transpile_type_expression(context, declaration^.type_expression);
write_semicolon(context^.output) write_semicolon(context^.output)
end; end;
proc transpile_type_part(context: PTranspilerContext, declarations: PPAstTypedDeclaration); proc transpile_type_part(context: ^TranspilerContext, declarations: ^^AstTypedDeclaration);
var var
current_declaration: PPAstTypedDeclaration; current_declaration: ^^AstTypedDeclaration;
begin begin
if declarations^ <> nil then if declarations^ <> nil then
WriteString(context^.output, 'TYPE'); WriteString(context^.output, 'TYPE');
@@ -287,18 +294,18 @@ begin
while current_declaration^ <> nil do while current_declaration^ <> nil do
transpile_type_declaration(context, current_declaration^); transpile_type_declaration(context, current_declaration^);
INC(current_declaration, TSIZE(PAstTypedDeclaration)) INC(current_declaration, #size(^AstTypedDeclaration))
end; end;
WriteLine(context^.output) WriteLine(context^.output)
end end
end; end;
proc transpile_variable_declaration(context: PTranspilerContext, declaration: PAstVariableDeclaration); proc transpile_variable_declaration(context: ^TranspilerContext, declaration: ^AstVariableDeclaration);
var var
written_bytes: CARDINAL; written_bytes: Word;
begin begin
WriteString(context^.output, ' '); WriteString(context^.output, ' ');
written_bytes := WriteNBytes(context^.output, ORD(declaration^.variable_name[1]), ADR(declaration^.variable_name[2])); written_bytes := WriteNBytes(context^.output, ORD(declaration^.variable_name[1]), @declaration^.variable_name[2]);
WriteString(context^.output, ': '); WriteString(context^.output, ': ');
@@ -306,9 +313,9 @@ begin
write_semicolon(context^.output) write_semicolon(context^.output)
end; end;
proc transpile_variable_part(context: PTranspilerContext, declarations: PPAstVariableDeclaration, extra_newline: BOOLEAN); proc transpile_variable_part(context: ^TranspilerContext, declarations: ^^AstVariableDeclaration, extra_newline: Bool);
var var
current_declaration: PPAstVariableDeclaration; current_declaration: ^^AstVariableDeclaration;
begin begin
if declarations^ <> nil then if declarations^ <> nil then
WriteString(context^.output, 'VAR'); WriteString(context^.output, 'VAR');
@@ -318,7 +325,7 @@ begin
while current_declaration^ <> nil do while current_declaration^ <> nil do
transpile_variable_declaration(context, current_declaration^); transpile_variable_declaration(context, current_declaration^);
INC(current_declaration, TSIZE(PAstVariableDeclaration)) INC(current_declaration, #size(^AstVariableDeclaration))
end; end;
if extra_newline then if extra_newline then
WriteLine(context^.output) WriteLine(context^.output)
@@ -326,26 +333,26 @@ begin
end end
end; end;
proc transpile_procedure_heading(context: PTranspilerContext, declaration: PAstProcedureDeclaration); proc transpile_procedure_heading(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration);
var var
written_bytes: CARDINAL; written_bytes: Word;
parameter_index: CARDINAL; parameter_index: Word;
current_parameter: PAstTypedDeclaration; current_parameter: ^AstTypedDeclaration;
begin begin
WriteString(context^.output, 'PROCEDURE '); WriteString(context^.output, 'PROCEDURE ');
written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2])); written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), @declaration^.name[2]);
WriteChar(context^.output, '('); WriteChar(context^.output, '(');
parameter_index := 0; parameter_index := 0;
current_parameter := declaration^.parameters; current_parameter := declaration^.parameters;
while parameter_index < declaration^.parameter_count do while parameter_index < declaration^.parameter_count do
written_bytes := WriteNBytes(context^.output, ORD(current_parameter^.identifier[1]), ADR(current_parameter^.identifier[2])); written_bytes := WriteNBytes(context^.output, ORD(current_parameter^.identifier[1]), @current_parameter^.identifier[2]);
WriteString(context^.output, ': '); WriteString(context^.output, ': ');
transpile_type_expression(context, current_parameter^.type_expression); transpile_type_expression(context, current_parameter^.type_expression);
INC(parameter_index); parameter_index := parameter_index + 1u;
INC(current_parameter, TSIZE(AstTypedDeclaration)); INC(current_parameter, #size(AstTypedDeclaration));
if parameter_index <> declaration^.parameter_count then if parameter_index <> declaration^.parameter_count then
WriteString(context^.output, '; ') WriteString(context^.output, '; ')
@@ -362,83 +369,63 @@ begin
write_semicolon(context^.output) write_semicolon(context^.output)
end; end;
proc transpile_unary_operator(context: PTranspilerContext, operator: AstUnaryOperator); proc transpile_unary_operator(context: ^TranspilerContext, operator: AstUnaryOperator);
begin begin
if operator = astUnaryOperatorMinus then if operator = AstUnaryOperator.minus then
WriteChar(context^.output, '-') WriteChar(context^.output, '-')
end; end;
if operator = astUnaryOperatorNot then if operator = AstUnaryOperator.not then
WriteChar(context^.output, '~') WriteChar(context^.output, '~')
end end
end; end;
proc transpile_binary_operator(context: PTranspilerContext, operator: AstBinaryOperator); proc transpile_binary_operator(context: ^TranspilerContext, operator: AstBinaryOperator);
begin begin
if operator = astBinaryOperatorSum then case operator of
WriteChar(context^.output, '+') AstBinaryOperator.sum: WriteChar(context^.output, '+')
end; | AstBinaryOperator.subtraction: WriteChar(context^.output, '-')
if operator = astBinaryOperatorSubtraction then | AstBinaryOperator.multiplication: WriteChar(context^.output, '*')
WriteChar(context^.output, '-') | AstBinaryOperator.equals: WriteChar(context^.output, '=')
end; | AstBinaryOperator.not_equals: WriteChar(context^.output, '#')
if operator = astBinaryOperatorMultiplication then | AstBinaryOperator.less: WriteChar(context^.output, '<')
WriteChar(context^.output, '*') | AstBinaryOperator.greater: WriteChar(context^.output, '>')
end; | AstBinaryOperator.less_equal: WriteString(context^.output, '<=')
if operator = astBinaryOperatorEquals then | AstBinaryOperator.greater_equal: WriteString(context^.output, '>=')
WriteChar(context^.output, '=') | AstBinaryOperator.disjunction: WriteString(context^.output, 'OR')
end; | AstBinaryOperatorConjunction: WriteString(context^.output, 'AND')
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
end; end;
proc transpile_expression(context: PTranspilerContext, expression: PAstExpression); proc transpile_expression(context: ^TranspilerContext, expression: ^AstExpression);
var var
literal: PAstLiteral; literal: ^AstLiteral;
buffer: [20]CHAR; buffer: [20]CHAR;
written_bytes: CARDINAL; written_bytes: Word;
argument_index: CARDINAL; argument_index: Word;
current_argument: PPAstExpression; current_argument: ^^AstExpression;
begin begin
if expression^.kind = astExpressionKindLiteral then if expression^.kind = astExpressionKindLiteral then
literal := expression^.literal; literal := expression^.literal;
if literal^.kind = astLiteralKindInteger then if literal^.kind = AstLiteralKind.integer then
IntToStr(literal^.integer, 0, buffer); IntToStr(literal^.integer, 0, buffer);
WriteString(context^.output, buffer) WriteString(context^.output, buffer)
end; end;
if literal^.kind = astLiteralKindString then if literal^.kind = AstLiteralKind.string then
WriteString(context^.output, literal^.string) WriteString(context^.output, literal^.string)
end; end;
if literal^.kind = astLiteralKindNull then if literal^.kind = AstLiteralKind.null then
WriteString(context^.output, 'NIL') WriteString(context^.output, 'NIL')
end; end;
if (literal^.kind = astLiteralKindBoolean) & literal^.boolean then if (literal^.kind = AstLiteralKind.boolean) & literal^.boolean then
WriteString(context^.output, 'TRUE') WriteString(context^.output, 'TRUE')
end; end;
if (literal^.kind = astLiteralKindBoolean) & (literal^.boolean = false) then if (literal^.kind = AstLiteralKind.boolean) & (literal^.boolean = false) then
WriteString(context^.output, 'FALSE') WriteString(context^.output, 'FALSE')
end end
end; end;
if expression^.kind = astExpressionKindIdentifier then if expression^.kind = astExpressionKindIdentifier then
written_bytes := WriteNBytes(context^.output, ORD(expression^.identifier[1]), ADR(expression^.identifier[2])) written_bytes := WriteNBytes(context^.output, ORD(expression^.identifier[1]), @expression^.identifier[2])
end; end;
if expression^.kind = astExpressionKindDereference then if expression^.kind = astExpressionKindDereference then
transpile_expression(context, expression^.reference); transpile_expression(context, expression^.reference);
@@ -453,7 +440,7 @@ begin
if expression^.kind = astExpressionKindFieldAccess then if expression^.kind = astExpressionKindFieldAccess then
transpile_expression(context, expression^.aggregate); transpile_expression(context, expression^.aggregate);
WriteChar(context^.output, '.'); WriteChar(context^.output, '.');
written_bytes := WriteNBytes(context^.output, ORD(expression^.field[1]), ADR(expression^.field[2])) written_bytes := WriteNBytes(context^.output, ORD(expression^.field[1]), @expression^.field[2])
end; end;
if expression^.kind = astExpressionKindUnary then if expression^.kind = astExpressionKindUnary then
transpile_unary_operator(context, expression^.unary_operator); transpile_unary_operator(context, expression^.unary_operator);
@@ -476,70 +463,70 @@ begin
if expression^.argument_count > 0 then if expression^.argument_count > 0 then
transpile_expression(context, current_argument^); transpile_expression(context, current_argument^);
argument_index := 1; argument_index := 1u;
INC(current_argument, TSIZE(PAstExpression)); INC(current_argument, #size(^AstExpression));
while argument_index < expression^.argument_count do while argument_index < expression^.argument_count do
WriteString(context^.output, ', '); WriteString(context^.output, ', ');
transpile_expression(context, current_argument^); transpile_expression(context, current_argument^);
INC(current_argument, TSIZE(PAstExpression)); INC(current_argument, #size(^AstExpression));
INC(argument_index) argument_index := argument_index + 1u
end end
end; end;
WriteChar(context^.output, ')') WriteChar(context^.output, ')')
end end
end; end;
proc transpile_if_statement(context: PTranspilerContext, statement: PAstStatement); proc transpile_if_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin begin
WriteString(context^.output, 'IF '); WriteString(context^.output, 'IF ');
transpile_expression(context, statement^.if_condition); transpile_expression(context, statement^.if_condition);
WriteString(context^.output, ' THEN'); WriteString(context^.output, ' THEN');
WriteLine(context^.output); WriteLine(context^.output);
INC(context^.indentation); context^.indentation := context^.indentation + 1u;
transpile_compound_statement(context, statement^.if_branch); transpile_compound_statement(context, statement^.if_branch);
DEC(context^.indentation); context^.indentation := context^.indentation - 1u;
indent(context); indent(context);
WriteString(context^.output, 'END') WriteString(context^.output, 'END')
end; end;
proc transpile_while_statement(context: PTranspilerContext, statement: PAstStatement); proc transpile_while_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin begin
WriteString(context^.output, 'WHILE '); WriteString(context^.output, 'WHILE ');
transpile_expression(context, statement^.while_condition); transpile_expression(context, statement^.while_condition);
WriteString(context^.output, ' DO'); WriteString(context^.output, ' DO');
WriteLine(context^.output); WriteLine(context^.output);
INC(context^.indentation); context^.indentation := context^.indentation + 1u;
transpile_compound_statement(context, statement^.while_body); transpile_compound_statement(context, statement^.while_body);
DEC(context^.indentation); context^.indentation := context^.indentation - 1u;
indent(context); indent(context);
WriteString(context^.output, 'END') WriteString(context^.output, 'END')
end; end;
proc transpile_assignment_statement(context: PTranspilerContext, statement: PAstStatement); proc transpile_assignment_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin begin
transpile_expression(context, statement^.assignee); transpile_expression(context, statement^.assignee);
WriteString(context^.output, ' := '); WriteString(context^.output, ' := ');
transpile_expression(context, statement^.assignment) transpile_expression(context, statement^.assignment)
end; end;
proc transpile_return_statement(context: PTranspilerContext, statement: PAstStatement); proc transpile_return_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin begin
WriteString(context^.output, 'RETURN '); WriteString(context^.output, 'RETURN ');
transpile_expression(context, statement^.returned) transpile_expression(context, statement^.returned)
end; end;
proc transpile_compound_statement(context: PTranspilerContext, statement: AstCompoundStatement); proc transpile_compound_statement(context: ^TranspilerContext, statement: AstCompoundStatement);
var var
current_statement: PPAstStatement; current_statement: ^^AstStatement;
index: CARDINAL; index: Word;
begin begin
index := 0; index := 0;
current_statement := statement.statements; current_statement := statement.statements;
@@ -547,8 +534,8 @@ begin
while index < statement.count do while index < statement.count do
transpile_statement(context, current_statement^); transpile_statement(context, current_statement^);
INC(current_statement, TSIZE(PAstStatement)); INC(current_statement, #size(^AstStatement));
INC(index); index := index + 1u;
if index <> statement.count then if index <> statement.count then
WriteChar(context^.output, ';') WriteChar(context^.output, ';')
@@ -557,7 +544,7 @@ begin
end end
end; end;
proc transpile_statement(context: PTranspilerContext, statement: PAstStatement); proc transpile_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin begin
indent(context); indent(context);
@@ -578,21 +565,21 @@ begin
end end
end; end;
proc transpile_statement_part(context: PTranspilerContext, compound: AstCompoundStatement); proc transpile_statement_part(context: ^TranspilerContext, compound: AstCompoundStatement);
begin begin
if compound.count > 0 then if compound.count > 0 then
WriteString(context^.output, 'BEGIN'); WriteString(context^.output, 'BEGIN');
WriteLine(context^.output); WriteLine(context^.output);
INC(context^.indentation); context^.indentation := context^.indentation + 1u;
transpile_compound_statement(context, compound); transpile_compound_statement(context, compound);
DEC(context^.indentation) context^.indentation := context^.indentation - 1u;
end end
end; end;
proc transpile_procedure_declaration(context: PTranspilerContext, declaration: PAstProcedureDeclaration); proc transpile_procedure_declaration(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration);
var var
written_bytes: CARDINAL; written_bytes: Word;
begin begin
transpile_procedure_heading(context, declaration); transpile_procedure_heading(context, declaration);
@@ -601,58 +588,58 @@ begin
transpile_statement_part(context, declaration^.statements); transpile_statement_part(context, declaration^.statements);
WriteString(context^.output, 'END '); WriteString(context^.output, 'END ');
written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2])); written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), @declaration^.name[2]);
write_semicolon(context^.output) write_semicolon(context^.output)
end; end;
proc transpile_procedure_part(context: PTranspilerContext, declaration: PPAstProcedureDeclaration); proc transpile_procedure_part(context: ^TranspilerContext, declaration: ^^AstProcedureDeclaration);
begin begin
while declaration^ <> nil do while declaration^ <> nil do
transpile_procedure_declaration(context, declaration^); transpile_procedure_declaration(context, declaration^);
WriteLine(context^.output); WriteLine(context^.output);
INC(declaration, TSIZE(PAstProcedureDeclaration)) INC(declaration, #size(^AstProcedureDeclaration))
end end
end; end;
proc transpile_module_name(context: PTranspilerContext); proc transpile_module_name(context: ^TranspilerContext);
var var
counter: CARDINAL; counter: Word;
last_slash: CARDINAL; last_slash: Word;
begin begin
counter := 1; counter := 1u;
last_slash := 0; last_slash := 0u;
while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
if context^.input_name[counter] = '/' then if context^.input_name[counter] = '/' then
last_slash := counter last_slash := counter
end; end;
INC(counter) counter := counter + 1u
end; end;
if last_slash = 0 then if last_slash = 0u then
counter := 1 counter := 1u
end; end;
if last_slash <> 0 then if last_slash <> 0u then
counter := last_slash + 1 counter := last_slash + 1u
end; end;
while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
WriteChar(context^.output, context^.input_name[counter]); WriteChar(context^.output, context^.input_name[counter]);
INC(counter) counter := counter + 1u
end end
end; end;
proc transpile(ast_module: PAstModule, output: File, definition: File, input_name: ShortString); proc transpile*(ast_module: ^AstModule, output: File, definition: File, input_name: ShortString);
var var
context: TranspilerContext; context: TranspilerContext;
begin begin
context.input_name := input_name; context.input_name := input_name;
context.output := output; context.output := output;
context.definition := definition; context.definition := definition;
context.indentation := 0; context.indentation := 0u;
transpile_module(ADR(context), ast_module) transpile_module(@context, ast_module)
end; end;
end. end.