Implement named blocks

13 files changed, 275 insertions, 13 deletions

diff --git a/boot/ast.cc b/boot/ast.cc
index 04e9230..4a596e5 100644
--- a/boot/ast.cc
+++ b/boot/ast.cc
@@ -112,6 +112,16 @@ namespace elna::boot
         __builtin_unreachable();
     }
 
+    void empty_visitor::visit(block_statement *)
+    {
+        __builtin_unreachable();
+    }
+
+    void empty_visitor::visit(break_statement *)
+    {
+        __builtin_unreachable();
+    }
+
     void empty_visitor::visit(empty_statement *)
     {
         __builtin_unreachable();
@@ -306,12 +316,24 @@ namespace elna::boot
 
     void walking_visitor::visit(defer_statement *statement)
     {
-        for (auto *block_statement : statement->statements)
+        for (auto *body_statement : statement->statements)
+        {
+            body_statement->accept(this);
+        }
+    }
+
+    void walking_visitor::visit(block_statement *statement)
+    {
+        for (auto *body_statement : statement->statements)
         {
-            block_statement->accept(this);
+            body_statement->accept(this);
         }
     }
 
+    void walking_visitor::visit(break_statement *)
+    {
+    }
+
     void walking_visitor::visit(empty_statement *)
     {
     }
@@ -325,16 +347,16 @@ namespace elna::boot
             {
                 case_label->accept(this);
             }
-            for (auto *block_statement : case_block.statements)
+            for (auto *body_statement : case_block.statements)
             {
-                block_statement->accept(this);
+                body_statement->accept(this);
             }
         }
         if (statement->alternative != nullptr)
         {
-            for (auto *block_statement : *statement->alternative)
+            for (auto *body_statement : *statement->alternative)
             {
-                block_statement->accept(this);
+                body_statement->accept(this);
             }
         }
     }
@@ -1171,6 +1193,35 @@ namespace elna::boot
         }
     }
 
+    block_statement::block_statement(const source_position position, identifier&& name,
+            std::vector<statement *>&& statements)
+        : node(position), name(std::move(name)), statements(std::move(statements))
+    {
+    }
+
+    void block_statement::accept(parser_visitor *visitor)
+    {
+        visitor->visit(this);
+    }
+
+    block_statement::~block_statement()
+    {
+        for (const statement *body_statement : statements)
+        {
+            delete body_statement;
+        }
+    }
+
+    break_statement::break_statement(const source_position position, identifier&& label)
+        : node(position), label(std::move(label))
+    {
+    }
+
+    void break_statement::accept(parser_visitor *visitor)
+    {
+        visitor->visit(this);
+    }
+
     void empty_statement::accept(parser_visitor *visitor)
     {
         visitor->visit(this);
diff --git a/boot/lexer.ll b/boot/lexer.ll
index 1cccd35..3d881e3 100644
--- a/boot/lexer.ll
+++ b/boot/lexer.ll
@@ -179,6 +179,12 @@ cast {
 defer {
     return yy::parser::make_DEFER(this->location);
 }
+block {
+    return yy::parser::make_BLOCK(this->location);
+}
+break {
+    return yy::parser::make_BREAK(this->location);
+}
 case {
     return yy::parser::make_CASE(this->location);
 }
diff --git a/boot/name_analysis.cc b/boot/name_analysis.cc
index 8820684..9ba030c 100644
--- a/boot/name_analysis.cc
+++ b/boot/name_analysis.cc
@@ -48,8 +48,14 @@ namespace elna::boot
                         return "Trait '#" + this->name + "' not declared";
                     case undeclared_symbol:
                         return "Symbol '" + this->name + "' not declared";
+                    case undeclared_label:
+                        return "Label '" + this->name + "' not declared";
                     case not_a_type:
                         return "'" + this->name + "' is not a type";
+                    case not_a_label:
+                        return "'" + this->name + "' is not a label";
+                    case break_leaves_defer:
+                        return "'break' cannot leave a defer statement";
                     default:
                         __builtin_unreachable();
                 }
@@ -781,9 +787,64 @@ namespace elna::boot
 
     void resolving_visitor::visit(defer_statement *statement)
     {
-        for (auto *block_statement : statement->statements)
+        ++this->defer_depth;
+        for (auto *body_statement : statement->statements)
         {
-            block_statement->accept(this);
+            body_statement->accept(this);
+        }
+        --this->defer_depth;
+    }
+
+    void resolving_visitor::visit(block_statement *statement)
+    {
+        const std::string& label_name = statement->name.name();
+
+        this->bag.enter();
+
+        auto label_symbol = std::make_shared<label_info>(this->defer_depth);
+        label_symbol->position.emplace(statement->name.position());
+        label_symbol->file = this->module_file;
+
+        if (!this->bag.enter(label_name, label_symbol))
+        {
+            auto original = this->bag.lookup(label_name);
+            symbol_declaration_error::redefinition original_definition{
+                .original = original->position,
+                .file = this->redefinition_file(original)
+            };
+            add_error<symbol_declaration_error>(statement->name.position(),
+                    label_name, original_definition);
+        }
+        for (auto *body_statement : statement->statements)
+        {
+            body_statement->accept(this);
+        }
+        this->bag.leave();
+    }
+
+    void resolving_visitor::visit(break_statement *statement)
+    {
+        const std::string& label_name = statement->label.name();
+        const source_position position = statement->label.position();
+        const std::shared_ptr<info> symbol = this->bag.lookup(label_name);
+
+        if (symbol == nullptr)
+        {
+            add_error<symbol_declaration_error>(position, label_name,
+                    symbol_declaration_error::kind::undeclared_label);
+            return;
+        }
+        auto label_symbol = symbol->is_label();
+
+        if (label_symbol == nullptr)
+        {
+            add_error<symbol_declaration_error>(position, label_name,
+                    symbol_declaration_error::kind::not_a_label);
+        }
+        else if (label_symbol->defer_depth != this->defer_depth)
+        {
+            add_error<symbol_declaration_error>(position, label_name,
+                    symbol_declaration_error::kind::break_leaves_defer);
         }
     }
 
@@ -800,16 +861,16 @@ namespace elna::boot
             {
                 case_label->accept(this);
             }
-            for (auto *block_statement : case_block.statements)
+            for (auto *body_statement : case_block.statements)
             {
-                block_statement->accept(this);
+                body_statement->accept(this);
             }
         }
         if (statement->alternative != nullptr)
         {
-            for (auto *block_statement : *statement->alternative)
+            for (auto *body_statement : *statement->alternative)
             {
-                block_statement->accept(this);
+                body_statement->accept(this);
             }
         }
     }
diff --git a/boot/parser.yy b/boot/parser.yy
index ab386fe..eaf1a7c 100644
--- a/boot/parser.yy
+++ b/boot/parser.yy
@@ -112,6 +112,8 @@ along with GCC; see the file COPYING3.  If not see
     BEGIN_BLOCK "begin"
     END_BLOCK "end"
     DEFER "defer"
+    BLOCK "block"
+    BREAK "break"
     CASE "case"
     OF "of"
     TO "to"
@@ -582,6 +584,10 @@ statement:
     | call_expression { $$ = $1.release(); }
     | "defer" statements "end"
         { $$ = new boot::defer_statement(boot::make_position(@$), $2); }
+    | "block" identifier statements "end"
+        { $$ = new boot::block_statement(boot::make_position(@$), std::move(*$2), $3); }
+    | "break" identifier
+        { $$ = new boot::break_statement(boot::make_position(@$), std::move(*$2)); }
     | "case" expression "of" switch_cases else_statements "end"
         { $$ = new boot::case_statement(boot::make_position(@$), $2, $4, $5); }
     | %empty { $$ = new boot::empty_statement(boot::make_position(@$)); }
diff --git a/boot/symbol.cc b/boot/symbol.cc
index 55f91ea..58524ad 100644
--- a/boot/symbol.cc
+++ b/boot/symbol.cc
@@ -310,6 +310,11 @@ namespace elna::boot
         return nullptr;
     }
 
+    std::shared_ptr<label_info> info::is_label()
+    {
+        return nullptr;
+    }
+
     type_info::type_info(const type& symbol)
         : symbol(symbol), owner(symbol.get<alias_type>())
     {
@@ -346,6 +351,16 @@ namespace elna::boot
         return std::static_pointer_cast<variable_info>(shared_from_this());
     }
 
+    label_info::label_info(std::size_t defer_depth)
+        : defer_depth(defer_depth)
+    {
+    }
+
+    std::shared_ptr<label_info> label_info::is_label()
+    {
+        return std::static_pointer_cast<label_info>(shared_from_this());
+    }
+
     static void builtin_integers(const std::shared_ptr<symbol_table>& symbols,
             const std::array<type_properties, target_integer_count>& properties,
             const std::string& integer_name)
diff --git a/boot/validation.cc b/boot/validation.cc
index 2125a99..e628cd8 100644
--- a/boot/validation.cc
+++ b/boot/validation.cc
@@ -157,6 +157,15 @@ namespace elna::boot
         visit_statements(statement->statements);
     }
 
+    void validation_visitor::visit(block_statement *statement)
+    {
+        visit_statements(statement->statements);
+    }
+
+    void validation_visitor::visit(break_statement *)
+    {
+    }
+
     void validation_visitor::visit(empty_statement *)
     {
     }
diff --git a/gcc/gcc/elna-generic.cc b/gcc/gcc/elna-generic.cc
index 3b43f5e..60ed82b 100644
--- a/gcc/gcc/elna-generic.cc
+++ b/gcc/gcc/elna-generic.cc
@@ -1165,6 +1165,31 @@ namespace elna::gcc
         defer(leave_scope());
     }
 
+    void generic_visitor::visit(boot::block_statement *statement)
+    {
+        const location_t block_location = get_location(&statement->name.position());
+        tree end_label = create_artificial_label(block_location);
+
+        enter_scope();
+        this->symbols->enter(statement->name.name(), end_label);
+        visit_statements(statement->statements);
+        append_statement(leave_scope());
+
+        // The label sits outside the binding, so that a break leaving the block
+        // runs the defers registered in it.
+        append_statement(build1(LABEL_EXPR, void_type_node, end_label));
+        this->current_expression = NULL_TREE;
+    }
+
+    void generic_visitor::visit(boot::break_statement *statement)
+    {
+        tree end_label = this->symbols->lookup(statement->label.name());
+
+        TREE_USED(end_label) = 1;
+        this->current_expression = build1_loc(get_location(&statement->position()),
+                GOTO_EXPR, void_type_node, end_label);
+    }
+
     void generic_visitor::visit(boot::empty_statement *)
     {
     }
diff --git a/include/elna/boot/ast.h b/include/elna/boot/ast.h
index ffc57de..4eea412 100644
--- a/include/elna/boot/ast.h
+++ b/include/elna/boot/ast.h
@@ -148,6 +148,8 @@ namespace elna::boot
     template<literal_type T>
     class literal;
     class defer_statement;
+    class block_statement;
+    class break_statement;
     class empty_statement;
 
     /**
@@ -171,6 +173,8 @@ namespace elna::boot
         virtual void visit(repeat_statement *) = 0;
         virtual void visit(for_statement *) = 0;
         virtual void visit(defer_statement *) = 0;
+        virtual void visit(block_statement *) = 0;
+        virtual void visit(break_statement *) = 0;
         virtual void visit(case_statement *) = 0;
         virtual void visit(empty_statement *) = 0;
         virtual void visit(unit *) = 0;
@@ -223,6 +227,8 @@ namespace elna::boot
         [[noreturn]] void visit(repeat_statement *) override;
         [[noreturn]] void visit(for_statement *) override;
         [[noreturn]] void visit(defer_statement *) override;
+        [[noreturn]] void visit(block_statement *) override;
+        [[noreturn]] void visit(break_statement *) override;
         [[noreturn]] void visit(empty_statement *) override;
         [[noreturn]] void visit(case_statement *) override;
         [[noreturn]] void visit(procedure_call *) override;
@@ -271,6 +277,8 @@ namespace elna::boot
         void visit(repeat_statement *statement) override;
         void visit(for_statement *statement) override;
         void visit(defer_statement *statement) override;
+        void visit(block_statement *statement) override;
+        void visit(break_statement *) override;
         void visit(empty_statement *) override;
         void visit(case_statement *statement) override;
         void visit(procedure_call *call) override;
@@ -1104,6 +1112,34 @@ namespace elna::boot
         ~defer_statement() override;
     };
 
+    /**
+     * Named block a break-statement can jump out of.
+     */
+    class block_statement : public statement
+    {
+    public:
+        const identifier name;
+        const std::vector<statement *> statements;
+
+        block_statement(const source_position position, identifier&& name,
+                std::vector<statement *>&& statements);
+        void accept(parser_visitor *visitor) override;
+
+        ~block_statement() override;
+    };
+
+    /**
+     * Jump to the end of the named block.
+     */
+    class break_statement : public statement
+    {
+    public:
+        const identifier label;
+
+        break_statement(const source_position position, identifier&& label);
+        void accept(parser_visitor *visitor) override;
+    };
+
     class empty_statement : public statement
     {
     public:
diff --git a/include/elna/boot/name_analysis.h b/include/elna/boot/name_analysis.h
index eff122b..67cd713 100644
--- a/include/elna/boot/name_analysis.h
+++ b/include/elna/boot/name_analysis.h
@@ -43,7 +43,10 @@ namespace elna::boot
             undeclared_type,
             undeclared_trait,
             undeclared_symbol,
-            not_a_type
+            undeclared_label,
+            not_a_type,
+            not_a_label,
+            break_leaves_defer
         };
         struct redefinition
         {
@@ -208,6 +211,8 @@ namespace elna::boot
         symbol_bag& bag;
         evaluator constant_evaluator;
         std::filesystem::path module_file;
+        /// Number of defer bodies the visited statement stands in.
+        std::size_t defer_depth{ 0 };
 
         resolving_visitor(symbol_bag& bag, const target_info& target,
                 const std::filesystem::path& module_path);
@@ -310,6 +315,8 @@ namespace elna::boot
         void visit(while_statement *statement) override;
         void visit(repeat_statement *statement) override;
         void visit(defer_statement *statement) override;
+        void visit(block_statement *statement) override;
+        void visit(break_statement *statement) override;
         void visit(empty_statement *) override;
         void visit(case_statement *statement) override;
 
diff --git a/include/elna/boot/symbol.h b/include/elna/boot/symbol.h
index 08292bc..5bbe2c6 100644
--- a/include/elna/boot/symbol.h
+++ b/include/elna/boot/symbol.h
@@ -271,6 +271,7 @@ namespace elna::boot
     class type_info;
     class procedure_info;
     class variable_info;
+    class label_info;
 
     class info : public std::enable_shared_from_this<info>
     {
@@ -285,6 +286,7 @@ namespace elna::boot
         virtual std::shared_ptr<type_info> is_type();
         virtual std::shared_ptr<procedure_info> is_procedure();
         virtual std::shared_ptr<variable_info> is_variable();
+        virtual std::shared_ptr<label_info> is_label();
     };
 
     /**
@@ -501,6 +503,28 @@ namespace elna::boot
         std::shared_ptr<variable_info> is_variable() override;
     };
 
+    /**
+     * Named block a break-statement can jump to.
+     */
+    class label_info : public info
+    {
+    public:
+        /**
+         * Constructs a label symbol information.
+         *
+         * \param defer_depth Number of defer bodies enclosing the block.
+         */
+        explicit label_info(std::size_t defer_depth);
+
+        std::shared_ptr<label_info> is_label() override;
+
+        /*
+         * A break may not leave the defer body it stands in, so a label
+         * declared outside that body is not a valid target.
+         */
+        const std::size_t defer_depth;
+    };
+
     std::shared_ptr<symbol_table> builtin_symbol_table(const target_info& target);
 
     /**
diff --git a/include/elna/boot/validation.h b/include/elna/boot/validation.h
index 8598ada..87e0b18 100644
--- a/include/elna/boot/validation.h
+++ b/include/elna/boot/validation.h
@@ -65,6 +65,8 @@ namespace elna::boot
         void visit(repeat_statement *statement) override;
         void visit(for_statement *statement) override;
         void visit(defer_statement *statement) override;
+        void visit(block_statement *statement) override;
+        void visit(break_statement *) override;
         void visit(empty_statement *) override;
         void visit(procedure_call *) override;
     };
diff --git a/include/elna/gcc/elna-generic.h b/include/elna/gcc/elna-generic.h
index dde883a..b05a8f9 100644
--- a/include/elna/gcc/elna-generic.h
+++ b/include/elna/gcc/elna-generic.h
@@ -103,6 +103,8 @@ namespace elna::gcc
         void visit(boot::for_statement *statement) override;
         void visit(boot::while_statement *statement) override;
         void visit(boot::defer_statement *statement) override;
+        void visit(boot::block_statement *statement) override;
+        void visit(boot::break_statement *statement) override;
         void visit(boot::empty_statement *) override;
         void visit(boot::case_statement *statement) override;
     };
diff --git a/testsuite/runnable/named_block.elna b/testsuite/runnable/named_block.elna
new file mode 100644
index 0000000..a9c44ed
--- /dev/null
+++ b/testsuite/runnable/named_block.elna
@@ -0,0 +1,18 @@
+var
+  counter: Int := 0
+
+program()
+begin
+  block outer
+    while true do
+      defer
+        counter := counter + 10
+      end;
+      counter := counter + 1;
+      break outer
+    end
+  end;
+  assert(counter = 11)
+return 0u8
+
+end.