966 lines
27 KiB
Modula-2
966 lines
27 KiB
Modula-2
IMPLEMENTATION MODULE Parser;
|
|
|
|
FROM FIO IMPORT ReadNBytes;
|
|
FROM SYSTEM IMPORT TSIZE;
|
|
|
|
FROM MemUtils IMPORT MemZero;
|
|
FROM Storage IMPORT ALLOCATE, REALLOCATE;
|
|
|
|
FROM Lexer IMPORT Lexer, 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);
|
|
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));
|
|
|
|
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
|
|
NEW(result);
|
|
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
|
|
NEW(result);
|
|
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
|
|
NEW(result);
|
|
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
|
|
NEW(result);
|
|
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);
|
|
INC(case_count);
|
|
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;
|
|
|
|
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;
|
|
BEGIN
|
|
token := lexer_current(lexer);
|
|
NEW(result);
|
|
|
|
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;
|
|
NEW(result);
|
|
result^.kind := astTypeExpressionKindProcedure;
|
|
|
|
ALLOCATE(result^.parameters, 1);
|
|
|
|
token := transpiler_lex(lexer);
|
|
token := transpiler_lex(lexer);
|
|
|
|
WHILE token.kind <> lexerKindRightParen DO
|
|
INC(parameter_count);
|
|
INC(parameter_count);
|
|
REALLOCATE(result^.parameters, TSIZE(PAstTypeExpression) * parameter_count);
|
|
DEC(parameter_count);
|
|
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): PAstTypedDeclaration;
|
|
VAR
|
|
token: LexerToken;
|
|
result: PAstTypedDeclaration;
|
|
BEGIN
|
|
token := lexer_current(lexer);
|
|
|
|
NEW(result);
|
|
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): PPAstTypedDeclaration;
|
|
VAR
|
|
token: LexerToken;
|
|
result: PPAstTypedDeclaration;
|
|
current_declaration: PPAstTypedDeclaration;
|
|
declaration_count: CARDINAL;
|
|
BEGIN
|
|
token := lexer_current(lexer);
|
|
|
|
ALLOCATE(result, TSIZE(PAstTypedDeclaration));
|
|
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(PAstTypedDeclaration) * (declaration_count + 1));
|
|
current_declaration := result;
|
|
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(PAstTypedDeclaration))
|
|
END;
|
|
current_declaration^ := NIL;
|
|
|
|
RETURN result
|
|
END parse_type_part;
|
|
PROCEDURE parse_variable_declaration(lexer: PLexer): PAstVariableDeclaration;
|
|
VAR
|
|
token: LexerToken;
|
|
result: PAstVariableDeclaration;
|
|
BEGIN
|
|
NEW(result);
|
|
|
|
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
|
|
NEW(result);
|
|
|
|
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
|
|
NEW(result);
|
|
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;
|
|
PROCEDURE parse_literal(lexer: PLexer): PAstLiteral;
|
|
VAR
|
|
literal: PAstLiteral;
|
|
token: LexerToken;
|
|
BEGIN
|
|
literal := NIL;
|
|
token := lexer_current(lexer);
|
|
|
|
IF token.kind = lexerKindInteger THEN
|
|
NEW(literal);
|
|
|
|
literal^.kind := astLiteralKindInteger;
|
|
literal^.integer := token.integerKind
|
|
END;
|
|
IF (token.kind = lexerKindCharacter) OR (token.kind = lexerKindString) THEN
|
|
NEW(literal);
|
|
|
|
literal^.kind := astLiteralKindString;
|
|
literal^.string := token.stringKind
|
|
END;
|
|
IF token.kind = lexerKindNull THEN
|
|
NEW(literal);
|
|
|
|
literal^.kind := astLiteralKindNull
|
|
END;
|
|
IF token.kind = lexerKindBoolean THEN
|
|
NEW(literal);
|
|
|
|
literal^.kind := astLiteralKindBoolean;
|
|
literal^.boolean := token.booleanKind
|
|
END;
|
|
IF literal <> NIL THEN
|
|
token := transpiler_lex(lexer)
|
|
END;
|
|
|
|
RETURN literal
|
|
END parse_literal;
|
|
PROCEDURE parse_factor(lexer: PLexer): PAstExpression;
|
|
VAR
|
|
next_token: LexerToken;
|
|
result: PAstExpression;
|
|
literal: PAstLiteral;
|
|
BEGIN
|
|
result := NIL;
|
|
next_token := lexer_current(lexer);
|
|
|
|
literal := parse_literal(lexer);
|
|
|
|
IF (result = NIL) AND (literal <> NIL) THEN
|
|
NEW(result);
|
|
|
|
result^.kind := astExpressionKindLiteral;
|
|
result^.literal := literal
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindMinus) THEN
|
|
NEW(result);
|
|
next_token := transpiler_lex(lexer);
|
|
|
|
result^.kind := astExpressionKindUnary;
|
|
result^.unary_operator := astUnaryOperatorMinus;
|
|
result^.unary_operand := parse_factor(lexer)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindTilde) THEN
|
|
NEW(result);
|
|
next_token := transpiler_lex(lexer);
|
|
|
|
result^.kind := astExpressionKindUnary;
|
|
result^.unary_operator := astUnaryOperatorNot;
|
|
result^.unary_operand := parse_factor(lexer)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindLeftParen) THEN
|
|
next_token := transpiler_lex(lexer);
|
|
result := parse_expression(lexer);
|
|
IF result <> NIL THEN
|
|
next_token := transpiler_lex(lexer)
|
|
END
|
|
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;
|
|
|
|
RETURN result
|
|
END parse_factor;
|
|
PROCEDURE parse_designator(lexer: PLexer): PAstExpression;
|
|
VAR
|
|
next_token: LexerToken;
|
|
inner_expression: PAstExpression;
|
|
designator: PAstExpression;
|
|
arguments: PPAstExpression;
|
|
handled: BOOLEAN;
|
|
BEGIN
|
|
designator := parse_factor(lexer);
|
|
handled := designator <> NIL;
|
|
next_token := lexer_current(lexer);
|
|
|
|
WHILE handled DO
|
|
inner_expression := designator;
|
|
handled := FALSE;
|
|
|
|
IF ~handled AND (next_token.kind = lexerKindHat) THEN
|
|
NEW(designator);
|
|
|
|
designator^.kind := astExpressionKindDereference;
|
|
designator^.reference := inner_expression;
|
|
|
|
next_token := transpiler_lex(lexer);
|
|
handled := TRUE
|
|
END;
|
|
IF ~handled AND (next_token.kind = lexerKindLeftSquare) THEN
|
|
NEW(designator);
|
|
next_token := transpiler_lex(lexer);
|
|
|
|
designator^.kind := astExpressionKindArrayAccess;
|
|
designator^.array := inner_expression;
|
|
designator^.index := parse_expression(lexer);
|
|
|
|
next_token := transpiler_lex(lexer);
|
|
handled := TRUE
|
|
END;
|
|
IF ~handled AND (next_token.kind = lexerKindDot) THEN
|
|
NEW(designator);
|
|
next_token := transpiler_lex(lexer);
|
|
|
|
designator^.kind := astExpressionKindFieldAccess;
|
|
designator^.aggregate := inner_expression;
|
|
designator^.field := next_token.identifierKind;
|
|
|
|
next_token := transpiler_lex(lexer);
|
|
handled := TRUE
|
|
END;
|
|
IF ~handled AND (next_token.kind = lexerKindLeftParen) THEN
|
|
NEW(designator);
|
|
next_token := transpiler_lex(lexer);
|
|
|
|
designator^.kind := astExpressionKindCall;
|
|
designator^.callable := inner_expression;
|
|
designator^.argument_count := 0;
|
|
designator^.arguments := NIL;
|
|
|
|
IF next_token.kind <> lexerKindRightParen THEN
|
|
ALLOCATE(designator^.arguments, TSIZE(PAstExpression));
|
|
designator^.argument_count := 1;
|
|
designator^.arguments^ := parse_expression(lexer);
|
|
|
|
next_token := lexer_current(lexer);
|
|
|
|
WHILE next_token.kind = lexerKindComma DO
|
|
next_token := transpiler_lex(lexer);
|
|
|
|
designator^.argument_count := designator^.argument_count + 1;
|
|
REALLOCATE(designator^.arguments, TSIZE(PAstExpression) * designator^.argument_count);
|
|
arguments := designator^.arguments;
|
|
INC(arguments, TSIZE(PAstExpression) * (designator^.argument_count - 1));
|
|
arguments^ := parse_expression(lexer);
|
|
|
|
next_token := lexer_current(lexer)
|
|
END
|
|
END;
|
|
|
|
next_token := transpiler_lex(lexer);
|
|
handled := TRUE
|
|
END
|
|
END;
|
|
|
|
RETURN designator
|
|
END parse_designator;
|
|
PROCEDURE parse_binary_expression(lexer: PLexer; left: PAstExpression; operator: AstBinaryOperator): PAstExpression;
|
|
VAR
|
|
next_token: LexerToken;
|
|
result: PAstExpression;
|
|
right: PAstExpression;
|
|
BEGIN
|
|
next_token := transpiler_lex(lexer);
|
|
right := parse_designator(lexer);
|
|
result := NIL;
|
|
|
|
IF right <> NIL THEN
|
|
NEW(result);
|
|
result^.kind := astExpressionKindBinary;
|
|
result^.binary_operator := operator;
|
|
result^.lhs := left;
|
|
result^.rhs := right
|
|
END;
|
|
|
|
RETURN result
|
|
END parse_binary_expression;
|
|
PROCEDURE parse_expression(lexer: PLexer): PAstExpression;
|
|
VAR
|
|
next_token: LexerToken;
|
|
left: PAstExpression;
|
|
result: PAstExpression;
|
|
written_bytes: CARDINAL;
|
|
BEGIN
|
|
left := parse_designator(lexer);
|
|
result := NIL;
|
|
next_token := lexer_current(lexer);
|
|
|
|
IF left <> NIL THEN
|
|
IF (result = NIL) AND (next_token.kind = lexerKindNotEqual) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorNotEquals)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindEqual) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorEquals)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindGreaterThan) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorGreater)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindLessThan) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorLess)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindGreaterEqual) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorGreaterEqual)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindLessEqual) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorLessEqual)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindAnd) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorConjunction)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindOr) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorDisjunction)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindMinus) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorSubtraction)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindPlus) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorSum)
|
|
END;
|
|
IF (result = NIL) AND (next_token.kind = lexerKindAsterisk) THEN
|
|
result := parse_binary_expression(lexer, left, astBinaryOperatorMultiplication)
|
|
END
|
|
END;
|
|
IF (result = NIL) AND (left <> NIL) THEN
|
|
result := left
|
|
END;
|
|
|
|
RETURN result
|
|
END parse_expression;
|
|
PROCEDURE parse_return_statement(lexer: PLexer): PAstStatement;
|
|
VAR
|
|
token: LexerToken;
|
|
result: PAstStatement;
|
|
BEGIN
|
|
NEW(result);
|
|
result^.kind := astStatementKindReturn;
|
|
|
|
token := transpiler_lex(lexer);
|
|
result^.returned := parse_expression(lexer);
|
|
|
|
RETURN result
|
|
END parse_return_statement;
|
|
PROCEDURE parse_assignment_statement(lexer: PLexer; assignee: PAstExpression): PAstStatement;
|
|
VAR
|
|
token: LexerToken;
|
|
result: PAstStatement;
|
|
BEGIN
|
|
NEW(result);
|
|
result^.kind := astStatementKindAssignment;
|
|
result^.assignee := assignee;
|
|
|
|
token := transpiler_lex(lexer);
|
|
result^.assignment := parse_expression(lexer);
|
|
|
|
RETURN result
|
|
END parse_assignment_statement;
|
|
PROCEDURE parse_call_statement(lexer: PLexer; call: PAstExpression): PAstStatement;
|
|
VAR
|
|
result: PAstStatement;
|
|
BEGIN
|
|
NEW(result);
|
|
result^.kind := astStatementKindCall;
|
|
result^.call := call;
|
|
|
|
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.
|