From e3f094c8a5939fbb3fd7b53fcdfd5f02869607f0 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 11 Jun 2025 22:36:35 +0200 Subject: [PATCH] Split the parser from the code generator --- Rakefile | 2 +- source/Compiler.elna | 5 +- source/Lexer.elna | 10 +- source/Parser.def | 33 +++-- source/Parser.elna | 287 +++++++++++++++++++++++++++++++++++---- source/Transpiler.def | 6 +- source/Transpiler.elna | 296 +++++++++++++++-------------------------- 7 files changed, 409 insertions(+), 230 deletions(-) diff --git a/Rakefile b/Rakefile index 5bdd14e..ba78677 100644 --- a/Rakefile +++ b/Rakefile @@ -110,7 +110,7 @@ task :backport do .gsub(/ & /, ' AND ') .gsub(/ -> /, ': ') .gsub(/program;/, "MODULE #{module_name};") - .gsub(/module;/, "IMPLEMENTATION MODULE #{module_name};") + .gsub(/\bmodule;/, "IMPLEMENTATION MODULE #{module_name};") .gsub(/end\./, "END #{module_name}.") .gsub(/([[:space:]]*)end(;?)$/, '\1END\2') .gsub(/^([[:space:]]*)(while|return|if)\b/) { |match| match.upcase } diff --git a/source/Compiler.elna b/source/Compiler.elna index 61aff50..a2a5fe3 100644 --- a/source/Compiler.elna +++ b/source/Compiler.elna @@ -7,6 +7,7 @@ from M2RTS import HALT, ExitOnHalt; from Lexer import Lexer, lexer_destroy, lexer_initialize; from Transpiler import transpile; from CommandLineInterface import PCommandLine, parse_command_line; +from Parser import PAstModule, parse_module; var command_line: PCommandLine; @@ -15,6 +16,7 @@ proc compile_from_stream(); var lexer: Lexer; source_input: File; + ast_module: PAstModule; begin source_input := OpenToRead(command_line^.input); @@ -29,7 +31,8 @@ begin if IsNoError(source_input) then lexer_initialize(ADR(lexer), source_input); - transpile(ADR(lexer), StdOut, command_line^.input); + ast_module := parse_module(ADR(lexer)); + transpile(ast_module, StdOut, command_line^.input); lexer_destroy(ADR(lexer)); diff --git a/source/Lexer.elna b/source/Lexer.elna index 18f0a13..4cf6ea7 100644 --- a/source/Lexer.elna +++ b/source/Lexer.elna @@ -11,7 +11,7 @@ from MemUtils import MemCopy, MemZero; from StrCase import Lower; const - CHUNK_SIZE = 65536; + CHUNK_SIZE = 85536; type (* @@ -315,8 +315,8 @@ begin end; if lexer^.start^ = '"' then text_length := lexer^.current; - DEC(text_length, lexer^.start); - INC(text_length); + DEC(text_length, lexer^.start); + INC(text_length); MemZero(ADR(token^.stringKind), TSIZE(ShortString)); MemCopy(lexer^.start, text_length, ADR(token^.stringKind)); @@ -325,8 +325,8 @@ begin end; if lexer^.start^ = "'" then text_length := lexer^.current; - DEC(text_length, lexer^.start); - INC(text_length); + DEC(text_length, lexer^.start); + INC(text_length); MemZero(ADR(token^.stringKind), TSIZE(ShortString)); MemCopy(lexer^.start, text_length, ADR(token^.stringKind)); diff --git a/source/Parser.def b/source/Parser.def index 7c135a8..02c02d0 100644 --- a/source/Parser.def +++ b/source/Parser.def @@ -153,12 +153,12 @@ TYPE PAstTypeExpression = POINTER TO AstTypeExpression; PPAstTypeExpression = POINTER TO PAstTypeExpression; - AstTypeDeclaration = RECORD + AstTypedDeclaration = RECORD identifier: Identifier; type_expression: PAstTypeExpression END; - PAstTypeDeclaration = POINTER TO AstTypeDeclaration; - PPAstTypeDeclaration = POINTER TO PAstTypeDeclaration; + PAstTypedDeclaration = POINTER TO AstTypedDeclaration; + PPAstTypedDeclaration = POINTER TO PAstTypedDeclaration; AstVariableDeclaration = RECORD variable_name: Identifier; @@ -167,23 +167,38 @@ TYPE 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: PPAstTypeDeclaration; - variables: PPAstVariableDeclaration + types: PPAstTypedDeclaration; + variables: PPAstVariableDeclaration; + procedures: PPAstProcedureDeclaration; + statements: AstCompoundStatement END; PAstModule = POINTER TO AstModule; PROCEDURE parse_type_expression(lexer: PLexer): PAstTypeExpression; -PROCEDURE parse_type_part(lexer: PLexer): PPAstTypeDeclaration; +PROCEDURE parse_type_part(lexer: PLexer): PPAstTypedDeclaration; PROCEDURE parse_variable_part(lexer: PLexer): PPAstVariableDeclaration; PROCEDURE parse_constant_part(lexer: PLexer): PPAstConstantDeclaration; PROCEDURE parse_import_part(lexer: PLexer): PPAstImportStatement; PROCEDURE parse_designator(lexer: PLexer): PAstExpression; PROCEDURE parse_expression(lexer: PLexer): PAstExpression; -PROCEDURE parse_return_statement(lexer: PLexer): PAstStatement; -PROCEDURE parse_assignment_statement(lexer: PLexer; assignee: PAstExpression): PAstStatement; -PROCEDURE parse_call_statement(lexer: PLexer; call: PAstExpression): PAstStatement; +PROCEDURE parse_statement_part(lexer: PLexer): AstCompoundStatement; +PROCEDURE parse_procedure_part(lexer: PLexer): PPAstProcedureDeclaration; +PROCEDURE parse_module(lexer: PLexer): PAstModule; END Parser. diff --git a/source/Parser.elna b/source/Parser.elna index f32a728..03e5d0c 100644 --- a/source/Parser.elna +++ b/source/Parser.elna @@ -35,9 +35,9 @@ begin while token.kind <> lexerKindEnd do INC(field_count); - INC(field_count); - REALLOCATE(field_declarations, TSIZE(AstFieldDeclaration) * field_count); - DEC(field_count); + INC(field_count); + REALLOCATE(field_declarations, TSIZE(AstFieldDeclaration) * field_count); + DEC(field_count); current_field := field_declarations; INC(current_field , TSIZE(AstFieldDeclaration) * (field_count - 1)); @@ -109,7 +109,7 @@ begin result^.length := token.integerKind; - token := transpiler_lex(lexer); + token := transpiler_lex(lexer) end; token := transpiler_lex(lexer); result^.base := parse_type_expression(lexer); @@ -143,8 +143,8 @@ begin REALLOCATE(result^.cases, TSIZE(Identifier) * case_count); DEC(case_count); current_case := result^.cases; - INC(current_case, TSIZE(Identifier) * (case_count - 1)); - current_case^ := token.identifierKind; + INC(current_case, TSIZE(Identifier) * (case_count - 1)); + current_case^ := token.identifierKind; token := transpiler_lex(lexer) end; @@ -190,7 +190,7 @@ begin REALLOCATE(result^.parameters, TSIZE(PAstTypeExpression) * parameter_count); DEC(parameter_count); current_parameter := result^.parameters; - INC(current_parameter, TSIZE(PAstTypeExpression) * (parameter_count - 1)); + INC(current_parameter, TSIZE(PAstTypeExpression) * (parameter_count - 1)); current_parameter^ := parse_type_expression(lexer); @@ -235,10 +235,10 @@ begin return result end; -proc parse_type_declaration(lexer: PLexer) -> PAstTypeDeclaration; +proc parse_type_declaration(lexer: PLexer) -> PAstTypedDeclaration; var token: LexerToken; - result: PAstTypeDeclaration; + result: PAstTypedDeclaration; begin token := lexer_current(lexer); @@ -254,16 +254,16 @@ begin return result end; -proc parse_type_part(lexer: PLexer) -> PPAstTypeDeclaration; +proc parse_type_part(lexer: PLexer) -> PPAstTypedDeclaration; var token: LexerToken; - result: PPAstTypeDeclaration; - current_declaration: PPAstTypeDeclaration; + result: PPAstTypedDeclaration; + current_declaration: PPAstTypedDeclaration; declaration_count: CARDINAL; begin token := lexer_current(lexer); - ALLOCATE(result, TSIZE(PAstTypeDeclaration)); + ALLOCATE(result, TSIZE(PAstTypedDeclaration)); current_declaration := result; declaration_count := 0; @@ -273,16 +273,16 @@ begin while token.kind = lexerKindIdentifier do INC(declaration_count); - REALLOCATE(result, TSIZE(PAstTypeDeclaration) * (declaration_count + 1)); + REALLOCATE(result, TSIZE(PAstTypedDeclaration) * (declaration_count + 1)); current_declaration := result; - INC(current_declaration, TSIZE(PAstTypeDeclaration) * (declaration_count - 1)); + INC(current_declaration, TSIZE(PAstTypedDeclaration) * (declaration_count - 1)); current_declaration^ := parse_type_declaration(lexer); token := transpiler_lex(lexer) end end; if declaration_count <> 0 then - INC(current_declaration, TSIZE(PAstTypeDeclaration)) + INC(current_declaration, TSIZE(PAstTypedDeclaration)) end; current_declaration^ := nil; @@ -426,7 +426,7 @@ begin REALLOCATE(result^.symbols, TSIZE(Identifier) * (symbol_count + 1)); current_symbol := result^.symbols; - INC(current_symbol, TSIZE(Identifier) * (symbol_count - 1)); + INC(current_symbol, TSIZE(Identifier) * (symbol_count - 1)); current_symbol^ := token.identifierKind; token := transpiler_lex(lexer) @@ -481,18 +481,18 @@ begin NEW(literal); literal^.kind := astLiteralKindInteger; - literal^.integer := token.integerKind; + literal^.integer := token.integerKind end; if (token.kind = lexerKindCharacter) or (token.kind = lexerKindString) then NEW(literal); literal^.kind := astLiteralKindString; - literal^.string := token.stringKind; + literal^.string := token.stringKind end; if token.kind = lexerKindNull then NEW(literal); - literal^.kind := astLiteralKindNull; + literal^.kind := astLiteralKindNull end; if token.kind = lexerKindBoolean then NEW(literal); @@ -522,7 +522,7 @@ begin NEW(result); result^.kind := astExpressionKindLiteral; - result^.literal := literal; + result^.literal := literal end; if (result = nil) & (next_token.kind = lexerKindMinus) then NEW(result); @@ -549,10 +549,10 @@ begin end; if (result = nil) & (next_token.kind = lexerKindIdentifier) then NEW(result); - + result^.kind := astExpressionKindIdentifier; result^.identifier := next_token.identifierKind; - + next_token := transpiler_lex(lexer) end; @@ -658,7 +658,7 @@ begin result^.kind := astExpressionKindBinary; result^.binary_operator := operator; result^.lhs := left; - result^.rhs := right; + result^.rhs := right end; return result @@ -757,4 +757,243 @@ begin return result end; +proc parse_compound_statement(lexer: PLexer) -> AstCompoundStatement; +var + result: AstCompoundStatement; + token: LexerToken; + current_statement: PPAstStatement; + old_count: CARDINAL; +begin + result.count := 0; + result.statements := nil; + + token := lexer_current(lexer); + + while token.kind <> lexerKindEnd do + old_count := result.count; + INC(result.count); + + REALLOCATE(result.statements, TSIZE(PAstStatement) * result.count); + current_statement := result.statements; + + INC(current_statement, TSIZE(PAstStatement) * old_count); + current_statement^ := parse_statement(lexer); + + token := lexer_current(lexer) + end; + + return result +end; + +proc parse_statement(lexer: PLexer) -> PAstStatement; +var + token: LexerToken; + statement: PAstStatement; + designator: PAstExpression; +begin + statement := nil; + token := transpiler_lex(lexer); + + if token.kind = lexerKindIf then + statement := parse_if_statement(lexer) + end; + if token.kind = lexerKindWhile then + statement := parse_while_statement(lexer) + end; + if token.kind = lexerKindReturn then + statement := parse_return_statement(lexer) + end; + if token.kind = lexerKindIdentifier then + designator := parse_designator(lexer); + token := lexer_current(lexer); + + if token.kind = lexerKindAssignment then + statement := parse_assignment_statement(lexer, designator) + end; + if token.kind <> lexerKindAssignment then + statement := parse_call_statement(lexer, designator) + end + end; + return statement +end; + +proc parse_if_statement(lexer: PLexer) -> PAstStatement; +var + token: LexerToken; + result: PAstStatement; +begin + NEW(result); + result^.kind := astStatementKindIf; + + token := transpiler_lex(lexer); + result^.if_condition := parse_expression(lexer); + result^.if_branch := parse_compound_statement(lexer); + + token := transpiler_lex(lexer); + return result +end; + +proc parse_while_statement(lexer: PLexer) -> PAstStatement; +var + token: LexerToken; + result: PAstStatement; +begin + NEW(result); + result^.kind := astStatementKindWhile; + + token := transpiler_lex(lexer); + result^.while_condition := parse_expression(lexer); + result^.while_body := parse_compound_statement(lexer); + + token := transpiler_lex(lexer); + return result +end; + +proc parse_statement_part(lexer: PLexer) -> AstCompoundStatement; +var + token: LexerToken; + compound: AstCompoundStatement; +begin + compound.count := 0; + compound.statements := nil; + token := lexer_current(lexer); + + if token.kind = lexerKindBegin then + compound := parse_compound_statement(lexer) + end; + + return compound +end; + +proc parse_procedure_heading(lexer: PLexer) -> PAstProcedureDeclaration; +var + token: LexerToken; + declaration: PAstProcedureDeclaration; + parameter_index: CARDINAL; + current_parameter: PAstTypedDeclaration; +begin + NEW(declaration); + + token := transpiler_lex(lexer); + declaration^.name := token.identifierKind; + + token := transpiler_lex(lexer); + + declaration^.parameters := nil; + declaration^.parameter_count := 0; + + token := transpiler_lex(lexer); + while token.kind <> lexerKindRightParen do + parameter_index := declaration^.parameter_count; + INC(declaration^.parameter_count); + REALLOCATE(declaration^.parameters, TSIZE(AstTypedDeclaration) * declaration^.parameter_count); + + current_parameter := declaration^.parameters; + INC(current_parameter, TSIZE(AstTypedDeclaration) * parameter_index); + + current_parameter^.identifier := token.identifierKind; + + token := transpiler_lex(lexer); + token := transpiler_lex(lexer); + + current_parameter^.type_expression := parse_type_expression(lexer); + + token := transpiler_lex(lexer); + if token.kind = lexerKindComma then + token := transpiler_lex(lexer) + end + end; + token := transpiler_lex(lexer); + declaration^.return_type := nil; + + (* Check for the return type and write it. *) + if token.kind = lexerKindArrow then + token := transpiler_lex(lexer); + declaration^.return_type := parse_type_expression(lexer); + token := transpiler_lex(lexer) + end; + token := transpiler_lex(lexer); + + return declaration +end; + +proc parse_procedure_declaration(lexer: PLexer) -> PAstProcedureDeclaration; +var + token: LexerToken; + declaration: PAstProcedureDeclaration; +begin + declaration := parse_procedure_heading(lexer); + + declaration^.constants := parse_constant_part(lexer); + declaration^.variables := parse_variable_part(lexer); + declaration^.statements := parse_statement_part(lexer); + + token := transpiler_lex(lexer); + token := transpiler_lex(lexer); + + return declaration +end; + +proc parse_procedure_part(lexer: PLexer) -> PPAstProcedureDeclaration; +var + token: LexerToken; + current_declaration: PPAstProcedureDeclaration; + result: PPAstProcedureDeclaration; + declaration_count: CARDINAL; + declaration_index: CARDINAL; +begin + token := lexer_current(lexer); + declaration_count := 0; + declaration_index := 0; + + ALLOCATE(result, TSIZE(PAstProcedureDeclaration)); + + while token.kind = lexerKindProc do + INC(declaration_count); + REALLOCATE(result, TSIZE(PAstProcedureDeclaration) * (declaration_count + 1)); + current_declaration := result; + INC(current_declaration, TSIZE(PAstProcedureDeclaration) * declaration_index); + + current_declaration^ := parse_procedure_declaration(lexer); + token := lexer_current(lexer); + declaration_index := declaration_count + end; + current_declaration := result; + INC(current_declaration, TSIZE(PAstProcedureDeclaration) * declaration_index); + current_declaration^ := nil; + + return result +end; + +proc parse_module(lexer: PLexer) -> PAstModule; +var + token: LexerToken; + result: PAstModule; +begin + NEW(result); + token := transpiler_lex(lexer); + result^.main := true; + + if token.kind = lexerKindModule then + result^.main := false + end; + token := transpiler_lex(lexer); + + (* Write the module body. *) + token := transpiler_lex(lexer); + + result^.imports := parse_import_part(lexer); + result^.constants := parse_constant_part(lexer); + result^.types := parse_type_part(lexer); + + result^.variables := parse_variable_part(lexer); + result^.procedures := parse_procedure_part(lexer); + result^.statements := parse_statement_part(lexer); + + token := transpiler_lex(lexer); + token := transpiler_lex(lexer); + + return result +end; + end. diff --git a/source/Transpiler.def b/source/Transpiler.def index 22f4d69..534b206 100644 --- a/source/Transpiler.def +++ b/source/Transpiler.def @@ -4,15 +4,15 @@ 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; - lexer: PLexer + output: File END; PTranspilerContext = POINTER TO TranspilerContext; -PROCEDURE transpile(lexer: PLexer; output: File; input_name: ShortString); +PROCEDURE transpile(ast_module: PAstModule; output: File; input_name: ShortString); END Transpiler. diff --git a/source/Transpiler.elna b/source/Transpiler.elna index c63f040..ac3e987 100644 --- a/source/Transpiler.elna +++ b/source/Transpiler.elna @@ -1,6 +1,6 @@ module; -from FIO import StdErr, WriteNBytes, WriteLine, WriteChar, WriteString; +from FIO import WriteNBytes, WriteLine, WriteChar, WriteString; from SYSTEM import ADR, ADDRESS, TSIZE; from NumberIO import IntToStr; @@ -10,13 +10,11 @@ from MemUtils import MemCopy, MemZero; from Common import Identifier, PIdentifier, ShortString; from Lexer import Lexer, LexerToken, lexer_current, lexer_lex, LexerKind; from Parser import AstTypeExpressionKind, AstExpressionKind, AstLiteralKind, AstUnaryOperator, AstBinaryOperator, - AstModule, PAstModule, AstExpression, PPAstExpression, PAstExpression, PAstLiteral, - PAstConstantDeclaration, PPAstConstantDeclaration, PAstStatement, AstStatementKind, - AstTypeDeclaration, PAstTypeDeclaration, PPAstTypeDeclaration, + AstModule, PAstModule, AstExpression, PPAstExpression, PAstExpression, PAstLiteral, PPAstProcedureDeclaration, + PAstConstantDeclaration, PPAstConstantDeclaration, PPAstStatement, PAstStatement, AstStatementKind, + AstTypedDeclaration, PAstTypedDeclaration, PPAstTypedDeclaration, AstCompoundStatement, PAstProcedureDeclaration, PAstVariableDeclaration, PPAstVariableDeclaration, PAstImportStatement, PPAstImportStatement, - PAstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration, - parse_type_expression, parse_variable_part, parse_type_part, parse_constant_part, parse_import_part, - parse_designator, parse_expression, parse_return_statement, parse_assignment_statement, parse_call_statement; + PAstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration; (* Calls lexer_lex() but skips the comments. *) proc transpiler_lex(lexer: PLexer) -> LexerToken; @@ -118,15 +116,11 @@ begin end end; -proc transpile_module(context: PTranspilerContext) -> PAstModule; +proc transpile_module(context: PTranspilerContext, result: PAstModule); var token: LexerToken; - result: PAstModule; begin - NEW(result); - token := transpiler_lex(context^.lexer); - - if token.kind = lexerKindModule then + if result^.main = false then WriteString(context^.output, 'IMPLEMENTATION ') end; WriteString(context^.output, 'MODULE '); @@ -134,37 +128,23 @@ begin (* Write the module name and end the line with a semicolon and newline. *) transpile_module_name(context); - token := transpiler_lex(context^.lexer); write_semicolon(context^.output); WriteLine(context^.output); (* Write the module body. *) - token := transpiler_lex(context^.lexer); - result^.imports := parse_import_part(context^.lexer); transpile_import_part(context, result^.imports); - - result^.constants := parse_constant_part(context^.lexer); transpile_constant_part(context, result^.constants); - result^.types := parse_type_part(context^.lexer); transpile_type_part(context, result^.types); - - result^.variables := parse_variable_part(context^.lexer); transpile_variable_part(context, result^.variables); - - transpile_procedure_part(context); - transpile_statement_part(context); + transpile_procedure_part(context, result^.procedures); + transpile_statement_part(context, result^.statements); WriteString(context^.output, 'END '); transpile_module_name(context); - token := transpiler_lex(context^.lexer); WriteChar(context^.output, '.'); - - token := transpiler_lex(context^.lexer); - WriteLine(context^.output); - - return result + WriteLine(context^.output) end; proc transpile_type_fields(context: PTranspilerContext, fields: PAstFieldDeclaration); @@ -217,7 +197,7 @@ begin WriteString(context^.output, '[1..'); IntToStr(type_expression^.length, 0, buffer); - WriteString(context^.output, buffer); + WriteString(context^.output, buffer); WriteChar(context^.output, ']') end; @@ -270,7 +250,7 @@ begin while current_parameter^ <> nil do transpile_type_expression(context, current_parameter^); - INC(current_parameter, TSIZE(PAstTypeExpression)); + INC(current_parameter, TSIZE(PAstTypeExpression)); if current_parameter^ <> nil then WriteString(context^.output, ', ') @@ -301,7 +281,7 @@ begin end end; -proc transpile_type_declaration(context: PTranspilerContext, declaration: PAstTypeDeclaration); +proc transpile_type_declaration(context: PTranspilerContext, declaration: PAstTypedDeclaration); var written_bytes: CARDINAL; begin @@ -314,9 +294,9 @@ begin write_semicolon(context^.output) end; -proc transpile_type_part(context: PTranspilerContext, declarations: PPAstTypeDeclaration); +proc transpile_type_part(context: PTranspilerContext, declarations: PPAstTypedDeclaration); var - current_declaration: PPAstTypeDeclaration; + current_declaration: PPAstTypedDeclaration; begin if declarations^ <> nil then WriteString(context^.output, 'TYPE'); @@ -326,7 +306,7 @@ begin while current_declaration^ <> nil do transpile_type_declaration(context, current_declaration^); - INC(current_declaration, TSIZE(PAstTypeDeclaration)) + INC(current_declaration, TSIZE(PAstTypedDeclaration)) end; WriteLine(context^.output) end @@ -363,51 +343,41 @@ begin end end; -proc transpile_procedure_heading(context: PTranspilerContext) -> LexerToken; +proc transpile_procedure_heading(context: PTranspilerContext, declaration: PAstProcedureDeclaration); var token: LexerToken; - result: LexerToken; - type_expression: PAstTypeExpression; + written_bytes: CARDINAL; + parameter_index: CARDINAL; + current_parameter: PAstTypedDeclaration; begin WriteString(context^.output, 'PROCEDURE '); - - result := transpiler_lex(context^.lexer); - write_current(context^.lexer, context^.output); - - token := transpiler_lex(context^.lexer); + written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2])); WriteChar(context^.output, '('); - token := transpiler_lex(context^.lexer); - while token.kind <> lexerKindRightParen do - write_current(context^.lexer, context^.output); + parameter_index := 0; + current_parameter := declaration^.parameters; - token := transpiler_lex(context^.lexer); + while parameter_index < declaration^.parameter_count do + written_bytes := WriteNBytes(context^.output, ORD(current_parameter^.identifier[1]), ADR(current_parameter^.identifier[2])); WriteString(context^.output, ': '); - token := transpiler_lex(context^.lexer); + transpile_type_expression(context, current_parameter^.type_expression); - type_expression := parse_type_expression(context^.lexer); - transpile_type_expression(context, type_expression); + INC(parameter_index); + INC(current_parameter, TSIZE(AstTypedDeclaration)); - token := transpiler_lex(context^.lexer); - if (token.kind = lexerKindSemicolon) or (token.kind = lexerKindComma) then - WriteString(context^.output, '; '); - token := transpiler_lex(context^.lexer) + if parameter_index <> declaration^.parameter_count then + WriteString(context^.output, '; ') end end; + WriteString(context^.output, ')'); - token := transpiler_lex(context^.lexer); (* Check for the return type and write it. *) - if token.kind = lexerKindArrow then + if declaration^.return_type <> nil then WriteString(context^.output, ': '); - token := transpiler_lex(context^.lexer); - write_current(context^.lexer, context^.output); - token := transpiler_lex(context^.lexer) + transpile_type_expression(context, declaration^.return_type) end; - token := transpiler_lex(context^.lexer); - write_semicolon(context^.output); - - return result + write_semicolon(context^.output) end; proc transpile_unary_operator(context: PTranspilerContext, operator: AstUnaryOperator); @@ -470,20 +440,20 @@ begin if literal^.kind = astLiteralKindInteger then IntToStr(literal^.integer, 0, buffer); - WriteString(context^.output, buffer); + WriteString(context^.output, buffer) end; if literal^.kind = astLiteralKindString then WriteString(context^.output, literal^.string) end; - if literal^.kind = astLiteralKindNull then + if literal^.kind = astLiteralKindNull then WriteString(context^.output, 'NIL') end; if (literal^.kind = astLiteralKindBoolean) & literal^.boolean then WriteString(context^.output, 'TRUE') - end; + end; if (literal^.kind = astLiteralKindBoolean) & (literal^.boolean = false) then WriteString(context^.output, 'FALSE') - end + end end; if expression^.kind = astExpressionKindIdentifier then written_bytes := WriteNBytes(context^.output, ORD(expression^.identifier[1]), ADR(expression^.identifier[2])) @@ -501,7 +471,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]), ADR(expression^.field[2])) end; if expression^.kind = astExpressionKindUnary then transpile_unary_operator(context, expression^.unary_operator); @@ -540,52 +510,34 @@ begin end end; -proc transpile_if_statement(context: PTranspilerContext) -> PAstStatement; +proc transpile_if_statement(context: PTranspilerContext, statement: PAstStatement); var token: LexerToken; - result: PAstStatement; begin - NEW(result); - result^.kind := astStatementKindIf; - WriteString(context^.output, ' IF '); + if statement <> nil then + WriteString(context^.output, ' IF '); + transpile_expression(context, statement^.if_condition); - token := transpiler_lex(context^.lexer); - result^.if_condition := parse_expression(context^.lexer); + WriteString(context^.output, ' THEN'); + WriteLine(context^.output); - transpile_expression(context, result^.if_condition); - token := lexer_current(context^.lexer); - - WriteString(context^.output, ' THEN'); - WriteLine(context^.output); - transpile_statements(context); - WriteString(context^.output, ' END'); - token := transpiler_lex(context^.lexer); - - return result + transpile_compound_statement(context, statement^.if_branch); + WriteString(context^.output, ' END') + end end; -proc transpile_while_statement(context: PTranspilerContext) -> PAstStatement; +proc transpile_while_statement(context: PTranspilerContext, statement: PAstStatement); var token: LexerToken; - result: PAstStatement; begin - NEW(result); - result^.kind := astStatementKindWhile; WriteString(context^.output, ' WHILE '); - - token := transpiler_lex(context^.lexer); - result^.while_condition := parse_expression(context^.lexer); - - transpile_expression(context, result^.while_condition); - token := lexer_current(context^.lexer); + transpile_expression(context, statement^.while_condition); WriteString(context^.output, ' DO'); WriteLine(context^.output); - transpile_statements(context); - WriteString(context^.output, ' END'); - token := transpiler_lex(context^.lexer); - return result + transpile_compound_statement(context, statement^.while_body); + WriteString(context^.output, ' END') end; proc transpile_assignment_statement(context: PTranspilerContext, statement: PAstStatement); @@ -599,108 +551,81 @@ proc transpile_return_statement(context: PTranspilerContext, statement: PAstStat begin WriteString(context^.output, ' RETURN '); - transpile_expression(context, statement^.returned); + transpile_expression(context, statement^.returned) end; -proc transpile_statement(context: PTranspilerContext); +proc transpile_compound_statement(context: PTranspilerContext, statement: AstCompoundStatement); var - token: LexerToken; - written_bytes: CARDINAL; - statement: PAstStatement; - designator: PAstExpression; + current_statement: PPAstStatement; + index: CARDINAL; begin - token := transpiler_lex(context^.lexer); + index := 0; + current_statement := statement.statements; - if token.kind = lexerKindIf then - statement := transpile_if_statement(context) - end; - if token.kind = lexerKindWhile then - statement := transpile_while_statement(context) - end; - if token.kind = lexerKindReturn then - statement := parse_return_statement(context^.lexer); - transpile_return_statement(context, statement) - end; - if token.kind = lexerKindIdentifier then - designator := parse_designator(context^.lexer); - token := lexer_current(context^.lexer); + while index < statement.count do + transpile_statement(context, current_statement^); - if token.kind = lexerKindAssignment then - statement := parse_assignment_statement(context^.lexer, designator); - transpile_assignment_statement(context, statement) - end; - if token.kind <> lexerKindAssignment then - statement := parse_call_statement(context^.lexer, designator); - transpile_expression(context, designator); + INC(current_statement, TSIZE(PAstStatement)); + INC(index); - written_bytes := WriteNBytes(StdErr, 5, context^.lexer^.start); - WriteLine(StdErr); - end - end -end; - -proc transpile_statements(context: PTranspilerContext); -var - token: LexerToken; -begin - token := lexer_current(context^.lexer); - - while token.kind <> lexerKindEnd do - transpile_statement(context); - token := lexer_current(context^.lexer); - - if token.kind = lexerKindSemicolon then + if index <> statement.count then WriteChar(context^.output, ';') end; WriteLine(context^.output) end end; -proc transpile_statement_part(context: PTranspilerContext); -var - token: LexerToken; +proc transpile_statement(context: PTranspilerContext, statement: PAstStatement); begin - token := lexer_current(context^.lexer); - if token.kind = lexerKindBegin then - WriteString(context^.output, 'BEGIN'); - WriteLine(context^.output); - transpile_statements(context) + if statement^.kind = astStatementKindIf then + transpile_if_statement(context, statement) + end; + if statement^.kind = astStatementKindWhile then + transpile_while_statement(context, statement) + end; + if statement^.kind = astStatementKindReturn then + transpile_return_statement(context, statement) + end; + if statement^.kind = astStatementKindAssignment then + transpile_assignment_statement(context, statement) + end; + if statement^.kind = astStatementKindCall then + transpile_expression(context, statement^.call) end end; -proc transpile_procedure_declaration(context: PTranspilerContext); -var - token: LexerToken; - seen_variables: PPAstVariableDeclaration; - written_bytes: CARDINAL; - seen_constants: PPAstConstantDeclaration; +proc transpile_statement_part(context: PTranspilerContext, compound: AstCompoundStatement); begin - token := transpile_procedure_heading(context); - seen_constants := parse_constant_part(context^.lexer); - transpile_constant_part(context, seen_constants); - - seen_variables := parse_variable_part(context^.lexer); - transpile_variable_part(context, seen_variables); - transpile_statement_part(context); - - WriteString(context^.output, 'END '); - written_bytes := WriteNBytes(context^.output, ORD(token.identifierKind[1]), ADR(token.identifierKind[2])); - - token := transpiler_lex(context^.lexer); - write_semicolon(context^.output); - token := transpiler_lex(context^.lexer) + if compound.count > 0 then + WriteString(context^.output, 'BEGIN'); + WriteLine(context^.output); + transpile_compound_statement(context, compound) + end end; -proc transpile_procedure_part(context: PTranspilerContext); +proc transpile_procedure_declaration(context: PTranspilerContext, declaration: PAstProcedureDeclaration); var - token: LexerToken; + written_bytes: CARDINAL; begin - token := lexer_current(context^.lexer); + transpile_procedure_heading(context, declaration); - while token.kind = lexerKindProc do - transpile_procedure_declaration(context); - token := lexer_current(context^.lexer); - WriteLine(context^.output) + transpile_constant_part(context, declaration^.constants); + transpile_variable_part(context, declaration^.variables); + transpile_statement_part(context, declaration^.statements); + + WriteString(context^.output, 'END '); + written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2])); + + write_semicolon(context^.output) +end; + +proc transpile_procedure_part(context: PTranspilerContext, declaration: PPAstProcedureDeclaration); +begin + while declaration^ <> nil do + transpile_procedure_declaration(context, declaration^); + WriteLine(context^.output); + + INC(declaration, TSIZE(PAstProcedureDeclaration)) end end; @@ -716,7 +641,7 @@ begin if context^.input_name[counter] = '/' then last_slash := counter end; - INC(counter) + INC(counter) end; if last_slash = 0 then @@ -727,21 +652,18 @@ begin end; while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do WriteChar(context^.output, context^.input_name[counter]); - INC(counter) - end; + INC(counter) + end end; -proc transpile(lexer: PLexer, output: File, input_name: ShortString); +proc transpile(ast_module: PAstModule, output: File, input_name: ShortString); var - token: LexerToken; context: TranspilerContext; - ast_module: PAstModule; begin context.input_name := input_name; context.output := output; - context.lexer := lexer; - ast_module := transpile_module(ADR(context)) + transpile_module(ADR(context), ast_module) end; end.