diff --git a/source/Parser.elna b/source/Parser.elna deleted file mode 100644 index 1225750..0000000 --- a/source/Parser.elna +++ /dev/null @@ -1,1174 +0,0 @@ -(* This Source Code Form is subject to the terms of the Mozilla Public License, - v. 2.0. If a copy of the MPL was not distributed with this file, You can - obtain one at https://mozilla.org/MPL/2.0/. *) -module; - -import cstdlib, common, Lexer; - -type - Parser = record - lexer: ^Lexer - end; - - AstLiteralKind* = ( - integer, - string, - null, - boolean - ); - AstLiteral* = record - kind: AstLiteralKind; - value: union - integer: Int; - string: String; - boolean: Bool - end - end; - - AstUnaryOperator* = ( - reference, - not, - minus - ); - AstBinaryOperator* = ( - sum, - subtraction, - multiplication, - division, - remainder, - equals, - not_equals, - less, - greater, - less_equal, - greater_equal, - disjunction, - conjunction, - exclusive_disjunction, - shift_left, - shift_right - ); - - AstExpressionKind* = ( - literal, - identifier, - array_access, - dereference, - field_access, - unary, - binary, - call - ); - AstExpression* = record - kind: AstExpressionKind - value: union - literal: ^AstLiteral; - identifier: Identifier; - reference: ^AstExpression; - array_access: record - array: ^AstExpression; - index: ^AstExpression - end; - field_access: record - aggregate: ^AstExpression; - field: Identifier - end; - unary: record - operator: AstUnaryOperator; - operand: ^AstExpression - end; - binary: record - operator: AstBinaryOperator; - lhs: ^AstExpression; - rhs: ^AstExpression - end; - call: record - callable: ^AstExpression; - argument_count: Word; - arguments: ^^AstExpression - end - end - end; - - ConditionalStatement = record - condition: ^AstExpression; - branch: AstCompoundStatement - end; - - AstStatementKind* = ( - if_statement, - while_statement, - assignment_statement, - return_statement, - call_statement - ); - AstStatement* = record - kind: AstStatementKind - value: union - if_statement: ConditionalStatement; - while_statement: ConditionalStatement; - assignment_statement: record - assignee: ^AstExpression; - assignment: ^AstExpression - end; - return_statement: ^AstExpression; - call_statement: ^AstExpression - end - end; - AstCompoundStatement* = record - count: Word; - statements: ^^AstStatement - end; - - AstImportStatement* = record - package: Identifier; - symbols: ^Identifier - end; - - AstConstantDeclaration* = record - constant_name: Identifier; - constant_value: Int - end; - - AstFieldDeclaration* = record - field_name: Identifier; - field_type: ^AstTypeExpression - end; - - AstTypeExpressionKind* = ( - named_expression, - record_expression, - enumeration_expression, - array_expression, - pointer_expression, - procedure_expression - ); - AstTypeExpression* = record - kind: AstTypeExpressionKind; - value: union - name: Identifier; - cases: ^Identifier; - target: ^AstTypeExpression; - fields: ^AstFieldDeclaration; - array_expression: record - base: ^AstTypeExpression; - length: Word - end; - parameters: ^^AstTypeExpression - end - end; - - AstTypedDeclaration* = record - identifier: Identifier; - type_expression: ^AstTypeExpression - end; - - AstVariableDeclaration* = record - variable_name: Identifier; - variable_type: ^AstTypeExpression - end; - - AstProcedureDeclaration* = record - name: Identifier; - parameter_count: Word; - parameters: ^AstTypedDeclaration; - return_type: ^AstTypeExpression; - constants: ^^AstConstantDeclaration; - variables: ^^AstVariableDeclaration; - statements: AstCompoundStatement - end; - - AstModule* = record - main: Bool; - imports: ^^AstImportStatement; - constants: ^^AstConstantDeclaration; - types: ^^AstTypedDeclaration; - variables: ^^AstVariableDeclaration; - procedures: ^^AstProcedureDeclaration; - statements: AstCompoundStatement - end; - -(* Calls lexer_lex() but skips the comments. *) -proc parser_lex(lexer: ^Lexer) -> LexerToken; -var - result: LexerToken; -begin - result := lexer_lex(lexer); - - while result.kind = lexerKindComment do - result := lexer_lex(lexer) - end; - - return result -end; - -proc parse_type_fields(parser: ^Parser) -> ^AstFieldDeclaration; -var - token: LexerToken; - field_declarations: ^AstFieldDeclaration; - field_count: Word; - current_field: ^AstFieldDeclaration; -begin - field_declarations := malloc(#size(AstFieldDeclaration)); - token := parser_lex(parser^.lexer); - field_count := 0; - - while token.kind <> lexerKindEnd do - field_count := field_count + 2u; - - field_declarations := realloc(field_declarations, #size(AstFieldDeclaration) * field_count); - field_count := field_count - 1u; - current_field := field_declarations + (field_count - 1u); - - token := parser_lex(parser^.lexer); - - current_field^.field_name := token.identifierKind; - - token := parser_lex(parser^.lexer); - current_field^.field_type := parse_type_expression(parser); - token := parser_lex(parser^.lexer); - - if token.kind = lexerKindSemicolon then - token := parser_lex(parser^.lexer) - end - end; - current_field := current_field + 1; - memset(current_field, 0, #size(AstFieldDeclaration)); - - return field_declarations -end; - -proc parse_record_type(parser: ^Parser) -> ^AstTypeExpression; -var - result: ^AstTypeExpression; -begin - NEW(result); - result^.kind := AstTypeExpressionKind.record_expression; - result^.fields := parse_type_fields(parser); - - return result -end; - -proc parse_pointer_type(parser: ^Parser) -> ^AstTypeExpression; -var - token: LexerToken; - result: ^AstTypeExpression; -begin - NEW(result); - result^.kind := AstTypeExpressionKind.pointer_expression; - - token := lexer_current(parser^.lexer); - - if token.kind = lexerKindPointer then - token := parser_lex(parser^.lexer) - end; - token := lexer_current(parser^.lexer); - result^.target := parse_type_expression(parser); - - return result -end; - -proc parse_array_type(parser: ^Parser) -> ^AstTypeExpression; -var - token: LexerToken; - buffer: [20]Char; - result: ^AstTypeExpression; -begin - NEW(result); - result^.kind := AstTypeExpressionKind.array_expression; - result^.array_expression.length := 0u; - - token := lexer_current(parser^.lexer); - - if token.kind = lexerKindArray then - token := parser_lex(parser^.lexer) - end; - if token.kind <> lexerKindOf then - token := parser_lex(parser^.lexer); - - result^.array_expression.length := token.integerKind; - - token := parser_lex(parser^.lexer) - end; - token := parser_lex(parser^.lexer); - result^.array_expression.base := parse_type_expression(parser); - - return result -end; - -proc parse_enumeration_type(parser: ^Parser) -> ^AstTypeExpression; -var - token: LexerToken; - result: ^AstTypeExpression; - current_case: ^Identifier; - case_count: Word; -begin - NEW(result); - result^.kind := AstTypeExpressionKind.enumeration_expression; - - case_count := 1u; - result^.cases := malloc(#size(Identifier) * 2); - token := parser_lex(parser^.lexer); - current_case := result^.cases; - current_case^ := token.identifierKind; - - token := parser_lex(parser^.lexer); - - while token.kind = lexerKindComma do - token := parser_lex(parser^.lexer); - - case_count := case_count + 2u; - - result^.cases := realloc(result^.cases, #size(Identifier) * case_count); - case_count := case_count - 1u; - current_case := result^.cases + (case_count - 1u); - current_case^ := token.identifierKind; - - token := parser_lex(parser^.lexer) - end; - current_case := current_case + 1; - memset(current_case, 0, #size(Identifier)); - - return result -end; - -proc parse_named_type(parser: ^Parser) -> ^AstTypeExpression; -var - token: LexerToken; - result: ^AstTypeExpression; -begin - token := lexer_current(parser^.lexer); - NEW(result); - - result^.kind := AstTypeExpressionKind.named_expression; - result^.name := token.identifierKind; - - return result -end; - -proc parse_procedure_type(parser: ^Parser) -> ^AstTypeExpression; -var - token: LexerToken; - result: ^AstTypeExpression; - current_parameter: ^^AstTypeExpression; - parameter_count: Word; -begin - parameter_count := 0u; - NEW(result); - result^.kind := AstTypeExpressionKind.procedure_expression; - - result^.parameters := malloc(#size(^AstTypeExpression)); - - token := parser_lex(parser^.lexer); - token := parser_lex(parser^.lexer); - - while token.kind <> lexerKindRightParen do - parameter_count := parameter_count + 2u; - - result^.parameters := realloc(result^.parameters, #size(^AstTypeExpression) * parameter_count); - parameter_count := parameter_count - 1u; - current_parameter := result^.parameters + (parameter_count - 1u); - - current_parameter^ := parse_type_expression(parser); - - token := parser_lex(parser^.lexer); - if token.kind = lexerKindComma then - token := parser_lex(parser^.lexer) - end - end; - current_parameter := result^.parameters + parameter_count; - current_parameter^ := nil; - - return result -end; - -proc parse_type_expression(parser: ^Parser) -> ^AstTypeExpression; -var - token: LexerToken; - result: ^AstTypeExpression; -begin - result := nil; - token := lexer_current(parser^.lexer); - - if token.kind = lexerKindRecord then - result := parse_record_type(parser) - end; - if token.kind = lexerKindLeftParen then - result := parse_enumeration_type(parser) - end; - if (token.kind = lexerKindArray) or (token.kind = lexerKindLeftSquare) then - result := parse_array_type(parser) - end; - if token.kind = lexerKindHat then - result := parse_pointer_type(parser) - end; - if token.kind = lexerKindProc then - result := parse_procedure_type(parser) - end; - if token.kind = lexerKindIdentifier then - result := parse_named_type(parser) - end; - return result -end; - -proc parse_type_declaration(parser: ^Parser) -> ^AstTypedDeclaration; -var - token: LexerToken; - result: ^AstTypedDeclaration; -begin - token := lexer_current(parser^.lexer); - - NEW(result); - result^.identifier := token.identifierKind; - - token := parser_lex(parser^.lexer); - token := parser_lex(parser^.lexer); - - result^.type_expression := parse_type_expression(parser); - token := parser_lex(parser^.lexer); - - return result -end; - -proc parse_type_part(parser: ^Parser) -> ^^AstTypedDeclaration; -var - token: LexerToken; - result: ^^AstTypedDeclaration; - current_declaration: ^^AstTypedDeclaration; - declaration_count: Word; -begin - token := lexer_current(parser^.lexer); - - result := malloc(#size(^AstTypedDeclaration)); - current_declaration := result; - declaration_count := 0u; - - if token.kind = lexerKindType then - token := parser_lex(parser^.lexer); - - while token.kind = lexerKindIdentifier do - declaration_count := declaration_count + 1u; - - result := realloc(result, #size(^AstTypedDeclaration) * (declaration_count + 1)); - current_declaration := result + (declaration_count - 1u); - - current_declaration^ := parse_type_declaration(parser); - token := parser_lex(parser^.lexer) - end - end; - if declaration_count <> 0u then - current_declaration := current_declaration + 1 - end; - current_declaration^ := nil; - - return result -end; - -proc parse_variable_declaration(parser: ^Parser) -> ^AstVariableDeclaration; -var - token: LexerToken; - result: ^AstVariableDeclaration; -begin - NEW(result); - - token := lexer_current(parser^.lexer); - result^.variable_name := token.identifierKind; - - token := parser_lex(parser^.lexer); - - token := parser_lex(parser^.lexer); - result^.variable_type := parse_type_expression(parser); - - token := parser_lex(parser^.lexer); - return result -end; - -proc parse_variable_part(parser: ^Parser) -> ^^AstVariableDeclaration; -var - token: LexerToken; - result: ^^AstVariableDeclaration; - current_declaration: ^^AstVariableDeclaration; - declaration_count: Word; -begin - token := lexer_current(parser^.lexer); - - result := malloc(#size(^AstVariableDeclaration)); - current_declaration := result; - declaration_count := 0u; - - if token.kind = lexerKindVar then - token := parser_lex(parser^.lexer); - - while token.kind = lexerKindIdentifier do - declaration_count := declaration_count + 1u; - - result := realloc(result, #size(^AstVariableDeclaration) * (declaration_count + 1)); - current_declaration := result + (declaration_count - 1u); - - current_declaration^ := parse_variable_declaration(parser); - token := parser_lex(parser^.lexer) - end - end; - if declaration_count <> 0 then - current_declaration := current_declaration + 1 - end; - current_declaration^ := nil; - - return result -end; - -proc parse_constant_declaration(parser: ^Parser) -> ^AstConstantDeclaration; -var - token: LexerToken; - result: ^AstConstantDeclaration; -begin - NEW(result); - - token := lexer_current(parser^.lexer); - result^.constant_name := token.identifierKind; - - token := parser_lex(parser^.lexer); - - token := parser_lex(parser^.lexer); - result^.constant_value := token.integerKind; - - token := parser_lex(parser^.lexer); - - return result -end; - -proc parse_constant_part(parser: ^Parser) -> ^^AstConstantDeclaration; -var - token: LexerToken; - result: ^^AstConstantDeclaration; - current_declaration: ^^AstConstantDeclaration; - declaration_count: Word; -begin - token := lexer_current(parser^.lexer); - - result := malloc(#size(^AstConstantDeclaration)); - current_declaration := result; - declaration_count := 0u; - - if token.kind = lexerKindConst then - token := parser_lex(parser^.lexer); - - while token.kind = lexerKindIdentifier do - declaration_count := declaration_count + 1u; - - result := realloc(result, #size(^AstConstantDeclaration) * (declaration_count + 1u)); - current_declaration := result + (declaration_count - 1u); - - current_declaration^ := parse_constant_declaration(parser); - token := parser_lex(parser^.lexer) - end - end; - if declaration_count <> 0 then - current_declaration := current_declaration + 1 - end; - current_declaration^ := nil; - - return result -end; - -proc parse_import_statement(parser: ^Parser) -> ^AstImportStatement; -var - result: ^AstImportStatement; - token: LexerToken; - symbol_count: Word; - current_symbol: ^Identifier; -begin - NEW(result); - symbol_count := 1u; - - token := parser_lex(parser^.lexer); - result^.package := token.identifierKind; - - token := parser_lex(parser^.lexer); - result^.symbols := malloc(#size(Identifier) * 2); - - current_symbol := result^.symbols; - - token := parser_lex(parser^.lexer); - current_symbol^ := token.identifierKind; - - token := parser_lex(parser^.lexer); - while token.kind <> lexerKindSemicolon do - token := parser_lex(parser^.lexer); - symbol_count := symbol_count + 1u; - - result^.symbols := realloc(result^.symbols, #size(Identifier) * (symbol_count + 1u)); - current_symbol := result^.symbols + (symbol_count - 1u); - - current_symbol^ := token.identifierKind; - token := parser_lex(parser^.lexer) - end; - current_symbol := current_symbol + 1; - memset(current_symbol, 0, #size(Identifier)); - - token := parser_lex(parser^.lexer); - - return result -end; - -proc parse_import_part(parser: ^Parser) -> ^^AstImportStatement; -var - token: LexerToken; - import_statement: ^^AstImportStatement; - result: ^^AstImportStatement; - import_count: Word; -begin - token := lexer_current(parser^.lexer); - result := malloc(#size(^AstImportStatement)); - import_statement := result; - import_count := 0u; - - while token.kind = lexerKindFrom do - import_count := import_count + 1u; - - result := realloc(result, #size(^AstImportStatement) * (import_count + 1u)); - import_statement := result + (import_count - 1u); - - import_statement^ := parse_import_statement(parser); - token := lexer_current(parser^.lexer) - end; - if import_count > 0u then - import_statement := import_count + 1 - end; - import_statement^ := nil; - - return result -end; - -proc parse_literal(parser: ^Parser) -> ^AstLiteral; -var - literal: ^AstLiteral; - token: LexerToken; -begin - literal := nil; - token := lexer_current(parser^.lexer); - - if token.kind = lexerKindInteger then - NEW(literal); - - literal^.kind := AstLiteralKind.integer; - literal^.integer := token.integerKind - end; - if (token.kind = lexerKindCharacter) or (token.kind = lexerKindString) then - NEW(literal); - - literal^.kind := AstLiteralKind.string; - literal^.string := token.stringKind - end; - if token.kind = lexerKindNull then - NEW(literal); - - literal^.kind := AstLiteralKind.null - end; - if token.kind = lexerKindBoolean then - NEW(literal); - - literal^.kind := AstLiteralKind.boolean; - literal^.boolean := token.booleanKind - end; - if literal <> nil then - token := parser_lex(parser^.lexer) - end; - - return literal -end; - -proc parse_factor(parser: ^Parser) -> ^AstExpression; -var - next_token: LexerToken; - result: ^AstExpression; - literal: ^AstLiteral; -begin - result := nil; - next_token := lexer_current(parser^.lexer); - - literal := parse_literal(parser); - - if (result = nil) & (literal <> nil) then - NEW(result); - - result^.kind := AstExpressionKind.literal; - result^.literal := literal - end; - if (result = nil) & (next_token.kind = lexerKindMinus) then - NEW(result); - next_token := parser_lex(parser^.lexer); - - result^.kind := AstExpressionKind.unary; - result^.unary.operator := AstUnaryOperator.minus; - result^.unary.operand := parse_factor(parser) - end; - if (result = nil) & (next_token.kind = lexerKindTilde) then - NEW(result); - next_token := parser_lex(parser^.lexer); - - result^.kind := AstExpressionKind.unary; - result^.unary.operator := AstUnaryOperator.not; - result^.unary.operand := parse_factor(parser) - end; - if (result = nil) & (next_token.kind = lexerKindLeftParen) then - next_token := parser_lex(parser^.lexer); - result := parse_expression(parser); - if result <> nil then - next_token := parser_lex(parser^.lexer) - end - end; - if (result = nil) & (next_token.kind = lexerKindIdentifier) then - NEW(result); - - result^.kind := AstExpressionKind.identifier; - result^.identifier := next_token.identifierKind; - - next_token := parser_lex(parser^.lexer) - end; - - return result -end; - -proc parse_designator(parser: ^Parser) -> ^AstExpression; -var - next_token: LexerToken; - inner_expression: ^AstExpression; - designator: ^AstExpression; - arguments: ^^AstExpression; - handled: Bool; -begin - designator := parse_factor(parser); - handled := designator <> nil; - next_token := lexer_current(parser^.lexer); - - while handled do - inner_expression := designator; - handled := false; - - if ~handled & (next_token.kind = lexerKindHat) then - NEW(designator); - - designator^.kind := AstExpressionKind.dereference; - designator^.reference := inner_expression; - - next_token := parser_lex(parser^.lexer); - handled := true - end; - if ~handled & (next_token.kind = lexerKindLeftSquare) then - NEW(designator); - next_token := parser_lex(parser^.lexer); - - designator^.kind := AstExpressionKind.array_access; - designator^.array_access.array := inner_expression; - designator^.array_access.index := parse_expression(parser); - - next_token := parser_lex(parser^.lexer); - handled := true - end; - if ~handled & (next_token.kind = lexerKindDot) then - NEW(designator); - next_token := parser_lex(parser^.lexer); - - designator^.kind := AstExpressionKind.field_access; - designator^.field_access.aggregate := inner_expression; - designator^.field_access.field := next_token.identifierKind; - - next_token := parser_lex(parser^.lexer); - handled := true - end; - if ~handled & (next_token.kind = lexerKindLeftParen) then - NEW(designator); - next_token := parser_lex(parser^.lexer); - - designator^.kind := AstExpressionKind.call; - designator^.call.callable := inner_expression; - designator^.call.argument_count := 0; - designator^.call.arguments := nil; - - if next_token.kind <> lexerKindRightParen then - designator^.arguments := malloc(#size(^AstExpression)); - designator^.argument_count := 1; - designator^.arguments^ := parse_expression(parser); - - next_token := lexer_current(parser^.lexer); - - while next_token.kind = lexerKindComma do - next_token := parser_lex(parser^.lexer); - - designator^.argument_count := designator^.argument_count + 1; - designator^.arguments := realloc(designator^.arguments, #size(^AstExpression) * designator^.argument_count); - arguments := designator^.arguments + (designator^.argument_count - 1u); - arguments^ := parse_expression(parser); - - next_token := lexer_current(parser^.lexer) - end - end; - - next_token := parser_lex(parser^.lexer); - handled := true - end - end; - - return designator -end; - -proc parse_binary_expression(parser: ^Parser, left: ^AstExpression, operator: AstBinaryOperator) -> ^AstExpression; -var - next_token: LexerToken; - result: ^AstExpression; - right: ^AstExpression; -begin - next_token := parser_lex(parser^.lexer); - right := parse_designator(parser); - result := nil; - - if right <> nil then - NEW(result); - result^.kind := AstExpressionKind.binary; - result^.binary.operator := operator; - result^.binary.lhs := left; - result^.binary.rhs := right - end; - - return result -end; - -proc parse_expression(parser: ^Parser) -> ^AstExpression; -var - next_token: LexerToken; - left: ^AstExpression; - result: ^AstExpression; - written_bytes: Word; -begin - left := parse_designator(parser); - result := nil; - next_token := lexer_current(parser^.lexer); - - if left <> nil then - if (result = nil) & (next_token.kind = lexerKindNotEqual) then - result := parse_binary_expression(parser, left, AstBinaryOperator.not_equals) - end; - if (result = nil) & (next_token.kind = lexerKindEqual) then - result := parse_binary_expression(parser, left, AstBinaryOperator.equals) - end; - if (result = nil) & (next_token.kind = lexerKindGreaterThan) then - result := parse_binary_expression(parser, left, AstBinaryOperator.greater) - end; - if (result = nil) & (next_token.kind = lexerKindLessThan) then - result := parse_binary_expression(parser, left, AstBinaryOperator.less) - end; - if (result = nil) & (next_token.kind = lexerKindGreaterEqual) then - result := parse_binary_expression(parser, left, AstBinaryOperator.greater_equal) - end; - if (result = nil) & (next_token.kind = lexerKindLessEqual) then - result := parse_binary_expression(parser, left, AstBinaryOperator.less_equal) - end; - if (result = nil) & (next_token.kind = lexerKindAnd) then - result := parse_binary_expression(parser, left, AstBinaryOperator.conjunction) - end; - if (result = nil) & (next_token.kind = lexerKindOr) then - result := parse_binary_expression(parser, left, AstBinaryOperator.disjunction) - end; - if (result = nil) & (next_token.kind = lexerKindMinus) then - result := parse_binary_expression(parser, left, AstBinaryOperator.subtraction) - end; - if (result = nil) & (next_token.kind = lexerKindPlus) then - result := parse_binary_expression(parser, left, AstBinaryOperator.sum) - end; - if (result = nil) & (next_token.kind = lexerKindAsterisk) then - result := parse_binary_expression(parser, left, AstBinaryOperator.multiplication) - end - end; - if (result = nil) & (left <> nil) then - result := left - end; - - return result -end; - -proc parse_return_statement(parser: ^Parser) -> ^AstStatement; -var - token: LexerToken; - result: ^AstStatement; -begin - NEW(result); - result^.kind := AstStatementKind.return_statement; - - token := parser_lex(parser^.lexer); - result^.return_statement := parse_expression(parser); - - return result -end; - -proc parse_assignment_statement(parser: ^Parser, assignee: ^AstExpression) -> ^AstStatement; -var - token: LexerToken; - result: ^AstStatement; -begin - NEW(result); - result^.kind := AstStatementKind.assignment_statement; - result^.assignment_statement.assignee := assignee; - - token := parser_lex(parser^.lexer); - result^.assignment_statement.assignment := parse_expression(parser); - - return result -end; - -proc parse_call_statement(parser: ^Parser, call: ^AstExpression) -> ^AstStatement; -var - result: ^AstStatement; -begin - NEW(result); - result^.kind := AstStatementKind.call_statement; - result^.call_statement := call; - - return result -end; - -proc parse_compound_statement(parser: ^Parser) -> AstCompoundStatement; -var - result: AstCompoundStatement; - token: LexerToken; - current_statement: ^^AstStatement; - old_count: Word; -begin - result.count := 0u; - result.statements := nil; - - token := lexer_current(parser^.lexer); - - while token.kind <> lexerKindEnd do - old_count := result.count; - result.count := result.count + 1u; - - result.statements := realloc(result.statements, #size(^AstStatement) * result.count); - current_statement := result.statements + old_count; - - current_statement^ := parse_statement(parser); - - token := lexer_current(parser^.lexer) - end; - - return result -end; - -proc parse_statement(parser: ^Parser) -> ^AstStatement; -var - token: LexerToken; - statement: ^AstStatement; - designator: ^AstExpression; -begin - statement := nil; - token := parser_lex(parser^.lexer); - - if token.kind = lexerKindIf then - statement := parse_if_statement(parser) - end; - if token.kind = lexerKindWhile then - statement := parse_while_statement(parser) - end; - if token.kind = lexerKindReturn then - statement := parse_return_statement(parser) - end; - if token.kind = lexerKindIdentifier then - designator := parse_designator(parser); - token := lexer_current(parser^.lexer); - - if token.kind = lexerKindAssignment then - statement := parse_assignment_statement(parser, designator) - end; - if token.kind <> lexerKindAssignment then - statement := parse_call_statement(parser, designator) - end - end; - return statement -end; - -proc parse_if_statement(parser: ^Parser) -> ^AstStatement; -var - token: LexerToken; - result: ^AstStatement; -begin - NEW(result); - result^.kind := AstStatementKind.if_statement; - - token := parser_lex(parser^.lexer); - result^.if_statement.condition := parse_expression(parser); - result^.if_statement.branch := parse_compound_statement(parser); - - token := parser_lex(parser^.lexer); - return result -end; - -proc parse_while_statement(parser: ^Parser) -> ^AstStatement; -var - token: LexerToken; - result: ^AstStatement; -begin - NEW(result); - result^.kind := AstStatementKind.while_statement; - - token := parser_lex(parser^.lexer); - result^.while_statement.condition := parse_expression(parser); - result^.while_statement.body := parse_compound_statement(parser); - - token := parser_lex(parser^.lexer); - return result -end; - -proc parse_statement_part(parser: ^Parser) -> AstCompoundStatement; -var - token: LexerToken; - compound: AstCompoundStatement; -begin - compound.count := 0; - compound.statements := nil; - token := lexer_current(parser^.lexer); - - if token.kind = lexerKindBegin then - compound := parse_compound_statement(parser) - end; - - return compound -end; - -proc parse_procedure_heading(parser: ^Parser) -> ^AstProcedureDeclaration; -var - token: LexerToken; - declaration: ^AstProcedureDeclaration; - parameter_index: Word; - current_parameter: ^AstTypedDeclaration; -begin - NEW(declaration); - - token := parser_lex(parser^.lexer); - declaration^.name := token.identifierKind; - - token := parser_lex(parser^.lexer); - - declaration^.parameters := nil; - declaration^.parameter_count := 0u; - - token := parser_lex(parser^.lexer); - while token.kind <> lexerKindRightParen do - parameter_index := declaration^.parameter_count; - declaration^.parameter_count := declaration^.parameter_count + 1; - declaration^.parameters := realloc(declaration^.parameters, #size(AstTypedDeclaration) * declaration^.parameter_count); - - current_parameter := declaration^.parameters + parameter_index; - - current_parameter^.identifier := token.identifierKind; - - token := parser_lex(parser^.lexer); - token := parser_lex(parser^.lexer); - - current_parameter^.type_expression := parse_type_expression(parser); - - token := parser_lex(parser^.lexer); - if token.kind = lexerKindComma then - token := parser_lex(parser^.lexer) - end - end; - token := parser_lex(parser^.lexer); - declaration^.return_type := nil; - - (* Check for the return type and write it. *) - if token.kind = lexerKindArrow then - token := parser_lex(parser^.lexer); - declaration^.return_type := parse_type_expression(parser); - token := parser_lex(parser^.lexer) - end; - token := parser_lex(parser^.lexer); - - return declaration -end; - -proc parse_procedure_declaration(parser: ^Parser) -> ^AstProcedureDeclaration; -var - token: LexerToken; - declaration: ^AstProcedureDeclaration; -begin - declaration := parse_procedure_heading(parser); - - declaration^.constants := parse_constant_part(parser); - declaration^.variables := parse_variable_part(parser); - declaration^.statements := parse_statement_part(parser); - - token := parser_lex(parser^.lexer); - token := parser_lex(parser^.lexer); - - return declaration -end; - -proc parse_procedure_part(parser: ^Parser) -> ^^AstProcedureDeclaration; -var - token: LexerToken; - current_declaration: ^^AstProcedureDeclaration; - result: ^^AstProcedureDeclaration; - declaration_count: Word; - declaration_index: Word; -begin - token := lexer_current(parser^.lexer); - declaration_count := 0u; - declaration_index := 0u; - - result := malloc(#size(^AstProcedureDeclaration)); - - while token.kind = lexerKindProc do - declaration_count := declaration_count + 1u; - result := realloc(result, #size(^AstProcedureDeclaration) * (declaration_count + 1)); - current_declaration := result + declaration_index; - - current_declaration^ := parse_procedure_declaration(parser); - token := lexer_current(parser^.lexer); - declaration_index := declaration_count - end; - current_declaration := result + declaration_index; - current_declaration^ := nil; - - return result -end; - -proc parse_module(parser: ^Parser) -> ^AstModule; -var - token: LexerToken; - result: ^AstModule; -begin - NEW(result); - token := parser_lex(parser^.lexer); - result^.main := true; - - if token.kind = lexerKindModule then - result^.main := false - end; - token := parser_lex(parser^.lexer); - - (* Write the module body. *) - token := parser_lex(parser^.lexer); - - result^.imports := parse_import_part(parser); - result^.constants := parse_constant_part(parser); - result^.types := parse_type_part(parser); - - result^.variables := parse_variable_part(parser); - result^.procedures := parse_procedure_part(parser); - result^.statements := parse_statement_part(parser); - - token := parser_lex(parser^.lexer); - token := parser_lex(parser^.lexer); - - return result -end; - -proc parse*(lexer: ^Lexer) -> ^AstModule; -var - parser: Parser; -begin - parser.lexer := lexer; - - return parse_module(@parser) -end; - -end. diff --git a/source/Transpiler.elna b/source/Transpiler.elna deleted file mode 100644 index 5a65036..0000000 --- a/source/Transpiler.elna +++ /dev/null @@ -1,631 +0,0 @@ -(* This Source Code Form is subject to the terms of the Mozilla Public License, - v. 2.0. If a copy of the MPL was not distributed with this file, You can - obtain one at https://mozilla.org/MPL/2.0/. *) -module; - -from FIO import File, WriteNBytes, WriteLine, WriteChar, WriteString; -from NumberIO import IntToStr; - -import common, Parser; - -type - TranspilerContext* = record - input_name: String; - output: File; - definition: File; - indentation: Word - end; - -proc indent(context: ^TranspilerContext); -var - count: Word; -begin - count := 0; - - while count < context^.indentation do - WriteString(context^.output, " "); - count := count + 1u - end -end; - -(* Write a semicolon followed by a newline. *) -proc write_semicolon(output: File); -begin - WriteChar(output, ';'); - WriteLine(output) -end; - -proc transpile_import_statement(context: ^TranspilerContext, import_statement: ^AstImportStatement); -var - current_symbol: ^Identifier; -begin - WriteString(context^.output, "FROM "); - transpile_identifier(context, import_statement^.package); - - WriteString(context^.output, " IMPORT "); - - current_symbol := import_statement^.symbols; - transpile_identifier(context, current_symbol^); - current_symbol := current_symbol + 1; - - while current_symbol^[1] <> '\0' do - WriteString(context^.output, ", "); - transpile_identifier(context, current_symbol^); - current_symbol := current_symbol + 1; - end; - write_semicolon(context^.output) -end; - -proc transpile_import_part(context: ^TranspilerContext, imports: ^^AstImportStatement); -var - import_statement: ^AstImportStatement; -begin - while imports^ <> nil do - transpile_import_statement(context, imports^); - imports := imports + 1 - end; - WriteLine(context^.output) -end; - -proc transpile_constant_declaration(context: ^TranspilerContext, declaration: ^AstConstantDeclaration); -var - buffer: [20]Char; -begin - WriteString(context^.output, " "); - transpile_identifier(context, declaration^.constant_name); - - WriteString(context^.output, " = "); - - IntToStr(declaration^.constant_value, 0, buffer); - WriteString(context^.output, buffer); - - write_semicolon(context^.output) -end; - -proc transpile_constant_part(context: ^TranspilerContext, declarations: ^^AstConstantDeclaration, extra_newline: Bool); -var - current_declaration: ^^AstConstantDeclaration; -begin - if declarations^ <> nil then - WriteString(context^.output, "CONST"); - WriteLine(context^.output); - - current_declaration := declarations; - while current_declaration^ <> nil do - transpile_constant_declaration(context, current_declaration^); - - current_declaration := current_declaration + 1 - end; - if extra_newline then - WriteLine(context^.output) - end - end -end; - -proc transpile_module(context: ^TranspilerContext, result: ^AstModule); -begin - if result^.main = false then - WriteString(context^.output, "IMPLEMENTATION ") - end; - WriteString(context^.output, "MODULE "); - - (* Write the module name and end the line with a semicolon and newline. *) - transpile_module_name(context); - - write_semicolon(context^.output); - WriteLine(context^.output); - - (* Write the module body. *) - - transpile_import_part(context, result^.imports); - transpile_constant_part(context, result^.constants, true); - transpile_type_part(context, result^.types); - transpile_variable_part(context, result^.variables, true); - transpile_procedure_part(context, result^.procedures); - transpile_statement_part(context, result^.statements); - - WriteString(context^.output, "END "); - transpile_module_name(context); - - WriteChar(context^.output, "."); - WriteLine(context^.output) -end; - -proc transpile_type_fields(context: ^TranspilerContext, fields: ^AstFieldDeclaration); -var - current_field: ^AstFieldDeclaration; -begin - current_field := fields; - - while current_field^.field_name[1] <> '\0' do - WriteString(context^.output, " "); - transpile_identifier(context, current_field^.field_name); - - WriteString(context^.output, ": "); - transpile_type_expression(context, current_field^.field_type); - - current_field := current_field + 1; - - if current_field^.field_name[1] <> '\0' then - WriteChar(context^.output, ';') - end; - WriteLine(context^.output) - end -end; - -proc transpile_record_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression); -begin - WriteString(context^.output, "RECORD"); - WriteLine(context^.output); - transpile_type_fields(context, type_expression^.fields); - WriteString(context^.output, " END") -end; - -proc transpile_pointer_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression); -begin - WriteString(context^.output, "POINTER TO "); - - transpile_type_expression(context, type_expression^.target) -end; - -proc transpile_array_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression); -var - buffer: [20]Char; -begin - WriteString(context^.output, "ARRAY"); - - if type_expression^.length <> 0 then - WriteString(context^.output, "[1.."); - - IntToStr(type_expression^.length, 0, buffer); - WriteString(context^.output, buffer); - - WriteChar(context^.output, ']') - end; - WriteString(context^.output, " OF "); - - transpile_type_expression(context, type_expression^.base) -end; - -proc transpile_enumeration_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression); -var - current_case: ^Identifier; -begin - current_case := type_expression^.cases; - - WriteString(context^.output, "("); - WriteLine(context^.output); - WriteString(context^.output, " "); - transpile_identifier(context, current_case^); - current_case := current_case + 1; - - while current_case^[1] <> '\0' do - WriteChar(context^.output, ','); - WriteLine(context^.output); - WriteString(context^.output, " "); - transpile_identifier(context, current_case^); - - current_case := current_case + 1 - end; - WriteLine(context^.output); - WriteString(context^.output, " )") -end; - -proc transpile_identifier(context: ^TranspilerContext, identifier: Identifier); -var - written_bytes: Word; -begin - written_bytes := WriteNBytes(context^.output, cast(identifier[1]: Word), @identifier[2]) -end; - -proc transpile_procedure_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression); -var - result: ^AstTypeExpression; - current_parameter: ^^AstTypeExpression; - parameter_count: Word; -begin - WriteString(context^.output, "PROCEDURE("); - current_parameter := type_expression^.parameters; - - while current_parameter^ <> nil do - transpile_type_expression(context, current_parameter^); - - current_parameter := current_parameter + 1; - - if current_parameter^ <> nil then - WriteString(context^.output, ", ") - end - end; - WriteChar(context^.output, ')') -end; - -proc transpile_type_expression(context: ^TranspilerContext, type_expression: ^AstTypeExpression); -begin - if type_expression^.kind = astTypeExpressionKindRecord then - transpile_record_type(context, type_expression) - end; - if type_expression^.kind = astTypeExpressionKindEnumeration then - transpile_enumeration_type(context, type_expression) - end; - if type_expression^.kind = astTypeExpressionKindArray then - transpile_array_type(context, type_expression) - end; - if type_expression^.kind = astTypeExpressionKindPointer then - transpile_pointer_type(context, type_expression) - end; - if type_expression^.kind = astTypeExpressionKindProcedure then - transpile_procedure_type(context, type_expression) - end; - if type_expression^.kind = astTypeExpressionKindNamed then - transpile_identifier(context, type_expression^.name) - end -end; - -proc transpile_type_declaration(context: ^TranspilerContext, declaration: ^AstTypedDeclaration); -var - written_bytes: Word; -begin - WriteString(context^.output, " "); - - transpile_identifier(context^.output, declaration^.identifier); - WriteString(context^.output, " = "); - - transpile_type_expression(context, declaration^.type_expression); - write_semicolon(context^.output) -end; - -proc transpile_type_part(context: ^TranspilerContext, declarations: ^^AstTypedDeclaration); -var - current_declaration: ^^AstTypedDeclaration; -begin - if declarations^ <> nil then - WriteString(context^.output, "TYPE"); - WriteLine(context^.output); - - current_declaration := declarations; - while current_declaration^ <> nil do - transpile_type_declaration(context, current_declaration^); - - current_declaration := current_declaration + 1 - end; - WriteLine(context^.output) - end -end; - -proc transpile_variable_declaration(context: ^TranspilerContext, declaration: ^AstVariableDeclaration); -begin - WriteString(context^.output, " "); - transpile_identifier(context, declaration^.variable_name); - - WriteString(context^.output, ": "); - - transpile_type_expression(context, declaration^.variable_type); - write_semicolon(context^.output) -end; - -proc transpile_variable_part(context: ^TranspilerContext, declarations: ^^AstVariableDeclaration, extra_newline: Bool); -var - current_declaration: ^^AstVariableDeclaration; -begin - if declarations^ <> nil then - WriteString(context^.output, "VAR"); - WriteLine(context^.output); - - current_declaration := declarations; - while current_declaration^ <> nil do - transpile_variable_declaration(context, current_declaration^); - - current_declaration := current_declaration + 1 - end; - if extra_newline then - WriteLine(context^.output) - end - end -end; - -proc transpile_procedure_heading(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration); -var - parameter_index: Word; - current_parameter: ^AstTypedDeclaration; -begin - WriteString(context^.output, "PROCEDURE "); - transpile_identifier(context, declaration^.name); - WriteChar(context^.output, '('); - - parameter_index := 0; - current_parameter := declaration^.parameters; - - while parameter_index < declaration^.parameter_count do - transpile_identifier(context, current_parameter^.identifier); - WriteString(context^.output, ": "); - transpile_type_expression(context, current_parameter^.type_expression); - - parameter_index := parameter_index + 1u; - current_parameter := current_parameter + 1; - - if parameter_index <> declaration^.parameter_count then - WriteString(context^.output, "; ") - end - end; - - WriteString(context^.output, ")"); - - (* Check for the return type and write it. *) - if declaration^.return_type <> nil then - WriteString(context^.output, ": "); - transpile_type_expression(context, declaration^.return_type) - end; - write_semicolon(context^.output) -end; - -proc transpile_unary_operator(context: ^TranspilerContext, operator: AstUnaryOperator); -begin - if operator = AstUnaryOperator.minus then - WriteChar(context^.output, '-') - end; - if operator = AstUnaryOperator.not then - WriteChar(context^.output, '~') - end -end; - -proc transpile_binary_operator(context: ^TranspilerContext, operator: AstBinaryOperator); -begin - case operator of - AstBinaryOperator.sum: WriteChar(context^.output, '+') - | AstBinaryOperator.subtraction: WriteChar(context^.output, '-') - | AstBinaryOperator.multiplication: WriteChar(context^.output, '*') - | AstBinaryOperator.equals: WriteChar(context^.output, '=') - | AstBinaryOperator.not_equals: WriteChar(context^.output, '#') - | AstBinaryOperator.less: WriteChar(context^.output, '<') - | AstBinaryOperator.greater: WriteChar(context^.output, '>') - | AstBinaryOperator.less_equal: WriteString(context^.output, "<=") - | AstBinaryOperator.greater_equal: WriteString(context^.output, ">=") - | AstBinaryOperator.disjunction: WriteString(context^.output, "OR") - | AstBinaryOperatorConjunction: WriteString(context^.output, "AND") - end -end; - -proc transpile_expression(context: ^TranspilerContext, expression: ^AstExpression); -var - literal: ^AstLiteral; - buffer: [20]Char; - argument_index: Word; - current_argument: ^^AstExpression; -begin - if expression^.kind = astExpressionKindLiteral then - literal := expression^.literal; - - if literal^.kind = AstLiteralKind.integer then - IntToStr(literal^.integer, 0, buffer); - WriteString(context^.output, buffer) - end; - if literal^.kind = AstLiteralKind.string then - WriteString(context^.output, literal^.string) - end; - if literal^.kind = AstLiteralKind.null then - WriteString(context^.output, "NIL") - end; - if (literal^.kind = AstLiteralKind.boolean) & literal^.boolean then - WriteString(context^.output, "TRUE") - end; - if (literal^.kind = AstLiteralKind.boolean) & (literal^.boolean = false) then - WriteString(context^.output, "FALSE") - end - end; - if expression^.kind = astExpressionKindIdentifier then - transpile_identifier(context, expression^.identifier) - end; - if expression^.kind = astExpressionKindDereference then - transpile_expression(context, expression^.reference); - WriteChar(context^.output, '^') - end; - if expression^.kind = astExpressionKindArrayAccess then - transpile_expression(context, expression^.array); - WriteChar(context^.output, '['); - transpile_expression(context, expression^.index); - WriteChar(context^.output, ']') - end; - if expression^.kind = astExpressionKindFieldAccess then - transpile_expression(context, expression^.aggregate); - WriteChar(context^.output, '.'); - transpile_identifier(contextexpression^.field) - end; - if expression^.kind = astExpressionKindUnary then - transpile_unary_operator(context, expression^.unary_operator); - transpile_expression(context, expression^.unary_operand) - end; - if expression^.kind = astExpressionKindBinary then - WriteChar(context^.output, '('); - transpile_expression(context, expression^.lhs); - WriteChar(context^.output, ' '); - transpile_binary_operator(context, expression^.binary_operator); - WriteChar(context^.output, ' '); - transpile_expression(context, expression^.rhs); - WriteChar(context^.output, ')') - end; - if expression^.kind = astExpressionKindCall then - transpile_expression(context, expression^.callable); - WriteChar(context^.output, '('); - - current_argument := expression^.arguments; - if expression^.argument_count > 0 then - transpile_expression(context, current_argument^); - - argument_index := 1u; - current_argument := current_argument + 1; - - while argument_index < expression^.argument_count do - WriteString(context^.output, ", "); - - transpile_expression(context, current_argument^); - - current_argument := current_argument + 1; - argument_index := argument_index + 1u - end - end; - WriteChar(context^.output, ')') - end -end; - -proc transpile_if_statement(context: ^TranspilerContext, statement: ^AstStatement); -begin - WriteString(context^.output, "IF "); - transpile_expression(context, statement^.if_condition); - - WriteString(context^.output, " THEN"); - WriteLine(context^.output); - context^.indentation := context^.indentation + 1u; - - transpile_compound_statement(context, statement^.if_branch); - context^.indentation := context^.indentation - 1u; - indent(context); - WriteString(context^.output, "END") -end; - -proc transpile_while_statement(context: ^TranspilerContext, statement: ^AstStatement); -begin - WriteString(context^.output, "WHILE "); - transpile_expression(context, statement^.while_condition); - - WriteString(context^.output, " DO"); - WriteLine(context^.output); - context^.indentation := context^.indentation + 1u; - - transpile_compound_statement(context, statement^.while_body); - context^.indentation := context^.indentation - 1u; - indent(context); - WriteString(context^.output, "END") -end; - -proc transpile_assignment_statement(context: ^TranspilerContext, statement: ^AstStatement); -begin - transpile_expression(context, statement^.assignee); - WriteString(context^.output, " := "); - transpile_expression(context, statement^.assignment) -end; - -proc transpile_return_statement(context: ^TranspilerContext, statement: ^AstStatement); -begin - WriteString(context^.output, "RETURN "); - - transpile_expression(context, statement^.returned) -end; - -proc transpile_compound_statement(context: ^TranspilerContext, statement: AstCompoundStatement); -var - current_statement: ^^AstStatement; - index: Word; -begin - index := 0; - current_statement := statement.statements; - - while index < statement.count do - transpile_statement(context, current_statement^); - - current_statement := current_statement + 1; - index := index + 1u; - - if index <> statement.count then - WriteChar(context^.output, ';') - end; - WriteLine(context^.output) - end -end; - -proc transpile_statement(context: ^TranspilerContext, statement: ^AstStatement); -begin - indent(context); - - if statement^.kind = astStatementKindIf then - transpile_if_statement(context, statement) - end; - if statement^.kind = astStatementKindWhile then - transpile_while_statement(context, statement) - end; - if statement^.kind = astStatementKindReturn then - transpile_return_statement(context, statement) - end; - if statement^.kind = astStatementKindAssignment then - transpile_assignment_statement(context, statement) - end; - if statement^.kind = astStatementKindCall then - transpile_expression(context, statement^.call) - end -end; - -proc transpile_statement_part(context: ^TranspilerContext, compound: AstCompoundStatement); -begin - if compound.count > 0 then - WriteString(context^.output, "BEGIN"); - WriteLine(context^.output); - - context^.indentation := context^.indentation + 1u; - transpile_compound_statement(context, compound); - context^.indentation := context^.indentation - 1u; - end -end; - -proc transpile_procedure_declaration(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration); -begin - transpile_procedure_heading(context, declaration); - - transpile_constant_part(context, declaration^.constants, false); - transpile_variable_part(context, declaration^.variables, false); - transpile_statement_part(context, declaration^.statements); - - WriteString(context^.output, "END "); - transpile_identifier(context^.output, declaration^.name); - - write_semicolon(context^.output) -end; - -proc transpile_procedure_part(context: ^TranspilerContext, declaration: ^^AstProcedureDeclaration); -begin - while declaration^ <> nil do - transpile_procedure_declaration(context, declaration^); - WriteLine(context^.output); - - declaration := declaration + 1 - end -end; - -proc transpile_module_name(context: ^TranspilerContext); -var - counter: Word; - last_slash: Word; -begin - counter := 1u; - last_slash := 0u; - - while context^.input_name[counter] <> '.' & context^.input_name[counter] <> '\0' do - if context^.input_name[counter] = '/' then - last_slash := counter - end; - counter := counter + 1u - end; - - if last_slash = 0u then - counter := 1u - end; - if last_slash <> 0u then - counter := last_slash + 1u - end; - while context^.input_name[counter] <> '.' & context^.input_name[counter] <> '\0' do - WriteChar(context^.output, context^.input_name[counter]); - counter := counter + 1u - end -end; - -proc transpile*(ast_module: ^AstModule, output: File, definition: File, input_name: String); -var - context: TranspilerContext; -begin - context.input_name := input_name; - context.output := output; - context.definition := definition; - context.indentation := 0u; - - transpile_module(@context, ast_module) -end; - -end.