From ff547a295deedff9b7dbf8a6b6a6e235e2c48388 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Tue, 3 Jun 2025 12:14:25 +0200 Subject: [PATCH] Don't require the module name after end --- source/CommandLineInterface.mod | 2 +- source/Common.def | 2 +- source/Compiler.mod | 2 +- source/Parser.def | 5 + source/Parser.mod | 272 ++++++++++++++++++++++++++++ source/Transpiler.def | 5 +- source/Transpiler.mod | 307 ++++++++++---------------------- 7 files changed, 378 insertions(+), 217 deletions(-) diff --git a/source/CommandLineInterface.mod b/source/CommandLineInterface.mod index 2b33668..f22cf2b 100644 --- a/source/CommandLineInterface.mod +++ b/source/CommandLineInterface.mod @@ -35,7 +35,7 @@ BEGIN parsed := TRUE; result^.parse := TRUE END; - IF parameter[0] <> '-' THEN + IF parameter[1] <> '-' THEN parsed := TRUE; IF Length(result^.input) > 0 THEN diff --git a/source/Common.def b/source/Common.def index c6f661d..996a971 100644 --- a/source/Common.def +++ b/source/Common.def @@ -1,7 +1,7 @@ DEFINITION MODULE Common; TYPE - ShortString = ARRAY[0..255] OF CHAR; + ShortString = ARRAY[1..256] OF CHAR; Identifier = ARRAY[1..256] OF CHAR; PIdentifier = POINTER TO Identifier; diff --git a/source/Compiler.mod b/source/Compiler.mod index ed197f6..61c7cfc 100644 --- a/source/Compiler.mod +++ b/source/Compiler.mod @@ -29,7 +29,7 @@ BEGIN IF IsNoError(source_input) THEN lexer_initialize(ADR(lexer), source_input); - transpile(ADR(lexer), StdOut); + transpile(ADR(lexer), StdOut, command_line^.input); lexer_destroy(ADR(lexer)); diff --git a/source/Parser.def b/source/Parser.def index f968125..3fcec3f 100644 --- a/source/Parser.def +++ b/source/Parser.def @@ -1,6 +1,7 @@ DEFINITION MODULE Parser; FROM Common IMPORT Identifier, PIdentifier; +FROM Lexer IMPORT PLexer; TYPE AstConstantDeclaration = RECORD @@ -56,4 +57,8 @@ TYPE END; PAstModule = POINTER TO AstModule; +PROCEDURE parse_type_expression(lexer: PLexer): PAstTypeExpression; +PROCEDURE parse_type_declaration(lexer: PLexer): PAstTypeDeclaration; +PROCEDURE parse_type_part(lexer: PLexer): PPAstTypeDeclaration; + END Parser. diff --git a/source/Parser.mod b/source/Parser.mod index e40cc4a..333085f 100644 --- a/source/Parser.mod +++ b/source/Parser.mod @@ -1,3 +1,275 @@ IMPLEMENTATION MODULE Parser; +FROM SYSTEM IMPORT TSIZE; + +FROM MemUtils IMPORT MemZero; +FROM Storage IMPORT ALLOCATE, REALLOCATE; + +FROM Lexer IMPORT LexerKind, LexerToken, lexer_current, lexer_lex; + +(* Calls lexer_lex() but skips the comments. *) +PROCEDURE transpiler_lex(lexer: PLexer): LexerToken; +VAR + result: LexerToken; +BEGIN + result := lexer_lex(lexer); + + WHILE result.kind = lexerKindComment DO + result := lexer_lex(lexer) + END; + + RETURN result +END transpiler_lex; +PROCEDURE parse_type_fields(lexer: PLexer): PAstFieldDeclaration; +VAR + token: LexerToken; + field_declarations: PAstFieldDeclaration; + field_count: CARDINAL; + current_field: PAstFieldDeclaration; +BEGIN + ALLOCATE(field_declarations, TSIZE(AstFieldDeclaration)); + token := transpiler_lex(lexer); + field_count := 0; + + WHILE token.kind <> lexerKindEnd DO + INC(field_count); + REALLOCATE(field_declarations, TSIZE(AstFieldDeclaration) * (field_count + 1)); + current_field := field_declarations; + INC(current_field , TSIZE(AstFieldDeclaration) * (field_count - 1)); + + token := transpiler_lex(lexer); + + current_field^.field_name := token.identifierKind; + + token := transpiler_lex(lexer); + current_field^.field_type := parse_type_expression(lexer); + token := transpiler_lex(lexer); + + IF token.kind = lexerKindSemicolon THEN + token := transpiler_lex(lexer) + END + END; + INC(current_field, TSIZE(AstFieldDeclaration)); + MemZero(current_field, TSIZE(AstFieldDeclaration)); + + RETURN field_declarations +END parse_type_fields; +PROCEDURE parse_record_type(lexer: PLexer): PAstTypeExpression; +VAR + result: PAstTypeExpression; +BEGIN + ALLOCATE(result, TSIZE(AstTypeExpression)); + result^.kind := astTypeExpressionKindRecord; + result^.fields := parse_type_fields(lexer); + + RETURN result +END parse_record_type; +PROCEDURE parse_pointer_type(lexer: PLexer): PAstTypeExpression; +VAR + token: LexerToken; + result: PAstTypeExpression; +BEGIN + ALLOCATE(result, TSIZE(AstTypeExpression)); + result^.kind := astTypeExpressionKindPointer; + + token := lexer_current(lexer); + + IF token.kind = lexerKindPointer THEN + token := transpiler_lex(lexer) + END; + token := lexer_current(lexer); + result^.target := parse_type_expression(lexer); + + RETURN result +END parse_pointer_type; +PROCEDURE parse_array_type(lexer: PLexer): PAstTypeExpression; +VAR + token: LexerToken; + buffer: ARRAY[1..20] OF CHAR; + result: PAstTypeExpression; +BEGIN + ALLOCATE(result, TSIZE(AstTypeExpression)); + result^.kind := astTypeExpressionKindArray; + result^.length := 0; + + token := lexer_current(lexer); + + IF token.kind = lexerKindArray THEN + token := transpiler_lex(lexer) + END; + IF token.kind <> lexerKindOf THEN + token := transpiler_lex(lexer); + + result^.length := token.integerKind; + + token := transpiler_lex(lexer); + END; + token := transpiler_lex(lexer); + result^.base := parse_type_expression(lexer); + + RETURN result +END parse_array_type; +PROCEDURE parse_enumeration_type(lexer: PLexer): PAstTypeExpression; +VAR + token: LexerToken; + result: PAstTypeExpression; + current_case: PIdentifier; + case_count: CARDINAL; +BEGIN + ALLOCATE(result, TSIZE(AstTypeExpression)); + result^.kind := astTypeExpressionKindEnumeration; + + case_count := 1; + ALLOCATE(result^.cases, TSIZE(Identifier) * 2); + token := transpiler_lex(lexer); + current_case := result^.cases; + current_case^ := token.identifierKind; + + token := transpiler_lex(lexer); + + WHILE token.kind = lexerKindComma DO + token := transpiler_lex(lexer); + + INC(case_count); + REALLOCATE(result^.cases, TSIZE(Identifier) * (case_count + 1)); + current_case := result^.cases; + INC(current_case, TSIZE(Identifier) * (case_count - 1)); + current_case^ := token.identifierKind; + + token := transpiler_lex(lexer) + END; + INC(current_case, TSIZE(Identifier)); + MemZero(current_case, TSIZE(Identifier)); + + RETURN result +END parse_enumeration_type; +PROCEDURE parse_named_type(lexer: PLexer): PAstTypeExpression; +VAR + token: LexerToken; + result: PAstTypeExpression; + written_bytes: CARDINAL; +BEGIN + token := lexer_current(lexer); + ALLOCATE(result, TSIZE(AstTypeExpression)); + + result^.kind := astTypeExpressionKindNamed; + result^.name := token.identifierKind; + + RETURN result +END parse_named_type; +PROCEDURE parse_procedure_type(lexer: PLexer): PAstTypeExpression; +VAR + token: LexerToken; + result: PAstTypeExpression; + current_parameter: PPAstTypeExpression; + parameter_count: CARDINAL; +BEGIN + parameter_count := 0; + ALLOCATE(result, TSIZE(AstTypeExpression)); + result^.kind := astTypeExpressionKindProcedure; + + ALLOCATE(result^.parameters, 1); + + token := transpiler_lex(lexer); + token := transpiler_lex(lexer); + + WHILE token.kind <> lexerKindRightParen DO + INC(parameter_count); + REALLOCATE(result^.parameters, TSIZE(PAstTypeExpression) * (parameter_count + 1)); + current_parameter := result^.parameters; + INC(current_parameter, TSIZE(PAstTypeExpression) * (parameter_count - 1)); + + current_parameter^ := parse_type_expression(lexer); + + token := transpiler_lex(lexer); + IF token.kind = lexerKindComma THEN + token := transpiler_lex(lexer) + END + END; + current_parameter := result^.parameters; + INC(current_parameter, TSIZE(PAstTypeExpression) * parameter_count); + current_parameter^ := NIL; + + RETURN result +END parse_procedure_type; +PROCEDURE parse_type_expression(lexer: PLexer): PAstTypeExpression; +VAR + token: LexerToken; + result: PAstTypeExpression; +BEGIN + result := NIL; + token := lexer_current(lexer); + + IF token.kind = lexerKindRecord THEN + result := parse_record_type(lexer) + END; + IF token.kind = lexerKindLeftParen THEN + result := parse_enumeration_type(lexer) + END; + IF (token.kind = lexerKindArray) OR (token.kind = lexerKindLeftSquare) THEN + result := parse_array_type(lexer) + END; + IF token.kind = lexerKindHat THEN + result := parse_pointer_type(lexer) + END; + IF token.kind = lexerKindProc THEN + result := parse_procedure_type(lexer) + END; + IF token.kind = lexerKindIdentifier THEN + result := parse_named_type(lexer) + END; + RETURN result +END parse_type_expression; +PROCEDURE parse_type_declaration(lexer: PLexer): PAstTypeDeclaration; +VAR + token: LexerToken; + result: PAstTypeDeclaration; +BEGIN + token := lexer_current(lexer); + + ALLOCATE(result, TSIZE(AstTypeDeclaration)); + result^.identifier := token.identifierKind; + + token := transpiler_lex(lexer); + token := transpiler_lex(lexer); + + result^.type_expression := parse_type_expression(lexer); + token := transpiler_lex(lexer); + + RETURN result +END parse_type_declaration; +PROCEDURE parse_type_part(lexer: PLexer): PPAstTypeDeclaration; +VAR + token: LexerToken; + result: PPAstTypeDeclaration; + current_declaration: PPAstTypeDeclaration; + declaration_count: CARDINAL; +BEGIN + token := lexer_current(lexer); + + ALLOCATE(result, TSIZE(PAstTypeDeclaration)); + current_declaration := result; + declaration_count := 0; + + IF token.kind = lexerKindType THEN + token := transpiler_lex(lexer); + + WHILE token.kind = lexerKindIdentifier DO + INC(declaration_count); + + REALLOCATE(result, TSIZE(PAstTypeDeclaration) * (declaration_count + 1)); + current_declaration := result; + INC(current_declaration, TSIZE(PAstTypeDeclaration) * (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)) + END; + current_declaration^ := NIL; + + RETURN result +END parse_type_part; END Parser. diff --git a/source/Transpiler.def b/source/Transpiler.def index 555a960..22f4d69 100644 --- a/source/Transpiler.def +++ b/source/Transpiler.def @@ -2,16 +2,17 @@ DEFINITION MODULE Transpiler; FROM FIO IMPORT File; +FROM Common IMPORT ShortString; FROM Lexer IMPORT PLexer, Lexer; TYPE TranspilerContext = RECORD - indentation: CARDINAL; + input_name: ShortString; output: File; lexer: PLexer END; PTranspilerContext = POINTER TO TranspilerContext; -PROCEDURE transpile(lexer: PLexer; output: File); +PROCEDURE transpile(lexer: PLexer; output: File; input_name: ShortString); END Transpiler. diff --git a/source/Transpiler.mod b/source/Transpiler.mod index 2f3dfea..9817250 100644 --- a/source/Transpiler.mod +++ b/source/Transpiler.mod @@ -7,13 +7,14 @@ FROM NumberIO IMPORT IntToStr; FROM Storage IMPORT ALLOCATE, REALLOCATE; FROM MemUtils IMPORT MemCopy, MemZero; -FROM Common IMPORT Identifier, PIdentifier; +FROM Common IMPORT Identifier, PIdentifier, ShortString; FROM Lexer IMPORT Lexer, LexerToken, lexer_current, lexer_lex, LexerKind; FROM Parser IMPORT AstModule, PAstModule, AstTypeExpressionKind, AstConstantDeclaration, PPAstConstantDeclaration, AstTypeDeclaration, PAstTypeDeclaration, PPAstTypeDeclaration, AstVariableDeclaration, PPAstVariableDeclaration, - PAstTypeExpression, AstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration; + PAstTypeExpression, AstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration, + parse_type_expression, parse_type_declaration, parse_type_part; (* Calls lexer_lex() but skips the comments. *) PROCEDURE transpiler_lex(lexer: PLexer): LexerToken; @@ -131,7 +132,7 @@ BEGIN (* Write the module name and end the line with a semicolon and newline. *) token := transpiler_lex(context^.lexer); - write_current(context^.lexer, context^.output); + transpile_module_name(context); token := transpiler_lex(context^.lexer); write_semicolon(context^.output); @@ -142,16 +143,15 @@ BEGIN transpile_import_part(context); result^.constants := transpile_constant_part(context); - result^.types := transpile_type_part(context); + result^.types := parse_type_part(context^.lexer); + transpile_type_part(context, result^.types); result^.variables := transpile_variable_part(context); transpile_procedure_part(context); transpile_statement_part(context); WriteString(context^.output, 'END '); - - token := transpiler_lex(context^.lexer); - write_current(context^.lexer, context^.output); + transpile_module_name(context); token := transpiler_lex(context^.lexer); WriteChar(context^.output, '.'); @@ -161,144 +161,67 @@ BEGIN RETURN result END transpile_module; -PROCEDURE transpile_type_fields(context: PTranspilerContext): PAstFieldDeclaration; +PROCEDURE transpile_type_fields(context: PTranspilerContext; fields: PAstFieldDeclaration); VAR - token: LexerToken; - field_declarations: PAstFieldDeclaration; - field_count: CARDINAL; + written_bytes: CARDINAL; current_field: PAstFieldDeclaration; BEGIN - ALLOCATE(field_declarations, TSIZE(AstFieldDeclaration)); - token := transpiler_lex(context^.lexer); - field_count := 0; - - WHILE token.kind <> lexerKindEnd DO - INC(field_count); - REALLOCATE(field_declarations, TSIZE(AstFieldDeclaration) * (field_count + 1)); - current_field := field_declarations; - INC(current_field , TSIZE(AstFieldDeclaration) * (field_count - 1)); + current_field := fields; + WHILE ORD(current_field^.field_name[1]) <> 0 DO WriteString(context^.output, ' '); - write_current(context^.lexer, context^.output); - token := transpiler_lex(context^.lexer); - - current_field^.field_name := token.identifierKind; + written_bytes := WriteNBytes(context^.output, ORD(current_field^.field_name[1]), ADR(current_field^.field_name[2])); WriteString(context^.output, ': '); - token := transpiler_lex(context^.lexer); - current_field^.field_type := transpile_type_expression(context); - token := transpiler_lex(context^.lexer); + transpile_type_expression(context, current_field^.field_type); - IF token.kind = lexerKindSemicolon THEN - token := transpiler_lex(context^.lexer); + INC(current_field , TSIZE(AstFieldDeclaration)); + + IF ORD(current_field^.field_name[1]) <> 0 THEN WriteChar(context^.output, ';') END; WriteLine(context^.output) - END; - INC(current_field, TSIZE(AstFieldDeclaration)); - MemZero(current_field, TSIZE(AstFieldDeclaration)); - RETURN field_declarations + END END transpile_type_fields; -PROCEDURE transpile_record_type(context: PTranspilerContext): PAstTypeExpression; -VAR - result: PAstTypeExpression; +PROCEDURE transpile_record_type(context: PTranspilerContext; type_expression: PAstTypeExpression); BEGIN - ALLOCATE(result, TSIZE(AstTypeExpression)); - result^.kind := astTypeExpressionKindRecord; - WriteString(context^.output, 'RECORD'); WriteLine(context^.output); - result^.fields := transpile_type_fields(context); - WriteString(context^.output, ' END'); - - RETURN result + transpile_type_fields(context, type_expression^.fields); + WriteString(context^.output, ' END') END transpile_record_type; -PROCEDURE transpile_pointer_type(context: PTranspilerContext): PAstTypeExpression; +PROCEDURE transpile_pointer_type(context: PTranspilerContext; type_expression: PAstTypeExpression); VAR token: LexerToken; - result: PAstTypeExpression; BEGIN - ALLOCATE(result, TSIZE(AstTypeExpression)); - result^.kind := astTypeExpressionKindPointer; - - token := lexer_current(context^.lexer); WriteString(context^.output, 'POINTER TO '); - IF token.kind = lexerKindPointer THEN - token := transpiler_lex(context^.lexer) - END; - token := lexer_current(context^.lexer); - result^.target := transpile_type_expression(context); - RETURN result + transpile_type_expression(context, type_expression^.target) END transpile_pointer_type; -PROCEDURE transpile_array_type(context: PTranspilerContext): PAstTypeExpression; +PROCEDURE transpile_array_type(context: PTranspilerContext; type_expression: PAstTypeExpression); VAR - token: LexerToken; buffer: ARRAY[1..20] OF CHAR; - result: PAstTypeExpression; BEGIN - ALLOCATE(result, TSIZE(AstTypeExpression)); - result^.kind := astTypeExpressionKindArray; - WriteString(context^.output, 'ARRAY'); - token := lexer_current(context^.lexer); - IF token.kind = lexerKindArray THEN - token := transpiler_lex(context^.lexer) - END; - IF token.kind <> lexerKindOf THEN + IF type_expression^.length <> 0 THEN WriteString(context^.output, '[1..'); - token := transpiler_lex(context^.lexer); - result^.length := token.integerKind; - IntToStr(result^.length, 0, buffer); + IntToStr(type_expression^.length, 0, buffer); WriteString(context^.output, buffer); - token := transpiler_lex(context^.lexer); WriteChar(context^.output, ']') END; WriteString(context^.output, ' OF '); - token := transpiler_lex(context^.lexer); - result^.base := transpile_type_expression(context); - - RETURN result + transpile_type_expression(context, type_expression^.base) END transpile_array_type; -PROCEDURE transpile_enumeration_type(context: PTranspilerContext): PAstTypeExpression; +PROCEDURE transpile_enumeration_type(context: PTranspilerContext; type_expression: PAstTypeExpression); VAR - token: LexerToken; - result: PAstTypeExpression; current_case: PIdentifier; - case_count: CARDINAL; written_bytes: CARDINAL; BEGIN - ALLOCATE(result, TSIZE(AstTypeExpression)); - result^.kind := astTypeExpressionKindEnumeration; - - case_count := 1; - ALLOCATE(result^.cases, TSIZE(Identifier) * 2); - token := transpiler_lex(context^.lexer); - current_case := result^.cases; - current_case^ := token.identifierKind; - - token := transpiler_lex(context^.lexer); - - WHILE token.kind = lexerKindComma DO - token := transpiler_lex(context^.lexer); - - INC(case_count); - REALLOCATE(result^.cases, TSIZE(Identifier) * (case_count + 1)); - current_case := result^.cases; - INC(current_case, TSIZE(Identifier) * (case_count - 1)); - current_case^ := token.identifierKind; - - token := transpiler_lex(context^.lexer) - END; - INC(current_case, TSIZE(Identifier)); - MemZero(current_case, TSIZE(Identifier)); - - (* Write the cases using the generated identifier list before. *) - current_case := result^.cases; + current_case := type_expression^.cases; WriteString(context^.output, '('); WriteLine(context^.output); @@ -315,151 +238,83 @@ BEGIN INC(current_case, TSIZE(Identifier)) END; WriteLine(context^.output); - WriteString(context^.output, ' )'); - - RETURN result + WriteString(context^.output, ' )') END transpile_enumeration_type; -PROCEDURE transpile_named_type(context: PTranspilerContext): PAstTypeExpression; +PROCEDURE transpile_named_type(context: PTranspilerContext; type_expression: PAstTypeExpression); VAR - token: LexerToken; - result: PAstTypeExpression; written_bytes: CARDINAL; BEGIN - token := lexer_current(context^.lexer); - ALLOCATE(result, TSIZE(AstTypeExpression)); - - result^.kind := astTypeExpressionKindNamed; - result^.name := token.identifierKind; - - written_bytes := WriteNBytes(context^.output, ORD(result^.name[1]), ADR(result^.name[2])); - - RETURN result + written_bytes := WriteNBytes(context^.output, ORD(type_expression^.name[1]), ADR(type_expression^.name[2])) END transpile_named_type; -PROCEDURE transpile_procedure_type(context: PTranspilerContext): PAstTypeExpression; +PROCEDURE transpile_procedure_type(context: PTranspilerContext; type_expression: PAstTypeExpression); VAR - token: LexerToken; result: PAstTypeExpression; current_parameter: PPAstTypeExpression; parameter_count: CARDINAL; BEGIN - parameter_count := 0; - ALLOCATE(result, TSIZE(AstTypeExpression)); - result^.kind := astTypeExpressionKindProcedure; - - ALLOCATE(result^.parameters, 1); - - token := transpiler_lex(context^.lexer); WriteString(context^.output, 'PROCEDURE('); + current_parameter := type_expression^.parameters; - token := transpiler_lex(context^.lexer); + WHILE current_parameter^ <> NIL DO + transpile_type_expression(context, current_parameter^); - WHILE token.kind <> lexerKindRightParen DO - INC(parameter_count); - REALLOCATE(result^.parameters, TSIZE(PAstTypeExpression) * (parameter_count + 1)); - current_parameter := result^.parameters; - INC(current_parameter, TSIZE(PAstTypeExpression) * (parameter_count - 1)); + INC(current_parameter, TSIZE(PAstTypeExpression)); - current_parameter^ := transpile_type_expression(context); - - token := transpiler_lex(context^.lexer); - IF token.kind = lexerKindComma THEN - token := transpiler_lex(context^.lexer); + IF current_parameter^ <> NIL THEN WriteString(context^.output, ', ') END END; - current_parameter := result^.parameters; - INC(current_parameter, TSIZE(PAstTypeExpression) * parameter_count); - current_parameter^ := NIL; - WriteChar(context^.output, ')'); - - RETURN result + WriteChar(context^.output, ')') END transpile_procedure_type; -PROCEDURE transpile_type_expression(context: PTranspilerContext): PAstTypeExpression; -VAR - token: LexerToken; - result: PAstTypeExpression; +PROCEDURE transpile_type_expression(context: PTranspilerContext; type_expression: PAstTypeExpression); BEGIN - result := NIL; - token := lexer_current(context^.lexer); - - IF token.kind = lexerKindRecord THEN - result := transpile_record_type(context) + IF type_expression^.kind = astTypeExpressionKindRecord THEN + transpile_record_type(context, type_expression) END; - IF token.kind = lexerKindLeftParen THEN - result := transpile_enumeration_type(context) + IF type_expression^.kind = astTypeExpressionKindEnumeration THEN + transpile_enumeration_type(context, type_expression) END; - IF (token.kind = lexerKindArray) OR (token.kind = lexerKindLeftSquare) THEN - result := transpile_array_type(context) + IF type_expression^.kind = astTypeExpressionKindArray THEN + transpile_array_type(context, type_expression) END; - IF token.kind = lexerKindHat THEN - result := transpile_pointer_type(context) + IF type_expression^.kind = astTypeExpressionKindPointer THEN + transpile_pointer_type(context, type_expression) END; - IF token.kind = lexerKindProc THEN - result := transpile_procedure_type(context) + IF type_expression^.kind = astTypeExpressionKindProcedure THEN + transpile_procedure_type(context, type_expression) END; - IF token.kind = lexerKindIdentifier THEN - result := transpile_named_type(context) - END; - RETURN result + IF type_expression^.kind = astTypeExpressionKindNamed THEN + transpile_named_type(context, type_expression) + END END transpile_type_expression; -PROCEDURE transpile_type_declaration(context: PTranspilerContext): PAstTypeDeclaration; +PROCEDURE transpile_type_declaration(context: PTranspilerContext; declaration: PAstTypeDeclaration); VAR - token: LexerToken; - result: PAstTypeDeclaration; written_bytes: CARDINAL; BEGIN WriteString(context^.output, ' '); - token := lexer_current(context^.lexer); - ALLOCATE(result, TSIZE(AstTypeDeclaration)); - result^.identifier := token.identifierKind; - - written_bytes := WriteNBytes(context^.output, ORD(token.identifierKind[1]), ADR(token.identifierKind[2])); - - token := transpiler_lex(context^.lexer); + written_bytes := WriteNBytes(context^.output, ORD(declaration^.identifier[1]), ADR(declaration^.identifier[2])); WriteString(context^.output, ' = '); - token := transpiler_lex(context^.lexer); - result^.type_expression := transpile_type_expression(context); - token := transpiler_lex(context^.lexer); - write_semicolon(context^.output); - RETURN result + transpile_type_expression(context, declaration^.type_expression); + write_semicolon(context^.output) END transpile_type_declaration; -PROCEDURE transpile_type_part(context: PTranspilerContext): PPAstTypeDeclaration; +PROCEDURE transpile_type_part(context: PTranspilerContext; declarations: PPAstTypeDeclaration); VAR - token: LexerToken; - result: PPAstTypeDeclaration; current_declaration: PPAstTypeDeclaration; - declaration_count: CARDINAL; BEGIN - token := lexer_current(context^.lexer); - - ALLOCATE(result, TSIZE(PAstTypeDeclaration)); - current_declaration := result; - declaration_count := 0; - - IF token.kind = lexerKindType THEN + IF declarations^ <> NIL THEN WriteString(context^.output, 'TYPE'); WriteLine(context^.output); - token := transpiler_lex(context^.lexer); - WHILE token.kind = lexerKindIdentifier DO - INC(declaration_count); + current_declaration := declarations; + WHILE current_declaration^ <> NIL DO + transpile_type_declaration(context, current_declaration^); - REALLOCATE(result, TSIZE(PAstTypeDeclaration) * (declaration_count + 1)); - current_declaration := result; - INC(current_declaration, TSIZE(PAstTypeDeclaration) * (declaration_count - 1)); - - current_declaration^ := transpile_type_declaration(context); - token := transpiler_lex(context^.lexer) + INC(current_declaration, TSIZE(PAstTypeDeclaration)) END; WriteLine(context^.output) - END; - IF declaration_count <> 0 THEN - INC(current_declaration, TSIZE(PAstTypeDeclaration)) - END; - current_declaration^ := NIL; - RETURN result + END END transpile_type_part; PROCEDURE transpile_variable_declaration(context: PTranspilerContext); VAR @@ -473,7 +328,8 @@ BEGIN token := transpiler_lex(context^.lexer); WriteString(context^.output, ': '); token := transpiler_lex(context^.lexer); - type_expression := transpile_type_expression(context); + type_expression := parse_type_expression(context^.lexer); + transpile_type_expression(context, type_expression); token := transpiler_lex(context^.lexer); write_semicolon(context^.output) END transpile_variable_declaration; @@ -517,7 +373,8 @@ BEGIN WriteString(context^.output, ': '); token := transpiler_lex(context^.lexer); - type_expression := transpile_type_expression(context); + type_expression := parse_type_expression(context^.lexer); + transpile_type_expression(context, type_expression); token := transpiler_lex(context^.lexer); IF (token.kind = lexerKindSemicolon) OR (token.kind = lexerKindComma) THEN @@ -758,13 +615,39 @@ BEGIN WriteLine(context^.output) END END transpile_procedure_part; -PROCEDURE transpile(lexer: PLexer; output: File); +PROCEDURE transpile_module_name(context: PTranspilerContext); +VAR + counter: CARDINAL; + last_slash: CARDINAL; +BEGIN + counter := 1; + last_slash := 0; + + WHILE (context^.input_name[counter] <> '.') AND (ORD(context^.input_name[counter]) <> 0) DO + IF context^.input_name[counter] = '/' THEN + last_slash := counter + END; + INC(counter) + END; + + IF last_slash = 0 THEN + counter := 1; + END; + IF last_slash <> 0 THEN + counter := last_slash + 1; + END; + WHILE (context^.input_name[counter] <> '.') AND (ORD(context^.input_name[counter]) <> 0) DO + WriteChar(context^.output, context^.input_name[counter]); + INC(counter) + END; +END transpile_module_name; +PROCEDURE transpile(lexer: PLexer; output: File; input_name: ShortString); VAR token: LexerToken; context: TranspilerContext; ast_module: PAstModule; BEGIN - context.indentation := 0; + context.input_name := input_name; context.output := output; context.lexer := lexer;