From 90aa5a0030bb51709ea2362113e512b3d0854a3c Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 11 Jun 2025 22:36:05 +0200 Subject: [PATCH] Split the parser from the code generator --- source/Compiler.mod | 5 +- source/Lexer.mod | 10 +- source/Parser.def | 33 +++-- source/Parser.mod | 278 +++++++++++++++++++++++++++++++++++++---- source/Transpiler.def | 6 +- source/Transpiler.mod | 282 +++++++++++++++--------------------------- 6 files changed, 392 insertions(+), 222 deletions(-) diff --git a/source/Compiler.mod b/source/Compiler.mod index 61c7cfc..ec37cb6 100644 --- a/source/Compiler.mod +++ b/source/Compiler.mod @@ -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 @@ PROCEDURE 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.mod b/source/Lexer.mod index 7000ebe..a9ef958 100644 --- a/source/Lexer.mod +++ b/source/Lexer.mod @@ -11,7 +11,7 @@ FROM MemUtils IMPORT MemCopy, MemZero; FROM StrCase IMPORT Lower; CONST - CHUNK_SIZE = 65536; + CHUNK_SIZE = 85536; TYPE (* @@ -308,8 +308,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)); @@ -318,8 +318,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.mod b/source/Parser.mod index df2fcbc..34d2298 100644 --- a/source/Parser.mod +++ b/source/Parser.mod @@ -34,9 +34,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)); @@ -105,7 +105,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); @@ -138,8 +138,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; @@ -183,7 +183,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); @@ -226,10 +226,10 @@ BEGIN END; RETURN result END parse_type_expression; -PROCEDURE parse_type_declaration(lexer: PLexer): PAstTypeDeclaration; +PROCEDURE parse_type_declaration(lexer: PLexer): PAstTypedDeclaration; VAR token: LexerToken; - result: PAstTypeDeclaration; + result: PAstTypedDeclaration; BEGIN token := lexer_current(lexer); @@ -244,16 +244,16 @@ BEGIN RETURN result END parse_type_declaration; -PROCEDURE parse_type_part(lexer: PLexer): PPAstTypeDeclaration; +PROCEDURE 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; @@ -263,16 +263,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; @@ -411,7 +411,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) @@ -464,18 +464,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); @@ -504,7 +504,7 @@ BEGIN NEW(result); result^.kind := astExpressionKindLiteral; - result^.literal := literal; + result^.literal := literal END; IF (result = NIL) AND (next_token.kind = lexerKindMinus) THEN NEW(result); @@ -531,10 +531,10 @@ BEGIN END; IF (result = NIL) AND (next_token.kind = lexerKindIdentifier) THEN NEW(result); - + result^.kind := astExpressionKindIdentifier; result^.identifier := next_token.identifierKind; - + next_token := transpiler_lex(lexer) END; @@ -638,7 +638,7 @@ BEGIN result^.kind := astExpressionKindBinary; result^.binary_operator := operator; result^.lhs := left; - result^.rhs := right; + result^.rhs := right END; RETURN result @@ -732,4 +732,234 @@ BEGIN RETURN result END parse_call_statement; +PROCEDURE 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 parse_compound_statement; +PROCEDURE 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 parse_statement; +PROCEDURE 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 parse_if_statement; +PROCEDURE 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 parse_while_statement; +PROCEDURE 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 parse_statement_part; +PROCEDURE 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 parse_procedure_heading; +PROCEDURE 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 parse_procedure_declaration; +PROCEDURE 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 parse_procedure_part; +PROCEDURE 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 parse_module; END Parser. 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.mod b/source/Transpiler.mod index cc382dc..fd356ee 100644 --- a/source/Transpiler.mod +++ b/source/Transpiler.mod @@ -1,6 +1,6 @@ IMPLEMENTATION MODULE Transpiler; -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. *) PROCEDURE transpiler_lex(lexer: PLexer): LexerToken; @@ -111,15 +109,11 @@ BEGIN WriteLine(context^.output) END END transpile_constant_part; -PROCEDURE transpile_module(context: PTranspilerContext): PAstModule; +PROCEDURE 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 '); @@ -127,37 +121,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 transpile_module; PROCEDURE transpile_type_fields(context: PTranspilerContext; fields: PAstFieldDeclaration); VAR @@ -206,7 +186,7 @@ BEGIN WriteString(context^.output, '[1..'); IntToStr(type_expression^.length, 0, buffer); - WriteString(context^.output, buffer); + WriteString(context^.output, buffer); WriteChar(context^.output, ']') END; @@ -256,7 +236,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, ', ') @@ -285,7 +265,7 @@ BEGIN transpile_named_type(context, type_expression) END END transpile_type_expression; -PROCEDURE transpile_type_declaration(context: PTranspilerContext; declaration: PAstTypeDeclaration); +PROCEDURE transpile_type_declaration(context: PTranspilerContext; declaration: PAstTypedDeclaration); VAR written_bytes: CARDINAL; BEGIN @@ -297,9 +277,9 @@ BEGIN transpile_type_expression(context, declaration^.type_expression); write_semicolon(context^.output) END transpile_type_declaration; -PROCEDURE transpile_type_part(context: PTranspilerContext; declarations: PPAstTypeDeclaration); +PROCEDURE transpile_type_part(context: PTranspilerContext; declarations: PPAstTypedDeclaration); VAR - current_declaration: PPAstTypeDeclaration; + current_declaration: PPAstTypedDeclaration; BEGIN IF declarations^ <> NIL THEN WriteString(context^.output, 'TYPE'); @@ -309,7 +289,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 @@ -343,51 +323,41 @@ BEGIN WriteLine(context^.output) END END transpile_variable_part; -PROCEDURE transpile_procedure_heading(context: PTranspilerContext): LexerToken; +PROCEDURE 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 transpile_procedure_heading; PROCEDURE transpile_unary_operator(context: PTranspilerContext; operator: AstUnaryOperator); BEGIN @@ -447,20 +417,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) AND literal^.boolean THEN WriteString(context^.output, 'TRUE') - END; + END; IF (literal^.kind = astLiteralKindBoolean) AND (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])) @@ -478,7 +448,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); @@ -516,51 +486,33 @@ BEGIN WriteChar(context^.output, ')') END END transpile_expression; -PROCEDURE transpile_if_statement(context: PTranspilerContext): PAstStatement; +PROCEDURE 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 transpile_if_statement; -PROCEDURE transpile_while_statement(context: PTranspilerContext): PAstStatement; +PROCEDURE 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 transpile_while_statement; PROCEDURE transpile_assignment_statement(context: PTranspilerContext; statement: PAstStatement); BEGIN @@ -572,103 +524,76 @@ PROCEDURE transpile_return_statement(context: PTranspilerContext; statement: PAs BEGIN WriteString(context^.output, ' RETURN '); - transpile_expression(context, statement^.returned); + transpile_expression(context, statement^.returned) END transpile_return_statement; -PROCEDURE transpile_statement(context: PTranspilerContext); +PROCEDURE 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 transpile_statement; -PROCEDURE 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 transpile_statements; -PROCEDURE transpile_statement_part(context: PTranspilerContext); -VAR - token: LexerToken; +END transpile_compound_statement; +PROCEDURE transpile_statement(context: PTranspilerContext; statement: PAstStatement); BEGIN - token := lexer_current(context^.lexer); - IF token.kind = lexerKindBegin THEN + 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 transpile_statement; +PROCEDURE transpile_statement_part(context: PTranspilerContext; compound: AstCompoundStatement); +BEGIN + IF compound.count > 0 THEN WriteString(context^.output, 'BEGIN'); WriteLine(context^.output); - transpile_statements(context) + transpile_compound_statement(context, compound) END END transpile_statement_part; -PROCEDURE transpile_procedure_declaration(context: PTranspilerContext); +PROCEDURE transpile_procedure_declaration(context: PTranspilerContext; declaration: PAstProcedureDeclaration); VAR - token: LexerToken; - seen_variables: PPAstVariableDeclaration; written_bytes: CARDINAL; - seen_constants: PPAstConstantDeclaration; BEGIN - token := transpile_procedure_heading(context); - seen_constants := parse_constant_part(context^.lexer); - transpile_constant_part(context, seen_constants); + transpile_procedure_heading(context, declaration); - seen_variables := parse_variable_part(context^.lexer); - transpile_variable_part(context, seen_variables); - transpile_statement_part(context); + 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(token.identifierKind[1]), ADR(token.identifierKind[2])); + written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2])); - token := transpiler_lex(context^.lexer); - write_semicolon(context^.output); - token := transpiler_lex(context^.lexer) + write_semicolon(context^.output) END transpile_procedure_declaration; -PROCEDURE transpile_procedure_part(context: PTranspilerContext); -VAR - token: LexerToken; +PROCEDURE transpile_procedure_part(context: PTranspilerContext; declaration: PPAstProcedureDeclaration); BEGIN - token := lexer_current(context^.lexer); + WHILE declaration^ <> NIL DO + transpile_procedure_declaration(context, declaration^); + WriteLine(context^.output); - WHILE token.kind = lexerKindProc DO - transpile_procedure_declaration(context); - token := lexer_current(context^.lexer); - WriteLine(context^.output) + INC(declaration, TSIZE(PAstProcedureDeclaration)) END END transpile_procedure_part; PROCEDURE transpile_module_name(context: PTranspilerContext); @@ -683,7 +608,7 @@ BEGIN IF context^.input_name[counter] = '/' THEN last_slash := counter END; - INC(counter) + INC(counter) END; IF last_slash = 0 THEN @@ -694,19 +619,16 @@ BEGIN END; WHILE (context^.input_name[counter] <> '.') AND (ORD(context^.input_name[counter]) <> 0) DO WriteChar(context^.output, context^.input_name[counter]); - INC(counter) - END; + INC(counter) + END END transpile_module_name; -PROCEDURE transpile(lexer: PLexer; output: File; input_name: ShortString); +PROCEDURE 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 transpile; END Transpiler.