belka/elna
1
0
Fork 0
Code Issues 34 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
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`
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;
from SYSTEM import ADR, TSIZE;
from Args import GetArg, Narg;
from FIO import WriteString, WriteChar, WriteLine, StdErr;
from Storage import ALLOCATE;
@@ -10,18 +11,26 @@ from MemUtils import MemZero;
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
parameter: ShortString;
i: CARDINAL;
result: PCommandLine;
parsed: BOOLEAN;
i: Word;
result: ^CommandLine;
parsed: Bool;
begin
i := 1;
i := 1u;
NEW(result);
result^.lex := false;
result^.parse := false;
MemZero(ADR(result^.input), 256);
MemZero(@result^.input, 256);
result^.output[1] := CHAR(0);
while (i < Narg()) & (result <> nil) do
@@ -37,7 +46,7 @@ begin
result^.parse := true
end;
if CompareStr(parameter, '-o') = 0 then
INC(i);
i := i + 1u;
if i = Narg() then
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;
type
ShortString = [256]Char;
Identifier = [256]Char;
PIdentifier = ^Identifier;
TextLocation* = record
line: 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;
from FIO import Close, IsNoError, File, OpenToRead, OpenToWrite, StdErr, StdOut, WriteLine, WriteString;
from SYSTEM import ADR;
from M2RTS import HALT, ExitOnHalt;
from Lexer import Lexer, lexer_destroy, lexer_initialize;
from Parser import Parser;
from Transpiler import transpile;
from CommandLineInterface import PCommandLine, parse_command_line;
from Parser import PAstModule, parse;
from CommandLineInterface import CommandLine, parse_command_line;
from Parser import AstModule, parse;
from Strings import Length;
var
command_line: PCommandLine;
command_line: ^CommandLine;
proc compile_from_stream();
var
lexer: Lexer;
source_input: File;
source_output: File;
ast_module: PAstModule;
ast_module: ^AstModule;
begin
source_input := OpenToRead(command_line^.input);
@@ -47,12 +49,12 @@ begin
end;
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);
lexer_destroy(ADR(lexer));
lexer_destroy(@lexer);
Close(source_output);
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;
from FIO import WriteNBytes, WriteLine, WriteChar, WriteString;
from SYSTEM import ADR, TSIZE;
from FIO import File, WriteNBytes, WriteLine, WriteChar, WriteString;
from NumberIO import IntToStr;
from Common import Identifier, PIdentifier, ShortString;
from Common import Identifier, ShortString;
from Parser import AstTypeExpressionKind, AstExpressionKind, AstLiteralKind, AstUnaryOperator, AstBinaryOperator,
PAstModule, PPAstExpression, PAstExpression, PAstLiteral, PPAstProcedureDeclaration,
PAstConstantDeclaration, PPAstConstantDeclaration, PPAstStatement, PAstStatement, AstStatementKind,
AstTypedDeclaration, PAstTypedDeclaration, PPAstTypedDeclaration, AstCompoundStatement, PAstProcedureDeclaration,
PAstVariableDeclaration, PPAstVariableDeclaration, PAstImportStatement, PPAstImportStatement,
PAstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration;
AstModule, AstExpression, AstLiteral, AstConstantDeclaration, AstStatement, AstStatementKind,
AstTypedDeclaration, AstCompoundStatement, AstProcedureDeclaration,
AstVariableDeclaration, AstImportStatement, AstTypeExpression, AstFieldDeclaration;
proc indent(context: PTranspilerContext);
type
TranspilerContext* = record
input_name: ShortString;
output: File;
definition: File;
indentation: Word
end;
proc indent(context: ^TranspilerContext);
var
count: CARDINAL;
count: Word;
begin
count := 0;
while count < context^.indentation do
WriteString(context^.output, ' ');
INC(count)
count := count + 1u
end
end;
@@ -32,46 +39,46 @@ begin
WriteLine(output)
end;
proc transpile_import_statement(context: PTranspilerContext, import_statement: PAstImportStatement);
proc transpile_import_statement(context: ^TranspilerContext, import_statement: ^AstImportStatement);
var
written_bytes: CARDINAL;
current_symbol: PIdentifier;
written_bytes: Word;
current_symbol: ^Identifier;
begin
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 ');
current_symbol := import_statement^.symbols;
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2]));
INC(current_symbol, TSIZE(Identifier));
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), @current_symbol^[2]);
INC(current_symbol, #size(Identifier));
while ORD(current_symbol^[1]) <> 0 do
WriteString(context^.output, ', ');
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2]));
INC(current_symbol, TSIZE(Identifier))
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), @current_symbol^[2]);
INC(current_symbol, #size(Identifier))
end;
write_semicolon(context^.output)
end;
proc transpile_import_part(context: PTranspilerContext, imports: PPAstImportStatement);
proc transpile_import_part(context: ^TranspilerContext, imports: ^^AstImportStatement);
var
import_statement: PAstImportStatement;
import_statement: ^AstImportStatement;
begin
while imports^ <> nil do
transpile_import_statement(context, imports^);
INC(imports, TSIZE(PAstImportStatement))
INC(imports, #size(^AstImportStatement))
end;
WriteLine(context^.output)
end;
proc transpile_constant_declaration(context: PTranspilerContext, declaration: PAstConstantDeclaration);
proc transpile_constant_declaration(context: ^TranspilerContext, declaration: ^AstConstantDeclaration);
var
buffer: [20]CHAR;
written_bytes: CARDINAL;
written_bytes: Word;
begin
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, ' = ');
@@ -81,9 +88,9 @@ begin
write_semicolon(context^.output)
end;
proc transpile_constant_part(context: PTranspilerContext, declarations: PPAstConstantDeclaration, extra_newline: BOOLEAN);
proc transpile_constant_part(context: ^TranspilerContext, declarations: ^^AstConstantDeclaration, extra_newline: Bool);
var
current_declaration: PPAstConstantDeclaration;
current_declaration: ^^AstConstantDeclaration;
begin
if declarations^ <> nil then
WriteString(context^.output, 'CONST');
@@ -93,7 +100,7 @@ begin
while current_declaration^ <> nil do
transpile_constant_declaration(context, current_declaration^);
INC(current_declaration, TSIZE(PAstConstantDeclaration))
INC(current_declaration, #size(^AstConstantDeclaration))
end;
if extra_newline then
WriteLine(context^.output)
@@ -101,7 +108,7 @@ begin
end
end;
proc transpile_module(context: PTranspilerContext, result: PAstModule);
proc transpile_module(context: ^TranspilerContext, result: ^AstModule);
begin
if result^.main = false then
WriteString(context^.output, 'IMPLEMENTATION ')
@@ -130,21 +137,21 @@ begin
WriteLine(context^.output)
end;
proc transpile_type_fields(context: PTranspilerContext, fields: PAstFieldDeclaration);
proc transpile_type_fields(context: ^TranspilerContext, fields: ^AstFieldDeclaration);
var
written_bytes: CARDINAL;
current_field: PAstFieldDeclaration;
written_bytes: Word;
current_field: ^AstFieldDeclaration;
begin
current_field := fields;
while ORD(current_field^.field_name[1]) <> 0 do
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, ': ');
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
WriteChar(context^.output, ';')
@@ -153,7 +160,7 @@ begin
end
end;
proc transpile_record_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
proc transpile_record_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
begin
WriteString(context^.output, 'RECORD');
WriteLine(context^.output);
@@ -161,14 +168,14 @@ begin
WriteString(context^.output, ' END')
end;
proc transpile_pointer_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
proc transpile_pointer_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
begin
WriteString(context^.output, 'POINTER TO ');
transpile_type_expression(context, type_expression^.target)
end;
proc transpile_array_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
proc transpile_array_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var
buffer: [20]CHAR;
begin
@@ -187,43 +194,43 @@ begin
transpile_type_expression(context, type_expression^.base)
end;
proc transpile_enumeration_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
proc transpile_enumeration_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var
current_case: PIdentifier;
written_bytes: CARDINAL;
current_case: ^Identifier;
written_bytes: Word;
begin
current_case := type_expression^.cases;
WriteString(context^.output, '(');
WriteLine(context^.output);
WriteString(context^.output, ' ');
written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2]));
INC(current_case, TSIZE(Identifier));
written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), @current_case^[2]);
INC(current_case, #size(Identifier));
while ORD(current_case^[1]) <> 0 do
WriteChar(context^.output, ',');
WriteLine(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;
WriteLine(context^.output);
WriteString(context^.output, ' )')
end;
proc transpile_named_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
proc transpile_named_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var
written_bytes: CARDINAL;
written_bytes: Word;
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;
proc transpile_procedure_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
proc transpile_procedure_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var
result: PAstTypeExpression;
current_parameter: PPAstTypeExpression;
parameter_count: CARDINAL;
result: ^AstTypeExpression;
current_parameter: ^^AstTypeExpression;
parameter_count: Word;
begin
WriteString(context^.output, 'PROCEDURE(');
current_parameter := type_expression^.parameters;
@@ -231,7 +238,7 @@ begin
while current_parameter^ <> nil do
transpile_type_expression(context, current_parameter^);
INC(current_parameter, TSIZE(PAstTypeExpression));
INC(current_parameter, #size(^AstTypeExpression));
if current_parameter^ <> nil then
WriteString(context^.output, ', ')
@@ -240,7 +247,7 @@ begin
WriteChar(context^.output, ')')
end;
proc transpile_type_expression(context: PTranspilerContext, type_expression: PAstTypeExpression);
proc transpile_type_expression(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
begin
if type_expression^.kind = astTypeExpressionKindRecord then
transpile_record_type(context, type_expression)
@@ -262,22 +269,22 @@ begin
end
end;
proc transpile_type_declaration(context: PTranspilerContext, declaration: PAstTypedDeclaration);
proc transpile_type_declaration(context: ^TranspilerContext, declaration: ^AstTypedDeclaration);
var
written_bytes: CARDINAL;
written_bytes: Word;
begin
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, ' = ');
transpile_type_expression(context, declaration^.type_expression);
write_semicolon(context^.output)
end;
proc transpile_type_part(context: PTranspilerContext, declarations: PPAstTypedDeclaration);
proc transpile_type_part(context: ^TranspilerContext, declarations: ^^AstTypedDeclaration);
var
current_declaration: PPAstTypedDeclaration;
current_declaration: ^^AstTypedDeclaration;
begin
if declarations^ <> nil then
WriteString(context^.output, 'TYPE');
@@ -287,18 +294,18 @@ begin
while current_declaration^ <> nil do
transpile_type_declaration(context, current_declaration^);
INC(current_declaration, TSIZE(PAstTypedDeclaration))
INC(current_declaration, #size(^AstTypedDeclaration))
end;
WriteLine(context^.output)
end
end;
proc transpile_variable_declaration(context: PTranspilerContext, declaration: PAstVariableDeclaration);
proc transpile_variable_declaration(context: ^TranspilerContext, declaration: ^AstVariableDeclaration);
var
written_bytes: CARDINAL;
written_bytes: Word;
begin
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, ': ');
@@ -306,9 +313,9 @@ begin
write_semicolon(context^.output)
end;
proc transpile_variable_part(context: PTranspilerContext, declarations: PPAstVariableDeclaration, extra_newline: BOOLEAN);
proc transpile_variable_part(context: ^TranspilerContext, declarations: ^^AstVariableDeclaration, extra_newline: Bool);
var
current_declaration: PPAstVariableDeclaration;
current_declaration: ^^AstVariableDeclaration;
begin
if declarations^ <> nil then
WriteString(context^.output, 'VAR');
@@ -318,7 +325,7 @@ begin
while current_declaration^ <> nil do
transpile_variable_declaration(context, current_declaration^);
INC(current_declaration, TSIZE(PAstVariableDeclaration))
INC(current_declaration, #size(^AstVariableDeclaration))
end;
if extra_newline then
WriteLine(context^.output)
@@ -326,26 +333,26 @@ begin
end
end;
proc transpile_procedure_heading(context: PTranspilerContext, declaration: PAstProcedureDeclaration);
proc transpile_procedure_heading(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration);
var
written_bytes: CARDINAL;
parameter_index: CARDINAL;
current_parameter: PAstTypedDeclaration;
written_bytes: Word;
parameter_index: Word;
current_parameter: ^AstTypedDeclaration;
begin
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, '(');
parameter_index := 0;
current_parameter := declaration^.parameters;
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, ': ');
transpile_type_expression(context, current_parameter^.type_expression);
INC(parameter_index);
INC(current_parameter, TSIZE(AstTypedDeclaration));
parameter_index := parameter_index + 1u;
INC(current_parameter, #size(AstTypedDeclaration));
if parameter_index <> declaration^.parameter_count then
WriteString(context^.output, '; ')
@@ -362,83 +369,63 @@ begin
write_semicolon(context^.output)
end;
proc transpile_unary_operator(context: PTranspilerContext, operator: AstUnaryOperator);
proc transpile_unary_operator(context: ^TranspilerContext, operator: AstUnaryOperator);
begin
if operator = astUnaryOperatorMinus then
if operator = AstUnaryOperator.minus then
WriteChar(context^.output, '-')
end;
if operator = astUnaryOperatorNot then
if operator = AstUnaryOperator.not then
WriteChar(context^.output, '~')
end
end;
proc transpile_binary_operator(context: PTranspilerContext, operator: AstBinaryOperator);
proc transpile_binary_operator(context: ^TranspilerContext, operator: AstBinaryOperator);
begin
if operator = astBinaryOperatorSum then
WriteChar(context^.output, '+')
end;
if operator = astBinaryOperatorSubtraction then
WriteChar(context^.output, '-')
end;
if operator = astBinaryOperatorMultiplication then
WriteChar(context^.output, '*')
end;
if operator = astBinaryOperatorEquals then
WriteChar(context^.output, '=')
end;
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')
case operator of
AstBinaryOperator.sum: WriteChar(context^.output, '+')
| AstBinaryOperator.subtraction: WriteChar(context^.output, '-')
| AstBinaryOperator.multiplication: WriteChar(context^.output, '*')
| AstBinaryOperator.equals: WriteChar(context^.output, '=')
| AstBinaryOperator.not_equals: WriteChar(context^.output, '#')
| AstBinaryOperator.less: WriteChar(context^.output, '<')
| AstBinaryOperator.greater: WriteChar(context^.output, '>')
| AstBinaryOperator.less_equal: WriteString(context^.output, '<=')
| AstBinaryOperator.greater_equal: WriteString(context^.output, '>=')
| AstBinaryOperator.disjunction: WriteString(context^.output, 'OR')
| AstBinaryOperatorConjunction: WriteString(context^.output, 'AND')
end
end;
proc transpile_expression(context: PTranspilerContext, expression: PAstExpression);
proc transpile_expression(context: ^TranspilerContext, expression: ^AstExpression);
var
literal: PAstLiteral;
literal: ^AstLiteral;
buffer: [20]CHAR;
written_bytes: CARDINAL;
argument_index: CARDINAL;
current_argument: PPAstExpression;
written_bytes: Word;
argument_index: Word;
current_argument: ^^AstExpression;
begin
if expression^.kind = astExpressionKindLiteral then
literal := expression^.literal;
if literal^.kind = astLiteralKindInteger then
if literal^.kind = AstLiteralKind.integer then
IntToStr(literal^.integer, 0, buffer);
WriteString(context^.output, buffer)
end;
if literal^.kind = astLiteralKindString then
if literal^.kind = AstLiteralKind.string then
WriteString(context^.output, literal^.string)
end;
if literal^.kind = astLiteralKindNull then
if literal^.kind = AstLiteralKind.null then
WriteString(context^.output, 'NIL')
end;
if (literal^.kind = astLiteralKindBoolean) & literal^.boolean then
if (literal^.kind = AstLiteralKind.boolean) & literal^.boolean then
WriteString(context^.output, 'TRUE')
end;
if (literal^.kind = astLiteralKindBoolean) & (literal^.boolean = false) then
if (literal^.kind = AstLiteralKind.boolean) & (literal^.boolean = false) then
WriteString(context^.output, 'FALSE')
end
end;
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;
if expression^.kind = astExpressionKindDereference then
transpile_expression(context, expression^.reference);
@@ -453,7 +440,7 @@ begin
if expression^.kind = astExpressionKindFieldAccess then
transpile_expression(context, expression^.aggregate);
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;
if expression^.kind = astExpressionKindUnary then
transpile_unary_operator(context, expression^.unary_operator);
@@ -476,70 +463,70 @@ begin
if expression^.argument_count > 0 then
transpile_expression(context, current_argument^);
argument_index := 1;
INC(current_argument, TSIZE(PAstExpression));
argument_index := 1u;
INC(current_argument, #size(^AstExpression));
while argument_index < expression^.argument_count do
WriteString(context^.output, ', ');
transpile_expression(context, current_argument^);
INC(current_argument, TSIZE(PAstExpression));
INC(argument_index)
INC(current_argument, #size(^AstExpression));
argument_index := argument_index + 1u
end
end;
WriteChar(context^.output, ')')
end
end;
proc transpile_if_statement(context: PTranspilerContext, statement: PAstStatement);
proc transpile_if_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin
WriteString(context^.output, 'IF ');
transpile_expression(context, statement^.if_condition);
WriteString(context^.output, ' THEN');
WriteLine(context^.output);
INC(context^.indentation);
context^.indentation := context^.indentation + 1u;
transpile_compound_statement(context, statement^.if_branch);
DEC(context^.indentation);
context^.indentation := context^.indentation - 1u;
indent(context);
WriteString(context^.output, 'END')
end;
proc transpile_while_statement(context: PTranspilerContext, statement: PAstStatement);
proc transpile_while_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin
WriteString(context^.output, 'WHILE ');
transpile_expression(context, statement^.while_condition);
WriteString(context^.output, ' DO');
WriteLine(context^.output);
INC(context^.indentation);
context^.indentation := context^.indentation + 1u;
transpile_compound_statement(context, statement^.while_body);
DEC(context^.indentation);
context^.indentation := context^.indentation - 1u;
indent(context);
WriteString(context^.output, 'END')
end;
proc transpile_assignment_statement(context: PTranspilerContext, statement: PAstStatement);
proc transpile_assignment_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin
transpile_expression(context, statement^.assignee);
WriteString(context^.output, ' := ');
transpile_expression(context, statement^.assignment)
end;
proc transpile_return_statement(context: PTranspilerContext, statement: PAstStatement);
proc transpile_return_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin
WriteString(context^.output, 'RETURN ');
transpile_expression(context, statement^.returned)
end;
proc transpile_compound_statement(context: PTranspilerContext, statement: AstCompoundStatement);
proc transpile_compound_statement(context: ^TranspilerContext, statement: AstCompoundStatement);
var
current_statement: PPAstStatement;
index: CARDINAL;
current_statement: ^^AstStatement;
index: Word;
begin
index := 0;
current_statement := statement.statements;
@@ -547,8 +534,8 @@ begin
while index < statement.count do
transpile_statement(context, current_statement^);
INC(current_statement, TSIZE(PAstStatement));
INC(index);
INC(current_statement, #size(^AstStatement));
index := index + 1u;
if index <> statement.count then
WriteChar(context^.output, ';')
@@ -557,7 +544,7 @@ begin
end
end;
proc transpile_statement(context: PTranspilerContext, statement: PAstStatement);
proc transpile_statement(context: ^TranspilerContext, statement: ^AstStatement);
begin
indent(context);
@@ -578,21 +565,21 @@ begin
end
end;
proc transpile_statement_part(context: PTranspilerContext, compound: AstCompoundStatement);
proc transpile_statement_part(context: ^TranspilerContext, compound: AstCompoundStatement);
begin
if compound.count > 0 then
WriteString(context^.output, 'BEGIN');
WriteLine(context^.output);
INC(context^.indentation);
context^.indentation := context^.indentation + 1u;
transpile_compound_statement(context, compound);
DEC(context^.indentation)
context^.indentation := context^.indentation - 1u;
end
end;
proc transpile_procedure_declaration(context: PTranspilerContext, declaration: PAstProcedureDeclaration);
proc transpile_procedure_declaration(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration);
var
written_bytes: CARDINAL;
written_bytes: Word;
begin
transpile_procedure_heading(context, declaration);
@@ -601,58 +588,58 @@ begin
transpile_statement_part(context, declaration^.statements);
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)
end;
proc transpile_procedure_part(context: PTranspilerContext, declaration: PPAstProcedureDeclaration);
proc transpile_procedure_part(context: ^TranspilerContext, declaration: ^^AstProcedureDeclaration);
begin
while declaration^ <> nil do
transpile_procedure_declaration(context, declaration^);
WriteLine(context^.output);
INC(declaration, TSIZE(PAstProcedureDeclaration))
INC(declaration, #size(^AstProcedureDeclaration))
end
end;
proc transpile_module_name(context: PTranspilerContext);
proc transpile_module_name(context: ^TranspilerContext);
var
counter: CARDINAL;
last_slash: CARDINAL;
counter: Word;
last_slash: Word;
begin
counter := 1;
last_slash := 0;
counter := 1u;
last_slash := 0u;
while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
if context^.input_name[counter] = '/' then
last_slash := counter
end;
INC(counter)
counter := counter + 1u
end;
if last_slash = 0 then
counter := 1
if last_slash = 0u then
counter := 1u
end;
if last_slash <> 0 then
counter := last_slash + 1
if last_slash <> 0u then
counter := last_slash + 1u
end;
while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
WriteChar(context^.output, context^.input_name[counter]);
INC(counter)
counter := counter + 1u
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
context: TranspilerContext;
begin
context.input_name := input_name;
context.output := output;
context.definition := definition;
context.indentation := 0;
context.indentation := 0u;
transpile_module(ADR(context), ast_module)
transpile_module(@context, ast_module)
end;
end.