Make procedure pointers compatible with normal pointers

11 files changed, 55 insertions, 79 deletions

diff --git a/boot/name_analysis.cc b/boot/name_analysis.cc
index 1a87927..12a14c3 100644
--- a/boot/name_analysis.cc
+++ b/boot/name_analysis.cc
@@ -152,6 +152,8 @@ namespace elna::boot
                         return "const must be written before the array size, not after";
                     case duplicate:
                         return "Duplicate 'const' qualifier is not allowed";
+                    case constant_procedure:
+                        return "Procedure types are always constant, 'const' is not allowed";
                     case module_entry:
                         return "Program entry point should have no or one argument";
                     default:
@@ -583,6 +585,11 @@ namespace elna::boot
             add_error<declaration_format_error>(expression->position(),
                     declaration_format_error::kind::duplicate);
         }
+        else if (qualified_base.get<procedure_type>() != nullptr)
+        {
+            add_error<declaration_format_error>(expression->position(),
+                    declaration_format_error::kind::constant_procedure);
+        }
         this->current_type = qualified_base.empty()
             ? type()
             : type(std::make_shared<constant_type>(qualified_base));
@@ -807,7 +814,9 @@ namespace elna::boot
     void resolving_visitor::visit(procedure_call *call)
     {
         call->callable().accept(this);
-        if (const auto procedure = call->callable().type_decoration.get<procedure_type>())
+        const type callable_type = resolve_underlying_type(call->callable().type_decoration);
+
+        if (const auto procedure = callable_type.get<procedure_type>())
         {
             call->type_decoration = procedure->return_type;
         }
diff --git a/boot/symbol.cc b/boot/symbol.cc
index 4828070..fa423e0 100644
--- a/boot/symbol.cc
+++ b/boot/symbol.cc
@@ -808,7 +808,6 @@ namespace elna::boot
     bool is_any_pointer_type(const type& checked)
     {
         return checked.get<pointer_type>() != nullptr
-            || checked.get<procedure_type>() != nullptr
             || is_primitive_type(checked, "Pointer");
     }
 
diff --git a/boot/type_check.cc b/boot/type_check.cc
index 82c910f..d8a9170 100644
--- a/boot/type_check.cc
+++ b/boot/type_check.cc
@@ -233,6 +233,10 @@ namespace elna::boot
 
     std::string type_requirement_error::what() const
     {
+        const bool is_procedure = resolve_underlying_type(this->actual).get<procedure_type>() != nullptr;
+        const std::string opaque_subject = (is_procedure ? "Procedure type '" : "Opaque type '")
+            + this->actual.to_string();
+
         switch (this->m_kind)
         {
             using enum kind;
@@ -255,26 +259,19 @@ namespace elna::boot
                 return "Type '" + this->actual.to_string()
                     + "' cannot be dereferenced, it is not a pointer";
             case opaque_variable:
-                return "Opaque type '" + this->actual.to_string()
-                    + "' cannot be used to declare a variable";
+                return opaque_subject + "' cannot be used to declare a variable";
             case opaque_parameter:
-                return "Opaque type '" + this->actual.to_string()
-                    + "' cannot be used as a procedure parameter";
+                return opaque_subject + "' cannot be used as a procedure parameter";
             case opaque_return:
-                return "Opaque type '" + this->actual.to_string()
-                    + "' cannot be used as a return type";
+                return opaque_subject + "' cannot be used as a return type";
             case opaque_field:
-                return "Opaque type '" + this->actual.to_string()
-                    + "' cannot be used as a record field type";
+                return opaque_subject + "' cannot be used as a record field type";
             case opaque_element:
-                return "Opaque type '" + this->actual.to_string()
-                    + "' cannot be used as an array or slice element type";
+                return opaque_subject + "' cannot be used as an array or slice element type";
             case opaque_cast:
-                return "Opaque type '" + this->actual.to_string()
-                    + "' cannot be used as a cast target type";
+                return opaque_subject + "' cannot be used as a cast target type";
             case opaque_arithmetic:
-                return "Opaque type '" + this->actual.to_string()
-                    + "' cannot be used as an element type in pointer arithmetic";
+                return opaque_subject + "' cannot be used as an element type in pointer arithmetic";
             case dereference_of_parameter:
                 return "Type parameter '" + this->actual.to_string()
                     + "' cannot be dereferenced, its pointee is unknown";
@@ -342,7 +339,7 @@ namespace elna::boot
     {
         const type referent = resolve_aliases(checked);
 
-        if (referent.get<constant_type>() != nullptr)
+        if (referent.get<constant_type>() != nullptr || referent.get<procedure_type>() != nullptr)
         {
             return true;
         }
@@ -367,7 +364,8 @@ namespace elna::boot
 
     /*
      * Finds the first opaque type in a value position, following aliases,
-     * qualifiers, arrays, slices, records and procedures but not pointers.
+     * qualifiers, arrays, slices and records but not pointers. A procedure is
+     * opaque too: it has no size and is only reachable through a pointer.
      * A pointer doesn't store its base type by value, so an opaque behind it
      * is only reachable as a transient value. A slice does: indexing, slicing
      * and taking an element's address all scale by the element size.
@@ -377,7 +375,8 @@ namespace elna::boot
         const type underlying = resolve_underlying_type(checked);
 
         if (underlying.get<extern_type>() != nullptr
-                || underlying.get<parameter_type>() != nullptr)
+                || underlying.get<parameter_type>() != nullptr
+                || underlying.get<procedure_type>() != nullptr)
         {
             return checked;
         }
@@ -402,26 +401,13 @@ namespace elna::boot
         {
             return find_opaque_type(slice->base);
         }
-        else if (const auto procedure = referent.get<procedure_type>())
-        {
-            for (const type& parameter : procedure->parameters)
-            {
-                if (const auto opaque = find_opaque_type(parameter))
-                {
-                    return opaque;
-                }
-            }
-            return !procedure->return_type.empty()
-                ? find_opaque_type(procedure->return_type)
-                : std::nullopt;
-        }
         return std::nullopt;
     }
 
     /*
      * Scaling an offset needs the pointee size, which neither an opaque type
      * nor a type parameter has. Only a pointer_type scales; the generic
-     * Pointer and procedure values advance byte-wise.
+     * Pointer advances byte-wise.
      */
     static std::optional<type> find_arithmetic_violation(binary_operator operation,
             const type& lhs, const type& rhs)
@@ -1403,7 +1389,9 @@ namespace elna::boot
     {
         const type resolved = resolve_underlying_type(argument.type_decoration);
 
-        if (resolved.get<array_type>() != nullptr || resolved.get<slice_type>() != nullptr)
+        if (resolved.get<array_type>() != nullptr
+                || resolved.get<slice_type>() != nullptr
+                || resolved.get<procedure_type>() != nullptr)
         {
             add_error<type_requirement_error>(argument.position(), argument.type_decoration,
                     type_requirement_error::kind::variadic_argument);
@@ -1435,7 +1423,7 @@ namespace elna::boot
         call->callable().accept(this);
         this->in_callable_position = false;
 
-        type callable_type = call->callable().type_decoration;
+        type callable_type = resolve_underlying_type(call->callable().type_decoration);
         std::shared_ptr<procedure_info> inferred;
 
         if (reference != nullptr && reference->arguments.empty())
@@ -1770,7 +1758,8 @@ namespace elna::boot
                 break;
             case equals:
             case not_equals:
-                valid = is_equality_compatible(lhs_resolved, rhs_resolved);
+                valid = lhs_resolved.get<procedure_type>() == nullptr
+                    && is_equality_compatible(lhs_resolved, rhs_resolved);
                 break;
             case shift_left:
             case shift_right:
diff --git a/gcc/gcc/elna-builtins.cc b/gcc/gcc/elna-builtins.cc
index 643b988..56950e3 100644
--- a/gcc/gcc/elna-builtins.cc
+++ b/gcc/gcc/elna-builtins.cc
@@ -293,9 +293,7 @@ namespace elna::gcc
         }
         else if (const auto reference = type.get<boot::procedure_type>())
         {
-            tree procedure = build_procedure_type(*reference, symbols);
-
-            return build_pointer_type(procedure);
+            return build_procedure_type(*reference, symbols);
         }
         else if (const auto reference = type.get<boot::constant_type>())
         {
diff --git a/gcc/gcc/elna-generic.cc b/gcc/gcc/elna-generic.cc
index fcc4c64..77ff61f 100644
--- a/gcc/gcc/elna-generic.cc
+++ b/gcc/gcc/elna-generic.cc
@@ -53,7 +53,6 @@ namespace elna::gcc
         for (std::size_t i = 0; i < arguments.size(); ++i)
         {
             arguments.at(i)->accept(this);
-            this->current_expression = prepare_rvalue(this->current_expression);
 
             tree passed_type = get_inner_alias(argument_types.at(i), this->symbols);
             const bool scalar_target = INTEGRAL_TYPE_P(passed_type)
@@ -108,8 +107,7 @@ namespace elna::gcc
         tree pointee = get_inner_alias(accessed, this->symbols);
         // NOLINTNEXTLINE(bugprone-signed-bitwise)
         tree qualified = build_qualified_type(pointee, TYPE_QUALS(pointee) | TYPE_QUAL_VOLATILE);
-        tree address = fold_convert_loc(location, build_pointer_type(qualified),
-                prepare_rvalue(this->current_expression));
+        tree address = fold_convert_loc(location, build_pointer_type(qualified), this->current_expression);
         tree reference = build_simple_mem_ref_loc(location, address);
 
         TREE_THIS_VOLATILE(reference) = 1;
@@ -132,7 +130,7 @@ namespace elna::gcc
                 *call->arguments.at(0), call->argument_types.at(1));
 
         call->arguments.at(1)->accept(this);
-        tree value = prepare_rvalue(this->current_expression);
+        tree value = this->current_expression;
 
         this->current_expression = build2_loc(call_location, MODIFY_EXPR, void_type_node,
                 target, value);
@@ -178,13 +176,7 @@ namespace elna::gcc
 
         if (TREE_CODE(expression_type) == FUNCTION_TYPE)
         {
-            this->current_expression = build1(ADDR_EXPR,
-                    build_pointer_type(expression_type), this->current_expression);
-            build_procedure_call(call_location, this->current_expression,
-                    call->arguments, call->argument_types);
-        }
-        else if (POINTER_TYPE_P(expression_type) && TREE_CODE(TREE_TYPE(expression_type)) == FUNCTION_TYPE)
-        {
+            this->current_expression = build_fold_addr_expr_loc(call_location, this->current_expression);
             build_procedure_call(call_location, this->current_expression,
                     call->arguments, call->argument_types);
         }
@@ -199,7 +191,6 @@ namespace elna::gcc
         tree cast_target = get_inner_alias(expression->type_decoration, this->symbols);
 
         expression->value().accept(this);
-        this->current_expression = prepare_rvalue(this->current_expression);
         const location_t cast_location = get_location(&expression->position());
         const std::shared_ptr<boot::slice_type> source_slice =
             resolve_underlying_type(expression->value().type_decoration).get<boot::slice_type>();
@@ -825,7 +816,6 @@ namespace elna::gcc
                 {
                     TREE_ADDRESSABLE(this->current_expression) = 1;
                 }
-                this->current_expression = prepare_rvalue(this->current_expression);
                 this->current_expression = build_fold_addr_expr_with_type_loc(location,
                         this->current_expression,
                         build_pointer_type(TREE_TYPE(this->current_expression)));
@@ -961,7 +951,7 @@ namespace elna::gcc
         const location_t statement_location = get_location(&statement->position());
 
         statement->rvalue().accept(this);
-        tree rvalue = prepare_rvalue(this->current_expression);
+        tree rvalue = this->current_expression;
 
         tree assignment = fold_build2_loc(statement_location, MODIFY_EXPR, void_type_node, lvalue, rvalue);
         append_statement(assignment);
diff --git a/gcc/gcc/elna-tree.cc b/gcc/gcc/elna-tree.cc
index e762b8e..b6384f8 100644
--- a/gcc/gcc/elna-tree.cc
+++ b/gcc/gcc/elna-tree.cc
@@ -38,18 +38,6 @@ namespace elna::gcc
         return RECORD_OR_UNION_TYPE_P(type) || TREE_CODE(type) == ENUMERAL_TYPE;
     }
 
-    tree prepare_rvalue(tree rvalue)
-    {
-        if (DECL_P(rvalue) && TREE_CODE(TREE_TYPE(rvalue)) == FUNCTION_TYPE)
-        {
-            return build1(ADDR_EXPR, build_pointer_type(TREE_TYPE(rvalue)), rvalue);
-        }
-        else
-        {
-            return rvalue;
-        }
-    }
-
     void append_statement(tree statement_tree)
     {
         if (!vec_safe_is_empty(f_binding_level->defers))
diff --git a/include/elna/boot/name_analysis.h b/include/elna/boot/name_analysis.h
index 4e13df1..d3f6f10 100644
--- a/include/elna/boot/name_analysis.h
+++ b/include/elna/boot/name_analysis.h
@@ -130,6 +130,7 @@ namespace elna::boot
         {
             array_position,
             duplicate,
+            constant_procedure,
             module_entry
         };
         struct not_initialized
diff --git a/include/elna/boot/symbol.h b/include/elna/boot/symbol.h
index 705cb29..0d07b88 100644
--- a/include/elna/boot/symbol.h
+++ b/include/elna/boot/symbol.h
@@ -820,8 +820,8 @@ namespace elna::boot
     /**
      * Checks whether the given type is a pointer type.
      *
-     * A pointer type is considered to be a variable pointer, a procedure
-     * pointer, or a built-in Pointer.
+     * A pointer type is considered to be a typed pointer, including a pointer
+     * to a procedure, or a built-in Pointer.
      *
      * \param checked The type to check.
      * \return Whether the type is a pointer type.
diff --git a/include/elna/gcc/elna-tree.h b/include/elna/gcc/elna-tree.h
index a3a9106..6dd3616 100644
--- a/include/elna/gcc/elna-tree.h
+++ b/include/elna/gcc/elna-tree.h
@@ -38,15 +38,6 @@ namespace elna::gcc
 
     bool is_integral_type(tree type);
     bool is_unique_type(tree type);
-    /**
-     * Prepares a value to be bound to a variable or parameter.
-     *
-     * If rvalue is a procedure declaration, builds a procedure pointer.
-     *
-     * \param rvalue Value to be assigned.
-     * \return Processed value.
-     */
-    tree prepare_rvalue(tree rvalue);
 
     void append_statement(tree statement_tree);
     void defer(tree statement_tree);
diff --git a/testsuite/fail_compilation/assign_procedure.elna b/testsuite/fail_compilation/assign_procedure.elna
new file mode 100644
index 0000000..7d69724
--- /dev/null
+++ b/testsuite/fail_compilation/assign_procedure.elna
@@ -0,0 +1,11 @@
+module
+
+proc f()
+return
+
+proc g()
+begin
+  f := g (* @Error Cannot assign to a value of type 'proc\(\)', because it is constant or contains constant members *)
+return
+
+end.
diff --git a/testsuite/runnable/procedure_cast.elna b/testsuite/runnable/procedure_cast.elna
index 191afbf..d724e38 100644
--- a/testsuite/runnable/procedure_cast.elna
+++ b/testsuite/runnable/procedure_cast.elna
@@ -1,11 +1,11 @@
 program()
 var
-  cb: proc(x: ^Char) -> Int
+  cb: ^proc(x: ^Char) -> Int
 
 proc probe_int(x: ^Int) -> Int
 return 42
 
 begin
-  cb := cast(probe_int: proc(x: ^Char) -> Int);
-  assert(cb(nil) = 42)
+  cb := cast(@probe_int: ^proc(x: ^Char) -> Int);
+  assert(cb^(nil) = 42)
 end.