From 8a0f2827146bf0581caa0d46a6540a5af5633ff7 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 7 Feb 2025 22:12:59 +0100 Subject: [PATCH] Implement defer --- boot/ast.cc | 58 +++++--- boot/driver.cc | 39 ++--- boot/lexer.ll | 21 ++- boot/parser.yy | 75 +++++----- gcc/Make-lang.in | 7 +- gcc/elna-generic.cc | 171 +++++++++++++--------- gcc/elna-tree.cc | 78 ++++++++-- gcc/elna1.cc | 1 - include/elna/boot/ast.h | 73 ++++------ include/elna/boot/driver.h | 4 +- include/elna/gcc/elna-generic.h | 8 +- include/elna/gcc/elna-tree.h | 38 +++-- source.elna | 246 ++++++++++++++++++-------------- 13 files changed, 484 insertions(+), 335 deletions(-) diff --git a/boot/ast.cc b/boot/ast.cc index 8b21165..6d56234 100644 --- a/boot/ast.cc +++ b/boot/ast.cc @@ -90,6 +90,14 @@ namespace boot } } + void empty_visitor::visit(defer_statement *defer) + { + for (statement *const body_statement : defer->statements) + { + body_statement->accept(this); + } + } + void empty_visitor::visit(block *block) { for (constant_definition *const constant : block->constants) @@ -204,7 +212,7 @@ namespace boot { } - void empty_visitor::visit(string_literal *) + void empty_visitor::visit(number_literal *) { } @@ -377,8 +385,8 @@ namespace boot } variable_declaration::variable_declaration(const struct position position, const std::string& identifier, - type_expression *type) - : definition(position, identifier), m_type(type) + const bool exported, type_expression *type) + : definition(position, identifier, exported), m_type(type) { } @@ -397,19 +405,14 @@ namespace boot return *m_type; } - definition::definition(const struct position position, const std::string& identifier) - : node(position), m_identifier(identifier) + definition::definition(const struct position position, const std::string& identifier, const bool exported) + : node(position), identifier(identifier), exported(exported) { } - std::string& definition::identifier() - { - return m_identifier; - } - constant_definition::constant_definition(const struct position position, const std::string& identifier, - literal *body) - : definition(position, identifier), m_body(body) + const bool exported, literal *body) + : definition(position, identifier, exported), m_body(body) { } @@ -429,8 +432,8 @@ namespace boot } procedure_definition::procedure_definition(const struct position position, const std::string& identifier, - std::vector&& parameters, type_expression *return_type, block *body) - : definition(position, identifier), m_return_type(return_type), m_body(body), parameters(std::move(parameters)) + const bool exported, type_expression *return_type) + : definition(position, identifier, exported), m_return_type(return_type) { } @@ -444,6 +447,12 @@ namespace boot return m_body; } + procedure_definition *procedure_definition::add_body(block *procedure_body) + { + m_body = procedure_body; + return this; + } + type_expression *procedure_definition::return_type() { return m_return_type; @@ -462,8 +471,8 @@ namespace boot } type_definition::type_definition(const struct position position, const std::string& identifier, - type_expression *body) - : definition(position, identifier), m_body(body) + const bool exported, type_expression *body) + : definition(position, identifier, exported), m_body(body) { } @@ -535,19 +544,22 @@ namespace boot { } - string_literal::string_literal(const struct position position, const std::string& value) - : literal(position), m_string(value) + defer_statement::defer_statement(const struct position position) + : statement(position) { } - void string_literal::accept(parser_visitor *visitor) + void defer_statement::accept(parser_visitor *visitor) { visitor->visit(this); } - const std::string& string_literal::string() const + defer_statement::~defer_statement() { - return m_string; + for (statement *body_statement : statements) + { + delete body_statement; + } } designator_expression::designator_expression(const struct position position) @@ -608,7 +620,7 @@ namespace boot } field_access_expression::field_access_expression(const struct position position, - designator_expression *base, const std::string& field) + expression *base, const std::string& field) : designator_expression(position), m_base(base), m_field(field) { } @@ -618,7 +630,7 @@ namespace boot visitor->visit(this); } - designator_expression& field_access_expression::base() + expression& field_access_expression::base() { return *m_base; } diff --git a/boot/driver.cc b/boot/driver.cc index dab1436..52f503d 100644 --- a/boot/driver.cc +++ b/boot/driver.cc @@ -9,10 +9,11 @@ namespace boot { position make_position(const yy::location& location) { - return position{ - static_cast(location.begin.line), - static_cast(location.begin.column) - }; + position result; + result.line = static_cast(location.begin.line); + result.column = static_cast(location.begin.column); + + return result; } syntax_error::syntax_error(const std::string& message, @@ -33,7 +34,7 @@ namespace boot void driver::error(const yy::location& loc, const std::string& message) { - m_errors.emplace_back(std::make_unique(message, input_file, loc)); + m_errors.emplace_back(new boot::syntax_error(message, input_file, loc)); } const std::list>& driver::errors() const noexcept @@ -41,36 +42,36 @@ namespace boot return m_errors; } - std::optional escape_char(char escape) + char escape_char(char escape) { switch (escape) { case 'n': - return std::make_optional('\n'); + return '\n'; case 'a': - return std::make_optional('\a'); + return '\a'; case 'b': - return std::make_optional('\b'); + return '\b'; case 't': - return std::make_optional('\t'); + return '\t'; case 'f': - return std::make_optional('\f'); + return '\f'; case 'r': - return std::make_optional('\r'); + return '\r'; case 'v': - return std::make_optional('\v'); + return '\v'; case '\\': - return std::make_optional('\\'); + return '\\'; case '\'': - return std::make_optional('\''); + return '\''; case '"': - return std::make_optional('"'); + return '"'; case '?': - return std::make_optional('\?'); + return '\?'; case '0': - return std::make_optional('\0'); + return '\0'; default: - return std::nullopt; + return escape_invalid_char; } } } diff --git a/boot/lexer.ll b/boot/lexer.ll index 96d2b66..366d20a 100644 --- a/boot/lexer.ll +++ b/boot/lexer.ll @@ -127,6 +127,9 @@ as { sizeof { return yy::parser::make_SIZEOF(this->location); } +defer { + return yy::parser::make_DEFER(this->location); + } [A-Za-z_][A-Za-z0-9_]* { return yy::parser::make_IDENTIFIER(yytext, this->location); } @@ -155,15 +158,12 @@ sizeof { return yy::parser::make_CHARACTER(std::string(&character, 1), this->location); } '\\[0nabtfrv\\'"?]' { - std::optional escape = elna::boot::escape_char(yytext[2]); - if (escape.has_value()) - { - return yy::parser::make_CHARACTER(std::string(&escape.value(), 1), this->location); - } - else + char escape = elna::boot::escape_char(yytext[2]); + if (escape == escape_invalid_char) { REJECT; } + return yy::parser::make_CHARACTER(std::string(&escape, 1), this->location); } \"[[:print:]]*\" { std::string result; @@ -191,15 +191,12 @@ sizeof { { ++current_position; - std::optional escape = elna::boot::escape_char(*current_position); - if (escape.has_value()) - { - result.push_back(escape.value()); - } - else + char escape = elna::boot::escape_char(*current_position); + if (escape == elna::boot::escape_invalid_char) { REJECT; } + result.push_back(escape); } else { diff --git a/boot/parser.yy b/boot/parser.yy index 041c617..c1d83ee 100644 --- a/boot/parser.yy +++ b/boot/parser.yy @@ -71,7 +71,7 @@ %token BOOLEAN %token IF WHILE DO THEN ELSE ELSIF RETURN %token CONST VAR PROCEDURE ARRAY OF TYPE RECORD POINTER TO UNION -%token BEGIN_BLOCK END_BLOCK EXTERN +%token BEGIN_BLOCK END_BLOCK EXTERN DEFER %token LEFT_PAREN RIGHT_PAREN LEFT_SQUARE RIGHT_SQUARE SEMICOLON DOT COMMA %token AND OR NOT CAST AS SIZEOF %token GREATER_EQUAL LESS_EQUAL LESS_THAN GREATER_THAN NOT_EQUAL EQUALS @@ -100,7 +100,7 @@ %type return_statement; %type statement; %type > statements optional_statements; -%type procedure_definition; +%type procedure_definition procedure_heading; %type > procedure_definitions procedure_part; %type type_definition; %type > type_definitions type_part; @@ -109,6 +109,8 @@ %type >> field_list; %type > elsif_statement_list; %type cast_expression; +%type defer_statement; +%type > identifier_definition; %% program: constant_part type_part variable_part procedure_part BEGIN_BLOCK optional_statements END_BLOCK DOT @@ -131,27 +133,31 @@ block: constant_part variable_part BEGIN_BLOCK optional_statements END_BLOCK std::swap($$->variables, $2); std::swap($$->body, $4); } +identifier_definition: + IDENTIFIER MULTIPLICATION + { + $$ = std::make_pair($1, true); + } + | IDENTIFIER + { + $$ = std::make_pair($1, false); + } +procedure_heading: + PROCEDURE identifier_definition formal_parameter_list SEMICOLON + { + $$ = new elna::boot::procedure_definition(elna::boot::make_position(@1), + $2.first, $2.second); + std::swap($3, $$->parameters); + } + | PROCEDURE identifier_definition formal_parameter_list COLON type_expression SEMICOLON + { + $$ = new elna::boot::procedure_definition(elna::boot::make_position(@1), + $2.first, $2.second, $5); + std::swap($3, $$->parameters); + } procedure_definition: - PROCEDURE IDENTIFIER formal_parameter_list SEMICOLON block SEMICOLON - { - $$ = new elna::boot::procedure_definition(elna::boot::make_position(@1), - $2, std::move($3), nullptr, $5); - } - | PROCEDURE IDENTIFIER formal_parameter_list SEMICOLON EXTERN SEMICOLON - { - $$ = new elna::boot::procedure_definition(elna::boot::make_position(@1), - $2, std::move($3), nullptr, nullptr); - } - | PROCEDURE IDENTIFIER formal_parameter_list COLON type_expression SEMICOLON block SEMICOLON - { - $$ = new elna::boot::procedure_definition(elna::boot::make_position(@1), - $2, std::move($3), $5, $7); - } - | PROCEDURE IDENTIFIER formal_parameter_list COLON type_expression SEMICOLON EXTERN SEMICOLON - { - $$ = new elna::boot::procedure_definition(elna::boot::make_position(@1), - $2, std::move($3), $5, nullptr); - } + procedure_heading block { $$ = $1->add_body($2); } + | procedure_heading EXTERN { $$ = $1; } procedure_definitions: procedure_definition procedure_definitions { @@ -206,11 +212,15 @@ if_statement: $$ = new elna::boot::if_statement(elna::boot::make_position(@1), then, _else); std::swap($5, $$->branches); } -return_statement: - RETURN expression +return_statement: RETURN expression { $$ = new elna::boot::return_statement(elna::boot::make_position(@1), $2); } +defer_statement: DEFER optional_statements END_BLOCK + { + $$ = new elna::boot::defer_statement(elna::boot::make_position(@1)); + std::swap($2, $$->statements); + } literal: INTEGER { @@ -238,7 +248,7 @@ literal: } | STRING { - $$ = new elna::boot::string_literal(elna::boot::make_position(@1), $1); + $$ = new elna::boot::number_literal(elna::boot::make_position(@1), $1); } operand: literal { $$ = $1; } @@ -346,7 +356,7 @@ designator_expression: { $$ = new elna::boot::array_access_expression(elna::boot::make_position(@1), $1, $3); } - | designator_expression DOT IDENTIFIER + | operand DOT IDENTIFIER { $$ = new elna::boot::field_access_expression(elna::boot::make_position(@2), $1, $3); } @@ -367,6 +377,7 @@ statement: { $$ = new elna::boot::call_statement(elna::boot::make_position(@1), $1); } + | defer_statement { $$ = $1; } statements: statement SEMICOLON statements { @@ -407,9 +418,9 @@ type_expression: { $$ = new elna::boot::basic_type_expression(elna::boot::make_position(@1), $1); } -variable_declaration: IDENTIFIER COLON type_expression +variable_declaration: identifier_definition COLON type_expression { - $$ = new elna::boot::variable_declaration(elna::boot::make_position(@1), $1, $3); + $$ = new elna::boot::variable_declaration(elna::boot::make_position(@2), $1.first, $1.second, $3); } variable_declarations: variable_declaration COMMA variable_declarations @@ -421,9 +432,9 @@ variable_declarations: variable_part: /* no variable declarations */ {} | VAR variable_declarations SEMICOLON { std::swap($$, $2); } -constant_definition: IDENTIFIER EQUALS literal SEMICOLON +constant_definition: identifier_definition EQUALS literal SEMICOLON { - $$ = new elna::boot::constant_definition(elna::boot::make_position(@1), $1, $3); + $$ = new elna::boot::constant_definition(elna::boot::make_position(@1), $1.first, $1.second, $3); } constant_definitions: constant_definition constant_definitions @@ -436,9 +447,9 @@ constant_part: /* no constant definitions */ {} | CONST {} | CONST constant_definitions { std::swap($$, $2); } -type_definition: IDENTIFIER EQUALS type_expression +type_definition: identifier_definition EQUALS type_expression { - $$ = new elna::boot::type_definition(elna::boot::make_position(@1), $1, $3); + $$ = new elna::boot::type_definition(elna::boot::make_position(@1), $1.first, $1.second, $3); } type_definitions: type_definition COMMA type_definitions diff --git a/gcc/Make-lang.in b/gcc/Make-lang.in index a0fbc0d..0e96ea4 100644 --- a/gcc/Make-lang.in +++ b/gcc/Make-lang.in @@ -87,17 +87,18 @@ elna.stagefeedback: stagefeedback-start -mv elna/*$(objext) stagefeedback/elna ELNA_INCLUDES = -I $(srcdir)/elna/include -I elna/generated +ELNA_CXXFLAGS = -std=c++11 elna/%.o: elna/boot/%.cc elna/generated/parser.hh elna/generated/location.hh - $(COMPILE) $(ELNA_INCLUDES) $< + $(COMPILE) $(ELNA_CXXFLAGS) $(ELNA_INCLUDES) $< $(POSTCOMPILE) elna/%.o: elna/generated/%.cc elna/generated/parser.hh elna/generated/location.hh - $(COMPILE) $(ELNA_INCLUDES) $< + $(COMPILE) $(ELNA_CXXFLAGS) $(ELNA_INCLUDES) $< $(POSTCOMPILE) elna/%.o: elna/gcc/%.cc elna/generated/parser.hh elna/generated/location.hh - $(COMPILE) $(ELNA_INCLUDES) $< + $(COMPILE) $(ELNA_CXXFLAGS) $(ELNA_INCLUDES) $< $(POSTCOMPILE) elna/generated/parser.cc: elna/boot/parser.yy diff --git a/gcc/elna-generic.cc b/gcc/elna-generic.cc index a352059..db29edf 100644 --- a/gcc/elna-generic.cc +++ b/gcc/elna-generic.cc @@ -50,7 +50,7 @@ namespace gcc if (return_type == void_type_node) { - append_to_statement_list(stmt, &this->current_statements); + this->scope.front().append_statement(stmt); this->current_expression = NULL_TREE; } else @@ -133,7 +133,7 @@ namespace gcc tree set_result = build2(INIT_EXPR, void_type_node, DECL_RESULT(main_fndecl), build_int_cst_type(integer_type_node, 0)); tree return_stmt = build1(RETURN_EXPR, void_type_node, set_result); - append_to_statement_list(return_stmt, &this->current_statements); + this->scope.front().append_statement(return_stmt); tree_symbol_mapping mapping = leave_scope(); BLOCK_SUPERCONTEXT(mapping.block()) = this->main_fndecl; @@ -161,8 +161,8 @@ namespace gcc : build_type(*definition->return_type()); tree declaration_type = build_function_type_array(return_type, definition->parameters.size(), parameter_types.data()); - this->main_fndecl = build_fn_decl(definition->identifier().c_str(), declaration_type); - this->symbol_map->enter(definition->identifier(), this->main_fndecl); + this->main_fndecl = build_fn_decl(definition->identifier.c_str(), declaration_type); + this->symbol_map->enter(definition->identifier, this->main_fndecl); if (definition->body() != nullptr) { @@ -178,17 +178,18 @@ namespace gcc auto parameter = definition->parameters.at(i); tree declaration_tree = build_decl(get_location(¶meter->position()), PARM_DECL, - get_identifier(parameter->identifier().c_str()), parameter_types[i]); + get_identifier(parameter->identifier.c_str()), parameter_types[i]); DECL_CONTEXT(declaration_tree) = this->main_fndecl; DECL_ARG_TYPE(declaration_tree) = parameter_types[i]; if (definition->body() != nullptr) { - this->symbol_map->enter(parameter->identifier(), declaration_tree); + this->symbol_map->enter(parameter->identifier, declaration_tree); } argument_chain.append(declaration_tree); } DECL_ARGUMENTS(this->main_fndecl) = argument_chain.head(); + TREE_PUBLIC(this->main_fndecl) = definition->exported; if (definition->body() != nullptr) { @@ -214,19 +215,29 @@ namespace gcc void generic_visitor::enter_scope() { - this->current_statements = alloc_stmt_list(); - this->variable_chain = tree_chain(); + scope.emplace_front(); this->symbol_map = std::make_shared>(this->symbol_map); } tree_symbol_mapping generic_visitor::leave_scope() { - tree new_block = build_block(variable_chain.head(), - NULL_TREE, NULL_TREE, NULL_TREE); - tree bind_expr = build3(BIND_EXPR, void_type_node, variable_chain.head(), - this->current_statements, new_block); + tree new_block = build_block(this->scope.front().variables.head(), + this->scope.front().blocks.head(), NULL_TREE, NULL_TREE); + + for (tree it = this->scope.front().blocks.head(); it != NULL_TREE; it = BLOCK_CHAIN(it)) + { + BLOCK_SUPERCONTEXT(it) = new_block; + } + tree bind_expr = build3(BIND_EXPR, void_type_node, this->scope.front().variables.head(), + this->scope.front().chain_defer(), new_block); this->symbol_map = this->symbol_map->scope(); + scope.pop_front(); + + if (!scope.empty()) + { + scope.front().blocks.append(new_block); + } return tree_symbol_mapping{ bind_expr, new_block }; } @@ -278,9 +289,29 @@ namespace gcc this->current_expression = null_pointer_node; } - void generic_visitor::visit(boot::string_literal *string) + void generic_visitor::visit(boot::number_literal *string) { - this->current_expression = build_string_literal(string->string().size() + 1, string->string().c_str()); + tree index_type = this->symbol_map->lookup("Word"); + tree index_constant = build_int_cstu(index_type, string->number().size()); + tree element_type = this->symbol_map->lookup("Char"); + tree string_type = build_array_type(element_type, build_index_type(index_constant)); + + tree string_literal = build_string(string->number().size(), string->number().c_str()); + TREE_TYPE(string_literal) = string_type; + TREE_CONSTANT(string_literal) = 1; + TREE_READONLY(string_literal) = 1; + TREE_STATIC(string_literal) = 1; + + string_type = build_pointer_type(element_type); + string_literal = build4(ARRAY_REF, element_type, string_literal, integer_zero_node, NULL_TREE, NULL_TREE); + string_literal = build1(ADDR_EXPR, string_type, string_literal); + + vec *elms = NULL; + tree string_record = this->symbol_map->lookup("String"); + CONSTRUCTOR_APPEND_ELT(elms, TYPE_FIELDS(string_record), index_constant); + CONSTRUCTOR_APPEND_ELT(elms, TREE_CHAIN(TYPE_FIELDS(string_record)), string_literal); + + this->current_expression = build_constructor(string_record, elms); } tree generic_visitor::build_arithmetic_operation(boot::binary_expression *expression, @@ -424,55 +455,49 @@ namespace gcc definition->body().accept(this); tree definition_tree = build_decl(definition_location, CONST_DECL, - get_identifier(definition->identifier().c_str()), TREE_TYPE(this->current_expression)); - auto result = this->symbol_map->enter(definition->identifier(), definition_tree); + get_identifier(definition->identifier.c_str()), TREE_TYPE(this->current_expression)); + auto result = this->symbol_map->enter(definition->identifier, definition_tree); if (result) { DECL_INITIAL(definition_tree) = this->current_expression; TREE_CONSTANT(definition_tree) = 1; TREE_READONLY(definition_tree) = 1; + TREE_PUBLIC(definition_tree) = definition->exported; - auto declaration_statement = build1_loc(definition_location, DECL_EXPR, - void_type_node, definition_tree); - append_to_statement_list(declaration_statement, &this->current_statements); + if (!scope.empty()) + { + auto declaration_statement = build1_loc(definition_location, DECL_EXPR, + void_type_node, definition_tree); + this->scope.front().append_statement(declaration_statement); + } } else { error_at(definition_location, "variable '%s' already declared in this scope", - definition->identifier().c_str()); + definition->identifier.c_str()); } this->current_expression = NULL_TREE; } void generic_visitor::visit(boot::type_definition *definition) { - tree tree_type = build_type(definition->body()); - - if (tree_type == NULL_TREE) - { - return; - } location_t definition_location = get_location(&definition->position()); + tree tree_type = build_type(definition->body()); tree definition_tree = build_decl(definition_location, TYPE_DECL, - get_identifier(definition->identifier().c_str()), tree_type); - auto result = this->symbol_map->enter(definition->identifier(), tree_type); + get_identifier(definition->identifier.c_str()), tree_type); + auto result = this->symbol_map->enter(definition->identifier, tree_type); if (result) { - DECL_CONTEXT(definition_tree) = this->main_fndecl; - variable_chain.append(definition_tree); - - auto declaration_statement = build1_loc(definition_location, DECL_EXPR, - void_type_node, definition_tree); - append_to_statement_list(declaration_statement, &this->current_statements); + TREE_PUBLIC(definition_tree) = definition->exported; } else { - error_at(definition_location, + error_at(get_location(&definition->position()), "type '%s' already declared in this scope", - definition->identifier().c_str()); + definition->identifier.c_str()); } } @@ -535,11 +560,8 @@ namespace gcc { return field_type; } - tree field_declaration = build_decl(get_location(&field.second->position()), - FIELD_DECL, get_identifier(field.first.c_str()), field_type); - TREE_ADDRESSABLE(field_declaration) = 1; - DECL_CONTEXT(field_declaration) = record_type_node; - + tree field_declaration = build_field(get_location(&field.second->position()), + record_type_node, field.first, field_type); record_chain.append(field_declaration); } TYPE_FIELDS(record_type_node) = record_chain.head(); @@ -567,11 +589,8 @@ namespace gcc { return field_type; } - tree field_declaration = build_decl(get_location(&field.second->position()), - FIELD_DECL, get_identifier(field.first.c_str()), field_type); - TREE_ADDRESSABLE(field_declaration) = 1; - DECL_CONTEXT(field_declaration) = union_type_node; - + tree field_declaration = build_field(get_location(&field.second->position()), + union_type_node, field.first, field_type); union_chain.append(field_declaration); } TYPE_FIELDS(union_type_node) = union_chain.head(); @@ -589,13 +608,13 @@ namespace gcc location_t declaration_location = get_location(&declaration->position()); tree declaration_tree = build_decl(declaration_location, VAR_DECL, - get_identifier(declaration->identifier().c_str()), declaration_type); - bool result = this->symbol_map->enter(declaration->identifier(), declaration_tree); + get_identifier(declaration->identifier.c_str()), declaration_type); + bool result = this->symbol_map->enter(declaration->identifier, declaration_tree); if (!result) { error_at(declaration_location, "variable '%s' already declared in this scope", - declaration->identifier().c_str()); + declaration->identifier.c_str()); } else if (this->main_fndecl == NULL_TREE) { @@ -606,11 +625,11 @@ namespace gcc else { DECL_CONTEXT(declaration_tree) = this->main_fndecl; - variable_chain.append(declaration_tree); + this->scope.front().variables.append(declaration_tree); auto declaration_statement = build1_loc(declaration_location, DECL_EXPR, void_type_node, declaration_tree); - append_to_statement_list(declaration_statement, &this->current_statements); + this->scope.front().append_statement(declaration_statement); } } @@ -705,7 +724,7 @@ namespace gcc tree assignment = build2_loc(statement_location, MODIFY_EXPR, void_type_node, lvalue, this->current_expression); - append_to_statement_list(assignment, &this->current_statements); + this->scope.front().append_statement(assignment); this->current_expression = NULL_TREE; } else @@ -731,14 +750,16 @@ namespace gcc } if (statement->alternative() != nullptr) { + enter_scope(); for (const auto body_statement : *statement->alternative()) { body_statement->accept(this); } + tree_symbol_mapping mapping = leave_scope(); + scope.front().append_statement(mapping.bind_expression()); } - tree endif_label_expr = build1(LABEL_EXPR, void_type_node, endif_label_decl); - append_to_statement_list(endif_label_expr, &this->current_statements); + this->scope.front().append_statement(endif_label_expr); this->current_expression = NULL_TREE; } @@ -761,19 +782,22 @@ namespace gcc tree goto_else = build1(GOTO_EXPR, void_type_node, else_label_decl); auto cond_expr = build3(COND_EXPR, void_type_node, this->current_expression, goto_then, goto_else); - append_to_statement_list(cond_expr, &this->current_statements); + this->scope.front().append_statement(cond_expr); tree then_label_expr = build1(LABEL_EXPR, void_type_node, then_label_decl); - append_to_statement_list(then_label_expr, &this->current_statements); + this->scope.front().append_statement(then_label_expr); + enter_scope(); for (const auto body_statement : branch.statements) { body_statement->accept(this); } - append_to_statement_list(goto_endif, &this->current_statements); + tree_symbol_mapping mapping = leave_scope(); + this->scope.front().append_statement(mapping.bind_expression()); + this->scope.front().append_statement(goto_endif); tree else_label_expr = build1(LABEL_EXPR, void_type_node, else_label_decl); - append_to_statement_list(else_label_expr, &this->current_statements); + this->scope.front().append_statement(else_label_expr); } tree generic_visitor::build_label_decl(const char *name, location_t loc) @@ -798,13 +822,15 @@ namespace gcc this->current_expression = error_mark_node; return; } + enter_scope(); + auto prerequisite_location = get_location(&statement->body().prerequisite().position()); auto body_location = get_location(&statement->position()); auto prerequisite_label_decl = build_label_decl("while_check", prerequisite_location); auto prerequisite_label_expr = build1_loc(prerequisite_location, LABEL_EXPR, void_type_node, prerequisite_label_decl); - append_to_statement_list(prerequisite_label_expr, &this->current_statements); + this->scope.front().append_statement(prerequisite_label_expr); auto body_label_decl = build_label_decl("while_body", body_location); auto end_label_decl = build_label_decl("end_while", UNKNOWN_LOCATION); @@ -816,21 +842,24 @@ namespace gcc auto cond_expr = build3_loc(prerequisite_location, COND_EXPR, void_type_node, this->current_expression, goto_body, goto_end); - append_to_statement_list(cond_expr, &this->current_statements); + this->scope.front().append_statement(cond_expr); auto body_label_expr = build1_loc(body_location, LABEL_EXPR, void_type_node, body_label_decl); - append_to_statement_list(body_label_expr, &this->current_statements); + this->scope.front().append_statement(body_label_expr); for (const auto body_statement : statement->body().statements) { body_statement->accept(this); } + tree_symbol_mapping mapping = leave_scope(); + this->scope.front().append_statement(mapping.bind_expression()); + auto goto_check = build1(GOTO_EXPR, void_type_node, prerequisite_label_decl); - append_to_statement_list(goto_check, &this->current_statements); + this->scope.front().append_statement(goto_check); auto endif_label_expr = build1(LABEL_EXPR, void_type_node, end_label_decl); - append_to_statement_list(endif_label_expr, &this->current_statements); + this->scope.front().append_statement(endif_label_expr); this->current_expression = NULL_TREE; } @@ -838,7 +867,8 @@ namespace gcc void generic_visitor::visit(boot::call_statement *statement) { statement->body().accept(this); - append_to_statement_list(this->current_expression, &this->current_statements); + this->scope.front().append_statement(this->current_expression); + this->current_expression = NULL_TREE; } void generic_visitor::visit(boot::return_statement *statement) @@ -854,7 +884,18 @@ namespace gcc tree set_result = build2(INIT_EXPR, void_type_node, DECL_RESULT(main_fndecl), this->current_expression); tree return_stmt = build1(RETURN_EXPR, void_type_node, set_result); - append_to_statement_list(return_stmt, &this->current_statements); + this->scope.front().append_statement(return_stmt); + } + + void generic_visitor::visit(boot::defer_statement *statement) + { + enter_scope(); + for (boot::statement *const body_statement : statement->statements) + { + body_statement->accept(this); + } + tree_symbol_mapping mapping = leave_scope(); + scope.front().defer(mapping.bind_expression()); } } } diff --git a/gcc/elna-tree.cc b/gcc/elna-tree.cc index e1d77c5..6f8a9af 100644 --- a/gcc/elna-tree.cc +++ b/gcc/elna-tree.cc @@ -4,19 +4,12 @@ #include "stor-layout.h" #include "fold-const.h" #include "diagnostic-core.h" - -tree elna_global_trees[ELNA_TI_MAX]; +#include "stringpool.h" namespace elna { namespace gcc { - void init_ttree() - { - elna_string_type_node = build_pointer_type( - build_qualified_type(char_type_node, TYPE_QUAL_CONST)); /* const char* */ - } - bool is_pointer_type(tree type) { gcc_assert(TYPE_P(type)); @@ -60,6 +53,11 @@ namespace gcc TREE_CHAIN(this->last) = t; } + void block_chain::chain(tree t) + { + BLOCK_CHAIN(this->last) = t; + } + tree_symbol_mapping::tree_symbol_mapping(tree bind_expression, tree block) : m_bind_expression(bind_expression), m_block(block) { @@ -75,6 +73,57 @@ namespace gcc return m_block; } + block_scope::block_scope() + : m_statement_list(alloc_stmt_list()) + { + } + + void block_scope::append_statement(tree statement_tree) + { + if (!defers.empty()) + { + append_to_statement_list(statement_tree, &this->defers.front().second); + } + else + { + append_to_statement_list(statement_tree, &this->m_statement_list); + } + } + + void block_scope::defer(tree statement_tree) + { + defers.push_front({ statement_tree, alloc_stmt_list() }); + } + + tree block_scope::chain_defer() + { + if (this->defers.empty()) + { + return m_statement_list; + } + std::forward_list>::iterator defer_iterator = + this->defers.begin(); + tree defer_tree = build2(TRY_FINALLY_EXPR, void_type_node, defer_iterator->second, defer_iterator->first); + + ++defer_iterator; + for (; defer_iterator != this->defers.end(); ++defer_iterator) + { + append_to_statement_list(defer_tree, &defer_iterator->second); + defer_tree = build2(TRY_FINALLY_EXPR, void_type_node, defer_iterator->second, defer_iterator->first); + } + return build2(COMPOUND_EXPR, TREE_TYPE(defer_tree), m_statement_list, defer_tree); + } + + tree build_field(location_t location, tree record_type, const std::string name, tree type) + { + tree field_declaration = build_decl(location, + FIELD_DECL, get_identifier(name.c_str()), type); + TREE_ADDRESSABLE(field_declaration) = 1; + DECL_CONTEXT(field_declaration) = record_type; + + return field_declaration; + } + std::shared_ptr> builtin_symbol_table() { std::shared_ptr> initial_table = @@ -86,7 +135,18 @@ namespace gcc initial_table->enter("Float", double_type_node); initial_table->enter("Char", unsigned_char_type_node); initial_table->enter("Byte", make_unsigned_type(8)); - initial_table->enter("String", elna_string_type_node); + + tree string_record = make_node(RECORD_TYPE); + tree_chain record_chain; + + record_chain.append(build_field(UNKNOWN_LOCATION, string_record, "length", initial_table->lookup("Word"))); + record_chain.append(build_field(UNKNOWN_LOCATION, string_record, "ptr", + build_pointer_type(initial_table->lookup("Char")))); + + TYPE_FIELDS(string_record) = record_chain.head(); + layout_type(string_record); + + initial_table->enter("String", string_record); return initial_table; } diff --git a/gcc/elna1.cc b/gcc/elna1.cc index 7b0f004..e3c3487 100644 --- a/gcc/elna1.cc +++ b/gcc/elna1.cc @@ -66,7 +66,6 @@ struct GTY (()) language_function static bool elna_langhook_init(void) { build_common_tree_nodes(false); - elna::gcc::init_ttree(); void_list_node = build_tree_list(NULL_TREE, void_type_node); diff --git a/include/elna/boot/ast.h b/include/elna/boot/ast.h index 4e6cfdf..97ab5ba 100644 --- a/include/elna/boot/ast.h +++ b/include/elna/boot/ast.h @@ -64,7 +64,7 @@ namespace boot class dereference_expression; template class number_literal; - class string_literal; + class defer_statement; /** * Interface for AST visitors. @@ -83,6 +83,7 @@ namespace boot virtual void visit(if_statement *) = 0; virtual void visit(while_statement *) = 0; virtual void visit(return_statement *) = 0; + virtual void visit(defer_statement *) = 0; virtual void visit(block *) = 0; virtual void visit(program *) = 0; virtual void visit(binary_expression *) = 0; @@ -102,7 +103,7 @@ namespace boot virtual void visit(number_literal *) = 0; virtual void visit(number_literal *) = 0; virtual void visit(number_literal *) = 0; - virtual void visit(string_literal *) = 0; + virtual void visit(number_literal *) = 0; }; /** @@ -122,6 +123,7 @@ namespace boot virtual void visit(if_statement *) override; virtual void visit(while_statement *) override; virtual void visit(return_statement *) override; + virtual void visit(defer_statement *defer) override; virtual void visit(block *block) override; virtual void visit(program *program) override; virtual void visit(binary_expression *expression) override; @@ -141,7 +143,7 @@ namespace boot virtual void visit(number_literal *) override; virtual void visit(number_literal *) override; virtual void visit(number_literal *) override; - virtual void visit(string_literal *) override; + virtual void visit(number_literal *) override; }; /** @@ -190,22 +192,12 @@ namespace boot */ class definition : public node { - std::string m_identifier; - protected: - /** - * Constructs a definition identified by some name. - * - * \param position Source code position. - * \param identifier Definition name. - */ - definition(const struct position position, const std::string& identifier); + definition(const struct position position, const std::string& identifier, const bool exported); public: - /** - * \return Definition name. - */ - std::string& identifier(); + const std::string identifier; + const bool exported; }; /** @@ -316,15 +308,8 @@ namespace boot type_expression *m_type; public: - /** - * Constructs a declaration with a name and a type. - * - * \param position Source code position. - * \param identifier Definition name. - * \param type Declared type. - */ variable_declaration(const struct position position, const std::string& identifier, - type_expression *type); + const bool exported, type_expression *type); virtual void accept(parser_visitor *visitor) override; type_expression& type(); @@ -332,6 +317,9 @@ namespace boot virtual ~variable_declaration() override; }; + /** + * Literal expression. + */ class literal : public expression { protected: @@ -352,7 +340,7 @@ namespace boot * \param body Constant value. */ constant_definition(const struct position position, const std::string& identifier, - literal *body); + const bool exported, literal *body); virtual void accept(parser_visitor *visitor) override; literal& body(); @@ -371,31 +359,28 @@ namespace boot public: std::vector parameters; - /** - * \param position Source code position. - * \param identifier Procedure name. - * \param parameters Procedure formal parameters. - * \param return_type Return type if any. - * \param body Procedure body. - */ procedure_definition(const struct position position, const std::string& identifier, - std::vector&& parameters, - type_expression *return_type = nullptr, block *body = nullptr); + const bool exported, type_expression *return_type = nullptr); virtual void accept(parser_visitor *visitor) override; type_expression *return_type(); + block *body(); + procedure_definition *add_body(block *procedure_body); virtual ~procedure_definition() override; }; + /** + * Type definition. + */ class type_definition : public definition { type_expression *m_body; public: type_definition(const struct position position, const std::string& identifier, - type_expression *expression); + const bool exported, type_expression *expression); virtual void accept(parser_visitor *visitor) override; type_expression& body(); @@ -546,15 +531,15 @@ namespace boot class field_access_expression : public designator_expression { - designator_expression *m_base; + expression *m_base; std::string m_field; public: - field_access_expression(const struct position position, designator_expression *base, + field_access_expression(const struct position position, expression *base, const std::string& field); virtual void accept(parser_visitor *visitor) override; - designator_expression& base(); + expression& base(); std::string& field(); field_access_expression *is_field_access() override; @@ -676,21 +661,21 @@ namespace boot visitor->visit(this); } - T number() const + const T& number() const { return m_number; } }; - class string_literal : public literal + class defer_statement : public statement { - std::string m_string; - public: - string_literal(const struct position position, const std::string& value); + std::vector statements; + + defer_statement(const struct position position); virtual void accept(parser_visitor *visitor) override; - const std::string& string() const; + virtual ~defer_statement() override; }; class binary_expression : public expression diff --git a/include/elna/boot/driver.h b/include/elna/boot/driver.h index 00c6e4f..343de8d 100644 --- a/include/elna/boot/driver.h +++ b/include/elna/boot/driver.h @@ -39,6 +39,8 @@ namespace boot const std::list>& errors() const noexcept; }; - std::optional escape_char(char escape); + constexpr char escape_invalid_char = '\xff'; + + char escape_char(char escape); } } diff --git a/include/elna/gcc/elna-generic.h b/include/elna/gcc/elna-generic.h index 2f84e0b..9d85ec4 100644 --- a/include/elna/gcc/elna-generic.h +++ b/include/elna/gcc/elna-generic.h @@ -10,7 +10,7 @@ #include "tree.h" #include "tree-iterator.h" -#include +#include #include namespace elna @@ -19,11 +19,10 @@ namespace gcc { class generic_visitor final : public boot::empty_visitor { - tree current_statements{ NULL_TREE }; + std::forward_list scope; tree current_expression{ NULL_TREE }; std::shared_ptr> symbol_map; tree main_fndecl{ NULL_TREE }; - tree_chain variable_chain; tree build_label_decl(const char *name, location_t loc); tree build_type(boot::type_expression& type); @@ -58,7 +57,7 @@ namespace gcc void visit(boot::number_literal *boolean) override; void visit(boot::number_literal *character) override; void visit(boot::number_literal *) override; - void visit(boot::string_literal *string) override; + void visit(boot::number_literal *string) override; void visit(boot::binary_expression *expression) override; void visit(boot::unary_expression *expression) override; void visit(boot::constant_definition *definition) override; @@ -73,6 +72,7 @@ namespace gcc void visit(boot::while_statement *statement) override; void visit(boot::call_statement *statement) override; void visit(boot::return_statement *statement) override; + void visit(boot::defer_statement *statement) override; }; } } diff --git a/include/elna/gcc/elna-tree.h b/include/elna/gcc/elna-tree.h index e445a12..2694376 100644 --- a/include/elna/gcc/elna-tree.h +++ b/include/elna/gcc/elna-tree.h @@ -1,28 +1,20 @@ #pragma once +#include + #include "config.h" #include "system.h" #include "coretypes.h" #include "tree.h" +#include "tree-iterator.h" #include "elna/boot/ast.h" #include "elna/boot/symbol.h" -enum elna_tree_index -{ - ELNA_TI_STRING_TYPE, - ELNA_TI_MAX -}; - -extern GTY(()) tree elna_global_trees[ELNA_TI_MAX]; - -#define elna_string_type_node elna_global_trees[ELNA_TI_STRING_TYPE] - namespace elna { namespace gcc { - void init_ttree(); bool is_pointer_type(tree type); bool is_integral_type(tree type); bool are_compatible_pointers(tree lhs, tree rhs); @@ -43,6 +35,13 @@ namespace gcc class tree_chain final : public tree_chain_base { + protected: + void chain(tree t) override; + }; + + class block_chain final : public tree_chain_base + { + protected: void chain(tree t) override; }; @@ -58,6 +57,22 @@ namespace gcc tree block(); }; + class block_scope + { + tree m_statement_list{ NULL_TREE }; + std::forward_list> defers; + + public: + tree_chain variables; + block_chain blocks; + + block_scope(); + + void append_statement(tree statement_tree); + void defer(tree statement_tree); + tree chain_defer(); + }; + std::shared_ptr> builtin_symbol_table(); tree do_pointer_arithmetic(boot::binary_operator binary_operator, tree left, tree right); @@ -65,5 +80,6 @@ namespace gcc tree_code operator_code, tree left, tree right, tree target_type); tree build_arithmetic_operation(boot::binary_expression *expression, tree_code operator_code, tree left, tree right); + tree build_field(location_t location, tree record_type, const std::string name, tree type); } } diff --git a/source.elna b/source.elna index 38a7a8b..6923fc5 100644 --- a/source.elna +++ b/source.elna @@ -1,91 +1,92 @@ const - SEEK_SET = 0; SEEK_CUR = 1; SEEK_END = 2; + SEEK_SET* = 0; SEEK_CUR* = 1; SEEK_END* = 2; - TOKEN_IDENTIFIER = 1; TOKEN_IF = 2; TOKEN_THEN = 3; TOKEN_ELSE = 4; TOKEN_ELSIF = 5; - TOKEN_WHILE = 6; TOKEN_DO = 7; TOKEN_PROC = 8; TOKEN_BEGIN = 9; TOKEN_END = 10; - TOKEN_EXTERN = 11; TOKEN_CONST = 12; TOKEN_VAR = 13; TOKEN_ARRAY = 14; TOKEN_OF = 15; - TOKEN_TYPE = 16; TOKEN_RECORD = 17; TOKEN_UNION = 18; TOKEN_POINTER = 19; TOKEN_TO = 20; - TOKEN_BOOLEAN = 21; TOKEN_NIL = 22; TOKEN_AND = 23; TOKEN_OR = 24; TOKEN_NOT = 25; - TOKEN_RETURN = 26; TOKEN_CAST = 27; TOKEN_AS = 28; TOKEN_SIZEOF = 29; - TOKEN_LEFT_PAREN = 30; TOKEN_RIGHT_PAREN = 31; TOKEN_LEFT_SQUARE = 32; - TOKEN_RIGHT_SQUARE = 33; TOKEN_GREATER_EQUAL = 34; TOKEN_LESS_EQUAL = 35; - TOKEN_GREATER_THAN = 36; TOKEN_LESS_THAN = 37; TOKEN_NOT_EQUAL = 38; TOKEN_EQUAL = 39; - TOKEN_SEMICOLON = 40; TOKEN_DOT = 41; TOKEN_COMMA = 42; - TOKEN_PLUS = 43; TOKEN_MINUS = 44; TOKEN_MULTIPLICATION = 45; TOKEN_DIVISION = 46; - TOKEN_REMAINDER = 47; TOKEN_ASSIGNMENT = 48; TOKEN_COLON = 49; TOKEN_HAT = 50; - TOKEN_AT = 51; TOKEN_COMMENT = 52; TOKEN_INTEGER = 53; TOKEN_WORD = 54; - TOKEN_CHARACTER = 55; TOKEN_STRING = 56; + TOKEN_IDENTIFIER* = 1; TOKEN_IF* = 2; TOKEN_THEN* = 3; TOKEN_ELSE* = 4; TOKEN_ELSIF* = 5; + TOKEN_WHILE* = 6; TOKEN_DO* = 7; TOKEN_PROC* = 8; TOKEN_BEGIN* = 9; TOKEN_END* = 10; + TOKEN_EXTERN* = 11; TOKEN_CONST* = 12; TOKEN_VAR* = 13; TOKEN_ARRAY* = 14; TOKEN_OF* = 15; + TOKEN_TYPE* = 16; TOKEN_RECORD* = 17; TOKEN_UNION* = 18; TOKEN_POINTER* = 19; TOKEN_TO* = 20; + TOKEN_BOOLEAN* = 21; TOKEN_NIL* = 22; TOKEN_AND* = 23; TOKEN_OR* = 24; TOKEN_NOT* = 25; + TOKEN_RETURN* = 26; TOKEN_CAST* = 27; TOKEN_AS* = 28; TOKEN_SIZEOF* = 29; + TOKEN_LEFT_PAREN* = 30; TOKEN_RIGHT_PAREN* = 31; TOKEN_LEFT_SQUARE* = 32; + TOKEN_RIGHT_SQUARE* = 33; TOKEN_GREATER_EQUAL* = 34; TOKEN_LESS_EQUAL* = 35; + TOKEN_GREATER_THAN* = 36; TOKEN_LESS_THAN* = 37; TOKEN_NOT_EQUAL* = 38; TOKEN_EQUAL* = 39; + TOKEN_SEMICOLON* = 40; TOKEN_DOT* = 41; TOKEN_COMMA* = 42; + TOKEN_PLUS* = 43; TOKEN_MINUS* = 44; TOKEN_MULTIPLICATION* = 45; TOKEN_DIVISION* = 46; + TOKEN_REMAINDER* = 47; TOKEN_ASSIGNMENT* = 48; TOKEN_COLON* = 49; TOKEN_HAT* = 50; + TOKEN_AT* = 51; TOKEN_COMMENT* = 52; TOKEN_INTEGER* = 53; TOKEN_WORD* = 54; + TOKEN_CHARACTER* = 55; TOKEN_STRING* = 56; TOKEN_DEFER* = 57; type - Position = record + Position* = record line: Word; column: Word end, - Location = record + Location* = record first: Position; last: Position end, - TokenValue = union + TokenValue* = union int_value: Int; string_value: pointer to Char; boolean_value: Bool; char_value: Char end, - Token = record + Token* = record kind: Int; value: TokenValue; location: Location end, - FILE = record + FILE* = record dummy: Int end, - CommandLine = record + CommandLine* = record input: pointer to Char; - tokenize: Bool + tokenize: Bool; + syntax_tree: Bool end, - Literal = record + Literal* = record value: Int end, - ConstantDefinition = record + ConstantDefinition* = record name: pointer to Char; body: pointer to Literal end, - ConstantPart = record + ConstantPart* = record elements: pointer to pointer to ConstantDefinition; count: Word end, - Program = record + Program* = record constants: ConstantPart end; (* External procedures. *) -proc fopen(pathname: String, mode: String): pointer to FILE; extern; -proc fclose(stream: pointer to FILE): Int; extern; -proc fseek(stream: pointer to FILE, off: Int, whence: Int): Int; extern; -proc rewind(stream: pointer to FILE); extern; -proc ftell(stream: pointer to FILE): Int; extern; -proc fread(ptr: pointer to Byte, size: Word, nmemb: Word, stream: pointer to FILE): Word; extern; -proc write(fd: Int, buf: pointer to Byte, Word: Int): Int; extern; +proc fopen(pathname: pointer to Char, mode: pointer to Char): pointer to FILE; extern +proc fclose(stream: pointer to FILE): Int; extern +proc fseek(stream: pointer to FILE, off: Int, whence: Int): Int; extern +proc rewind(stream: pointer to FILE); extern +proc ftell(stream: pointer to FILE): Int; extern +proc fread(ptr: pointer to Byte, size: Word, nmemb: Word, stream: pointer to FILE): Word; extern +proc write(fd: Int, buf: pointer to Byte, Word: Int): Int; extern -proc malloc(size: Word): pointer to Byte; extern; -proc free(ptr: pointer to Byte); extern; -proc calloc(nmemb: Word, size: Word): pointer to Byte; extern; -proc realloc(ptr: pointer to Byte, size: Word): pointer to Byte; extern; +proc malloc(size: Word): pointer to Byte; extern +proc free(ptr: pointer to Byte); extern +proc calloc(nmemb: Word, size: Word): pointer to Byte; extern +proc realloc(ptr: pointer to Byte, size: Word): pointer to Byte; extern -proc memset(ptr: pointer to Char, c: Int, n: Int): pointer to Char; extern; +proc memset(ptr: pointer to Char, c: Int, n: Int): pointer to Char; extern -proc strcmp(s1: pointer to Char, s2: pointer to Char): Int; extern; -proc strncmp(s1: pointer to Char, s2: pointer to Char, n: Word): Int; extern; -proc strncpy(dst: pointer to Char, src: pointer to Char, dsize: Word): pointer to Char; extern; -proc strcpy(dst: pointer to Char, src: pointer to Char): pointer to Char; extern; -proc strlen(ptr: pointer to Char): Word; extern; +proc strcmp(s1: pointer to Char, s2: pointer to Char): Int; extern +proc strncmp(s1: pointer to Char, s2: pointer to Char, n: Word): Int; extern +proc strncpy(dst: pointer to Char, src: pointer to Char, dsize: Word): pointer to Char; extern +proc strcpy(dst: pointer to Char, src: pointer to Char): pointer to Char; extern +proc strlen(ptr: pointer to Char): Word; extern -proc strtol(nptr: pointer to Char, endptr: pointer to pointer to Char, base: Int): Int; extern; +proc strtol(nptr: pointer to Char, endptr: pointer to pointer to Char, base: Int): Int; extern -proc perror(s: pointer to Char); extern; -proc exit(code: Int); extern; +proc perror(s: pointer to Char); extern +proc exit(code: Int); extern (* Standard procedures. @@ -93,12 +94,17 @@ proc exit(code: Int); extern; proc reallocarray(ptr: pointer to Byte, n: Word, size: Word): pointer to Byte; begin return realloc(ptr, n * size) -end; +end proc write_s(value: String); +begin + write(0, value.ptr, value.length) +end + +proc write_z(value: pointer to Char); begin write(0, value, strlen(value)) -end; +end proc write_b(value: Bool); begin @@ -107,12 +113,12 @@ begin else write_s("false") end -end; +end proc write_c(value: Char); begin write(0, @value, 1) -end; +end proc write_i(value: Int); var @@ -136,44 +142,54 @@ begin n := n + 1; write_c(buffer[n]) end -end; +end proc write_u(value: Word); begin write_i(value) -end; +end proc is_digit(c: Char): Bool; begin return cast(c as Int) >= cast('0' as Int) and cast(c as Int) <= cast('9' as Int) -end; +end proc is_alpha(c: Char): Bool; begin return cast(c as Int) >= cast('A' as Int) and cast(c as Int) <= cast('z' as Int) -end; +end proc is_alnum(c: Char): Bool; begin return is_digit(c) or is_alpha(c) -end; +end proc is_space(c: Char): Bool; begin return c = ' ' or c = '\n' or c = '\t' -end; +end + +proc string_equals_chars(this: String, that: pointer to Char, length: Word): Bool; +var + i: Word; +begin + if this.length <> length then + return false + end; + return strncmp(this.ptr, that, length) = 0 +end (* End of standard procedures. *) -proc read_source(filename: String): pointer to Char; +proc read_source(filename: pointer to Char): pointer to Char; var input_file: pointer to FILE, source_size: Int, input: pointer to Byte; begin - input_file := fopen(filename, "rb"); + input_file := fopen(filename, "rb\0".ptr); if input_file = nil then return nil @@ -196,7 +212,7 @@ begin fclose(input_file); return input -end; +end proc escape_char(escape: Char, result: pointer to Char): Bool; begin @@ -239,7 +255,7 @@ begin else return false end -end; +end proc skip_spaces(input: pointer to Char): pointer to Char; begin @@ -247,7 +263,7 @@ begin input := input + 1 end; return input -end; +end proc lex_identifier(input: pointer to Char): pointer to Char; begin @@ -255,7 +271,7 @@ begin input := input + 1 end; return input -end; +end proc lex_comment(input: pointer to Char): pointer to Char; var @@ -270,7 +286,7 @@ begin input := next end; return nil -end; +end proc lex_character(input: pointer to Char, current_token: pointer to Token): pointer to Char; begin @@ -284,7 +300,7 @@ begin input := input + 1 end; return input -end; +end proc lex_string(input: pointer to Char, current_token: pointer to Token): pointer to Char; var @@ -324,7 +340,7 @@ begin end; return token_end -end; +end proc print_tokens(tokens: pointer to Token, tokens_size: Word); var @@ -395,7 +411,7 @@ begin write_s("SIZEOF") elsif current_token^.kind = TOKEN_IDENTIFIER then write_c('<'); - write_s(current_token^.value.string_value); + write_z(current_token^.value.string_value); write_c('>') elsif current_token^.kind = TOKEN_LEFT_PAREN then write_s("(") @@ -457,6 +473,8 @@ begin write_s("c>") elsif current_token^.kind = TOKEN_STRING then write_s("\"...\"") + elsif current_token^.kind = TOKEN_DEFER then + write_s("DEFER") else write_s("UNKNOWN<"); write_i(current_token^.kind); @@ -467,72 +485,74 @@ begin i := i + 1u end; write_c('\n') -end; +end proc categorize_identifier(input_pointer: pointer to Char, token_length: Int): Token; var current_token: Token; begin - if strncmp("if", input_pointer, token_length) = 0 then + if string_equals_chars("if", input_pointer, token_length) then current_token.kind := TOKEN_IF - elsif strncmp("then", input_pointer, token_length) = 0 then + elsif string_equals_chars("then", input_pointer, token_length) then current_token.kind := TOKEN_THEN - elsif strncmp("else", input_pointer, token_length) = 0 then + elsif string_equals_chars("else", input_pointer, token_length) then current_token.kind := TOKEN_ELSE - elsif strncmp("elsif", input_pointer, token_length) = 0 then + elsif string_equals_chars("elsif", input_pointer, token_length) then current_token.kind := TOKEN_ELSIF - elsif strncmp("while", input_pointer, token_length) = 0 then + elsif string_equals_chars("while", input_pointer, token_length) then current_token.kind := TOKEN_WHILE - elsif strncmp("do", input_pointer, token_length) = 0 then + elsif string_equals_chars("do", input_pointer, token_length) then current_token.kind := TOKEN_DO - elsif strncmp("proc", input_pointer, token_length) = 0 then + elsif string_equals_chars("proc", input_pointer, token_length) then current_token.kind := TOKEN_PROC - elsif strncmp("begin", input_pointer, token_length) = 0 then + elsif string_equals_chars("begin", input_pointer, token_length) then current_token.kind := TOKEN_BEGIN - elsif strncmp("end", input_pointer, token_length) = 0 then + elsif string_equals_chars("end", input_pointer, token_length) then current_token.kind := TOKEN_END - elsif strncmp("extern", input_pointer, token_length) = 0 then + elsif string_equals_chars("extern", input_pointer, token_length) then current_token.kind := TOKEN_EXTERN - elsif strncmp("const", input_pointer, token_length) = 0 then + elsif string_equals_chars("const", input_pointer, token_length) then current_token.kind := TOKEN_CONST - elsif strncmp("var", input_pointer, token_length) = 0 then + elsif string_equals_chars("var", input_pointer, token_length) then current_token.kind := TOKEN_VAR - elsif strncmp("array", input_pointer, token_length) = 0 then + elsif string_equals_chars("array", input_pointer, token_length) then current_token.kind := TOKEN_ARRAY - elsif strncmp("of", input_pointer, token_length) = 0 then + elsif string_equals_chars("of", input_pointer, token_length) then current_token.kind := TOKEN_OF - elsif strncmp("type", input_pointer, token_length) = 0 then + elsif string_equals_chars("type", input_pointer, token_length) then current_token.kind := TOKEN_TYPE - elsif strncmp("record", input_pointer, token_length) = 0 then + elsif string_equals_chars("record", input_pointer, token_length) then current_token.kind := TOKEN_RECORD - elsif strncmp("union", input_pointer, token_length) = 0 then + elsif string_equals_chars("union", input_pointer, token_length) then current_token.kind := TOKEN_UNION - elsif strncmp("pointer", input_pointer, token_length) = 0 then + elsif string_equals_chars("pointer", input_pointer, token_length) then current_token.kind := TOKEN_POINTER - elsif strncmp("to", input_pointer, token_length) = 0 then + elsif string_equals_chars("to", input_pointer, token_length) then current_token.kind := TOKEN_TO - elsif strncmp("true", input_pointer, token_length) = 0 then + elsif string_equals_chars("true", input_pointer, token_length) then current_token.kind := TOKEN_BOOLEAN; current_token.value.boolean_value := true - elsif strncmp("false", input_pointer, token_length) = 0 then + elsif string_equals_chars("false", input_pointer, token_length) then current_token.kind := TOKEN_BOOLEAN; current_token.value.boolean_value := false - elsif strncmp("nil", input_pointer, token_length) = 0 then + elsif string_equals_chars("nil", input_pointer, token_length) then current_token.kind := TOKEN_NIL - elsif strncmp("and", input_pointer, token_length) = 0 then + elsif string_equals_chars("and", input_pointer, token_length) then current_token.kind := TOKEN_AND - elsif strncmp("or", input_pointer, token_length) = 0 then + elsif string_equals_chars("or", input_pointer, token_length) then current_token.kind := TOKEN_OR - elsif strncmp("not", input_pointer, token_length) = 0 then + elsif string_equals_chars("not", input_pointer, token_length) then current_token.kind := TOKEN_NOT - elsif strncmp("return", input_pointer, token_length) = 0 then + elsif string_equals_chars("return", input_pointer, token_length) then current_token.kind := TOKEN_RETURN - elsif strncmp("cast", input_pointer, token_length) = 0 then + elsif string_equals_chars("cast", input_pointer, token_length) then current_token.kind := TOKEN_CAST - elsif strncmp("as", input_pointer, token_length) = 0 then + elsif string_equals_chars("as", input_pointer, token_length) then current_token.kind := TOKEN_AS - elsif strncmp("sizeof", input_pointer, token_length) = 0 then + elsif string_equals_chars("sizeof", input_pointer, token_length) then current_token.kind := TOKEN_SIZEOF + elsif string_equals_chars("defer", input_pointer, token_length) then + current_token.kind := TOKEN_DEFER else current_token.kind := TOKEN_IDENTIFIER; current_token.value.string_value := cast(calloc(token_length + 1, 1) as pointer to Char); @@ -540,7 +560,7 @@ begin end; return current_token -end; +end proc tokenize(input_pointer: pointer to Char, tokens_size: pointer to Word): pointer to Token; var @@ -695,12 +715,12 @@ begin end; return tokens -end; +end proc parse_literal(tokens: pointer to pointer to Token, tokens_size: pointer to Word): pointer to Literal; begin return cast(calloc(1, sizeof(Literal)) as pointer to Literal) -end; +end proc parse_constant_definition(tokens: pointer to pointer to Token, tokens_size: pointer to Word): pointer to ConstantDefinition; @@ -715,7 +735,7 @@ begin tokens^ := tokens^ + 2u; tokens_size := tokens_size - 2u; - write_s(result^.name); + write_z(result^.name); write_c('\n'); result^.body := parse_literal(tokens, tokens_size); @@ -724,7 +744,7 @@ begin tokens_size := tokens_size - 2u; return result -end; +end proc parse_program(tokens: pointer to pointer to Token, tokens_size: pointer to Word): pointer to Program; var @@ -754,9 +774,9 @@ begin end end end -end; +end -proc parse_command_line(argc: Int, argv: pointer to pointer to Char): pointer to CommandLine; +proc parse_command_line*(argc: Int, argv: pointer to pointer to Char): pointer to CommandLine; var parameter: pointer to pointer to Char, i: Int, @@ -765,20 +785,23 @@ begin i := 1; result := cast(malloc(sizeof(CommandLine)) as pointer to CommandLine); result^.tokenize := false; + result^.syntax_tree := false; result^.input := nil; while i < argc do parameter := argv + i; - if strcmp(parameter^, "--tokenize") = 0 then + if strcmp(parameter^, "--tokenize\0".ptr) = 0 then result^.tokenize := true + elsif strcmp(parameter^, "--syntax-tree\0".ptr) = 0 then + result^.syntax_tree := true elsif parameter^^ <> '-' then result^.input := parameter^ else write_s("Fatal error: Unknown command line options:"); write_c(' '); - write_s(parameter^); + write_z(parameter^); write_s(".\n"); return nil @@ -792,7 +815,7 @@ begin end; return result -end; +end proc process(argc: Int, argv: pointer to pointer to Char): Int; var @@ -802,10 +825,10 @@ var command_line: pointer to CommandLine; begin command_line := parse_command_line(argc, argv); - - if cast(command_line as Word) = 0u then + if command_line = nil then return 2 end; + input := read_source(command_line^.input); if input = nil then perror(command_line^.input); @@ -816,10 +839,11 @@ begin if command_line^.tokenize then print_tokens(tokens, tokens_size) end; - - parse_program(@tokens, @tokens_size); + if command_line^.syntax_tree then + parse_program(@tokens, @tokens_size) + end; return 0 -end; +end begin exit(process(count, parameters))