elna/source/Parser.mod

450 lines
12 KiB
Modula-2

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;
PROCEDURE parse_variable_declaration(lexer: PLexer): PAstVariableDeclaration;
VAR
token: LexerToken;
result: PAstVariableDeclaration;
BEGIN
ALLOCATE(result, TSIZE(AstVariableDeclaration));
token := lexer_current(lexer);
result^.variable_name := token.identifierKind;
token := transpiler_lex(lexer);
token := transpiler_lex(lexer);
result^.variable_type := parse_type_expression(lexer);
token := transpiler_lex(lexer);
RETURN result
END parse_variable_declaration;
PROCEDURE parse_variable_part(lexer: PLexer): PPAstVariableDeclaration;
VAR
token: LexerToken;
result: PPAstVariableDeclaration;
current_declaration: PPAstVariableDeclaration;
declaration_count: CARDINAL;
BEGIN
token := lexer_current(lexer);
ALLOCATE(result, TSIZE(PAstVariableDeclaration));
current_declaration := result;
declaration_count := 0;
IF token.kind = lexerKindVar THEN
token := transpiler_lex(lexer);
WHILE token.kind = lexerKindIdentifier DO
INC(declaration_count);
REALLOCATE(result, TSIZE(PAstVariableDeclaration) * (declaration_count + 1));
current_declaration := result;
INC(current_declaration, TSIZE(PAstVariableDeclaration) * (declaration_count - 1));
current_declaration^ := parse_variable_declaration(lexer);
token := transpiler_lex(lexer)
END
END;
IF declaration_count <> 0 THEN
INC(current_declaration, TSIZE(PAstVariableDeclaration))
END;
current_declaration^ := NIL;
RETURN result
END parse_variable_part;
PROCEDURE parse_constant_declaration(lexer: PLexer): PAstConstantDeclaration;
VAR
token: LexerToken;
result: PAstConstantDeclaration;
BEGIN
ALLOCATE(result, TSIZE(AstConstantDeclaration));
token := lexer_current(lexer);
result^.constant_name := token.identifierKind;
token := transpiler_lex(lexer);
token := transpiler_lex(lexer);
result^.constant_value := token.integerKind;
token := transpiler_lex(lexer);
RETURN result
END parse_constant_declaration;
PROCEDURE parse_constant_part(lexer: PLexer): PPAstConstantDeclaration;
VAR
token: LexerToken;
result: PPAstConstantDeclaration;
current_declaration: PPAstConstantDeclaration;
declaration_count: CARDINAL;
BEGIN
token := lexer_current(lexer);
ALLOCATE(result, TSIZE(PAstConstantDeclaration));
current_declaration := result;
declaration_count := 0;
IF token.kind = lexerKindConst THEN
token := transpiler_lex(lexer);
WHILE token.kind = lexerKindIdentifier DO
INC(declaration_count);
REALLOCATE(result, TSIZE(PAstConstantDeclaration) * (declaration_count + 1));
current_declaration := result;
INC(current_declaration, TSIZE(PAstConstantDeclaration) * (declaration_count - 1));
current_declaration^ := parse_constant_declaration(lexer);
token := transpiler_lex(lexer)
END
END;
IF declaration_count <> 0 THEN
INC(current_declaration, TSIZE(PAstConstantDeclaration))
END;
current_declaration^ := NIL;
RETURN result
END parse_constant_part;
PROCEDURE parse_import_statement(lexer: PLexer): PAstImportStatement;
VAR
result: PAstImportStatement;
token: LexerToken;
symbol_count: CARDINAL;
current_symbol: PIdentifier;
BEGIN
ALLOCATE(result, TSIZE(AstImportStatement));
symbol_count := 1;
token := transpiler_lex(lexer);
result^.package := token.identifierKind;
token := transpiler_lex(lexer);
ALLOCATE(result^.symbols, TSIZE(Identifier) * 2);
current_symbol := result^.symbols;
token := transpiler_lex(lexer);
current_symbol^ := token.identifierKind;
token := transpiler_lex(lexer);
WHILE token.kind <> lexerKindSemicolon DO
token := transpiler_lex(lexer);
INC(symbol_count);
REALLOCATE(result^.symbols, TSIZE(Identifier) * (symbol_count + 1));
current_symbol := result^.symbols;
INC(current_symbol, TSIZE(Identifier) * (symbol_count - 1));
current_symbol^ := token.identifierKind;
token := transpiler_lex(lexer)
END;
INC(current_symbol, TSIZE(Identifier));
MemZero(current_symbol, TSIZE(Identifier));
token := transpiler_lex(lexer);
RETURN result
END parse_import_statement;
PROCEDURE parse_import_part(lexer: PLexer): PPAstImportStatement;
VAR
token: LexerToken;
import_statement: PPAstImportStatement;
result: PPAstImportStatement;
import_count: CARDINAL;
BEGIN
token := lexer_current(lexer);
ALLOCATE(result, TSIZE(PAstImportStatement));
import_statement := result;
import_count := 0;
WHILE token.kind = lexerKindFrom DO
INC(import_count);
REALLOCATE(result, TSIZE(PAstImportStatement) * (import_count + 1));
import_statement := result;
INC(import_statement, TSIZE(PAstImportStatement) * (import_count - 1));
import_statement^ := parse_import_statement(lexer);
token := lexer_current(lexer)
END;
IF import_count > 0 THEN
INC(import_statement, TSIZE(PAstImportStatement))
END;
import_statement^ := NIL;
RETURN result
END parse_import_part;
END Parser.