Handle const Pointer as const pointer to const data

11 files changed, 793 insertions, 623 deletions

diff --git a/boot/dependency.cc b/boot/dependency.cc
index 84fd800..ada0bac 100644
--- a/boot/dependency.cc
+++ b/boot/dependency.cc
@@ -22,7 +22,8 @@ along with GCC; see the file COPYING3.  If not see
 #include <string.h>
 
 #include "elna/boot/driver.h"
-#include "elna/boot/semantic.h"
+#include "elna/boot/name_analysis.h"
+#include "elna/boot/type_check.h"
 #include "parser.hh"
 
 namespace elna::boot
diff --git a/boot/semantic.cc b/boot/name_analysis.cc
index c987cfd..cfc4e35 100644
--- a/boot/semantic.cc
+++ b/boot/name_analysis.cc
@@ -15,7 +15,7 @@ You should have received a copy of the GNU General Public License
 along with GCC; see the file COPYING3.  If not see
 <http://www.gnu.org/licenses/>.  */
 
-#include "elna/boot/semantic.h"
+#include "elna/boot/name_analysis.h"
 
 #include <algorithm>
 
@@ -61,175 +61,6 @@ namespace elna::boot
         return std::nullopt;
     }
 
-    type_mismatch_error::type_mismatch_error(const source_position position,
-            type expected, type actual)
-        : error(position), expected(expected), actual(actual)
-    {
-    }
-
-    std::string type_mismatch_error::what() const
-    {
-        return "Expected type '" + expected.to_string()
-            + "', but got '" + actual.to_string() + "'";
-    }
-
-    constant_assignment_error::constant_assignment_error(const source_position position,
-            type assignee)
-        : error(position), assignee(assignee)
-    {
-    }
-
-    std::string constant_assignment_error::what() const
-    {
-        return "Cannot assign to a value of type '" + assignee.to_string()
-            + "', because it is constant or contains constant members";
-    }
-
-    field_not_found_error::field_not_found_error(const identifier& field_name,
-            type composite_type)
-        : error(field_name.position()), field_name(field_name.name()), composite_type(composite_type)
-    {
-    }
-
-    std::string field_not_found_error::what() const
-    {
-        type resolved = resolve_underlying_type(composite_type);
-        bool is_enum = resolved.get<enumeration_type>() != nullptr;
-        bool is_record = resolved.get<record_type>() != nullptr;
-
-        if (is_enum || is_record)
-        {
-            std::string message = is_enum ? "Enumeration" : "Record";
-
-            if (auto alias = composite_type.get<alias_type>())
-            {
-                message += " '" + alias->name + "'";
-            }
-            message += " does not have a ";
-            message += is_enum ? "member" : "field";
-            message += " named '" + field_name + "'";
-            return message;
-        }
-        return "Type '" + composite_type.to_string()
-            + "' does not have a field named '" + field_name + "'";
-    }
-
-    duplicate_member_error::duplicate_member_error(const boot::identifier& member_name,
-            type aggregate, std::optional<source_position> original,
-            std::optional<std::string> base_name)
-        : error(member_name.position()), member_name(member_name.name()), aggregate(aggregate),
-        original(original), base_name(base_name)
-    {
-    }
-
-    std::string duplicate_member_error::what() const
-    {
-        type resolved = resolve_underlying_type(aggregate);
-        bool is_enum = resolved.get<enumeration_type>() != nullptr;
-        std::string kind = is_enum ? "member" : "field";
-        std::string message = is_enum ? "Enumeration" : "Record";
-
-        if (auto alias = aggregate.get<alias_type>())
-        {
-            message += " '" + alias->name + "'";
-        }
-        message += " already has a " + kind + " named '" + member_name + "'";
-
-        if (base_name.has_value())
-        {
-            message += " (defined in base type '" + *base_name + "')";
-        }
-        return message;
-    }
-
-    std::optional<std::pair<std::string, source_position>> duplicate_member_error::note() const
-    {
-        if (original.has_value() && original->start().available())
-        {
-            return std::make_pair("previously declared here", *original);
-        }
-        return std::nullopt;
-    }
-
-    cyclic_declaration_error::cyclic_declaration_error(const std::vector<std::string>& cycle,
-            const source_position position)
-        : error(position), cycle(cycle)
-    {
-    }
-
-    std::string cyclic_declaration_error::what() const
-    {
-        auto segment = std::cbegin(this->cycle);
-        std::string message = "Type declaration forms a cycle: " + *segment;
-
-        ++segment;
-        for (; segment != std::cend(this->cycle); ++segment)
-        {
-            message += " -> " + *segment;
-        }
-        return message;
-    }
-
-    return_error::return_error(const std::string& identifier, const source_position position,
-            type return_type)
-        : error(position), identifier(identifier), return_type(return_type)
-    {
-    }
-
-    std::string return_error::what() const
-    {
-        if (!return_type.empty())
-        {
-            return "Procedure '" + this->identifier
-                + "' does not return a value, but return expression has type '"
-                + return_type.to_string() + "'";
-        }
-        return "Procedure '" + this->identifier
-            + "' is expected to return, but does not have a return statement";
-    }
-
-    base_type_error::base_type_error(type actual, const source_position position)
-        : error(position), actual(actual)
-    {
-    }
-
-    std::string base_type_error::what() const
-    {
-        return "'" + actual.to_string() + "' is not a record type";
-    }
-
-    argument_count_error::argument_count_error(std::size_t expected, std::size_t actual,
-            const source_position position)
-        : error(position), expected(expected), actual(actual)
-    {
-    }
-
-    std::string argument_count_error::what() const
-    {
-        if (actual > expected)
-        {
-            return "Too many arguments, expected " + std::to_string(expected)
-                + ", got " + std::to_string(actual);
-        }
-        else
-        {
-            return "Too few arguments, expected " + std::to_string(expected)
-                + ", got " + std::to_string(actual);
-        }
-    }
-
-    unsupported_trait_type_error::unsupported_trait_type_error(const identifier& trait,
-            type actual)
-        : error(trait.position()), actual(actual), trait_name(trait.name())
-    {
-    }
-
-    std::string unsupported_trait_type_error::what() const
-    {
-        return "Type '" + actual.to_string()
-            + "' does not support trait '#" + trait_name + "'";
-    }
-
     // Members of a constant aggregate are constant themselves.
     static type qualify_member_type(const type& element, const type& aggregate)
     {
@@ -244,323 +75,6 @@ namespace elna::boot
         }
     }
 
-    /*
-     * Whether the type itself is constant or has a constant member at any
-     * nesting level, so that values of this type cannot be reassigned as a
-     * whole. Pointers to constants do not make the type itself constant.
-     */
-    static bool contains_constant_member(const type& checked)
-    {
-        auto referent = resolve_aliases(checked);
-
-        if (referent.get<constant_type>() != nullptr)
-        {
-            return true;
-        }
-        else if (auto record = referent.get<record_type>())
-        {
-            for (const type_field& field : record->fields)
-            {
-                if (contains_constant_member(field.second))
-                {
-                    return true;
-                }
-            }
-            return !record->base.empty() && contains_constant_member(record->base);
-        }
-        else if (auto array = referent.get<array_type>())
-        {
-            return contains_constant_member(array->base);
-        }
-        return false;
-    }
-
-    bool type_analysis_visitor::check_unresolved_symbol(std::shared_ptr<alias_type> alias,
-            std::vector<std::string>& alias_path)
-    {
-        if (std::find(std::cbegin(alias_path), std::cend(alias_path), alias->name) != std::cend(alias_path))
-        {
-            return false;
-        }
-        alias_path.push_back(alias->name);
-
-        if (auto another_alias = alias->reference.get<alias_type>())
-        {
-            return check_unresolved_symbol(another_alias, alias_path);
-        }
-        return true;
-    }
-
-    bool type_analysis_visitor::is_base_of(const std::shared_ptr<record_type>& base,
-            const std::shared_ptr<record_type>& derived)
-    {
-        if (derived != nullptr)
-        {
-            if (auto current_record = resolve_underlying_type(derived->base).get<record_type>())
-            {
-                return current_record == base || is_base_of(base, current_record);
-            }
-        }
-        return false;
-    }
-
-    bool type_analysis_visitor::is_assignable_from(const type& assignee, const type& assignment)
-    {
-        type resolved_assignee = resolve_underlying_type(assignee);
-        type resolved_assignment = resolve_underlying_type(assignment);
-
-        if (resolved_assignee == resolved_assignment
-                || (is_primitive_type(resolved_assignee, "Pointer") && is_any_pointer_type(resolved_assignment))
-                || (is_primitive_type(resolved_assignment, "Pointer") && is_any_pointer_type(resolved_assignee)))
-        {
-            return true;
-        }
-        std::shared_ptr<pointer_type> assignee_pointer = resolved_assignee.get<pointer_type>();
-        std::shared_ptr<pointer_type> assignment_pointer = resolved_assignment.get<pointer_type>();
-
-        if (assignee_pointer == nullptr || assignment_pointer == nullptr)
-        {
-            return false;
-        }
-        auto assignee_pointee_const = resolve_aliases(assignee_pointer->base).get<constant_type>();
-        auto assignment_pointee_const = resolve_aliases(assignment_pointer->base).get<constant_type>();
-
-        // Constness can be added at the first indirection level, but not removed.
-        if (assignee_pointee_const != nullptr
-                && assignee_pointee_const->unqualified == assignment_pointer->base)
-        {
-            return true;
-        }
-        if (assignment_pointee_const != nullptr && assignee_pointee_const == nullptr)
-        {
-            return false;
-        }
-        // A pointer to a record can be assigned to a pointer to its base type.
-        std::shared_ptr<record_type> assignee_record =
-            resolve_underlying_type(assignee_pointer->base).get<record_type>();
-
-        return assignee_record != nullptr
-            && is_base_of(assignee_record, resolve_underlying_type(assignment_pointer->base).get<record_type>());
-    }
-
-    type_analysis_visitor::type_analysis_visitor(symbol_bag bag)
-        : error_container(), bag(bag)
-    {
-    }
-
-    void type_analysis_visitor::visit(procedure_declaration *declaration)
-    {
-        this->current_procedure = this->bag.lookup(declaration->identifier.name())->is_procedure();
-
-        if (declaration->body.has_value())
-        {
-            this->bag.enter(this->current_procedure->scope);
-        }
-        walking_visitor::visit(declaration);
-
-        if (declaration->body.has_value())
-        {
-            if (declaration->body.value().return_expression != nullptr)
-            {
-                expression *return_expr = declaration->body.value().return_expression;
-                type return_type = this->current_procedure->symbol.return_type.proper_type;
-
-                if (!return_type.empty())
-                {
-                    if (!is_assignable_from(return_type, return_expr->type_decoration))
-                    {
-                        add_error<type_mismatch_error>(
-                                return_expr->position(), return_type, return_expr->type_decoration);
-                    }
-                }
-                else
-                {
-                    add_error<return_error>(declaration->identifier.name(),
-                            return_expr->position(), return_expr->type_decoration);
-                }
-            }
-            else if (declaration->heading().return_type.proper_type != nullptr)
-            {
-                add_error<return_error>(declaration->identifier.name(), declaration->position());
-            }
-            this->bag.leave();
-        }
-        this->current_procedure.reset();
-    }
-
-    void type_analysis_visitor::visit(unit *unit)
-    {
-        walking_visitor::visit(unit);
-    }
-
-    void type_analysis_visitor::visit(assign_statement *statement)
-    {
-        walking_visitor::visit(statement);
-
-        if (contains_constant_member(statement->lvalue().type_decoration))
-        {
-            add_error<constant_assignment_error>(statement->position(),
-                    statement->lvalue().type_decoration);
-        }
-        else if (!is_assignable_from(statement->lvalue().type_decoration, statement->rvalue().type_decoration))
-        {
-            add_error<type_mismatch_error>(statement->position(),
-                    statement->lvalue().type_decoration, statement->rvalue().type_decoration);
-        }
-    }
-
-    void type_analysis_visitor::visit(variable_declaration *declaration)
-    {
-        walking_visitor::visit(declaration);
-
-        if (declaration->initializer == nullptr)
-        {
-            return;
-        }
-        for (const identifier_definition& variable_identifier : declaration->identifiers)
-        {
-            auto variable_symbol = this->bag.lookup(variable_identifier.name())->is_variable();
-            if (!is_assignable_from(variable_symbol->symbol, declaration->initializer->type_decoration))
-            {
-                add_error<type_mismatch_error>(
-                        declaration->initializer->position(),
-                        variable_symbol->symbol, declaration->initializer->type_decoration);
-            }
-        }
-    }
-
-    void type_analysis_visitor::visit(case_statement *statement)
-    {
-        walking_visitor::visit(statement);
-        type condition_type = resolve_underlying_type(statement->condition().type_decoration);
-
-        for (const switch_case& case_block : statement->cases)
-        {
-            for (expression *const case_label : case_block.labels)
-            {
-                if (!is_assignable_from(condition_type, case_label->type_decoration))
-                {
-                    add_error<type_mismatch_error>(
-                            case_label->position(), condition_type, case_label->type_decoration);
-                }
-            }
-        }
-    }
-
-    void type_analysis_visitor::visit(type_declaration *declaration)
-    {
-        std::vector<std::string> alias_path;
-        auto unresolved_type = this->bag.lookup(declaration->identifier.name())->is_type()->symbol.get<alias_type>();
-
-        if (!check_unresolved_symbol(unresolved_type, alias_path))
-        {
-            add_error<cyclic_declaration_error>(alias_path, declaration->position());
-        }
-        else
-        {
-            walking_visitor::visit(declaration);
-        }
-    }
-
-    void type_analysis_visitor::visit(record_type_expression *expression)
-    {
-        if (expression->base.has_value())
-        {
-            type base_type = resolve_underlying_type(this->bag.lookup(expression->base.value().name())->is_type()->symbol);
-            if (base_type.get<record_type>() == nullptr)
-            {
-                add_error<base_type_error>(base_type, expression->position());
-            }
-        }
-        walking_visitor::visit(expression);
-    }
-
-    void type_analysis_visitor::visit(procedure_call *call)
-    {
-        call->callable().accept(this);
-
-        if (auto procedure = call->callable().type_decoration.get<procedure_type>())
-        {
-            std::vector<expression *>::const_iterator argument_iterator = std::cbegin(call->arguments);
-            std::vector<type>::const_iterator type_iterator = std::cbegin(procedure->parameters);
-
-            while (argument_iterator != std::cend(call->arguments)
-                    && type_iterator != std::cend(procedure->parameters))
-            {
-                (*argument_iterator)->accept(this);
-                if (!is_assignable_from(*type_iterator, (*argument_iterator)->type_decoration))
-                {
-                    add_error<type_mismatch_error>(
-                            (*argument_iterator)->position(), *type_iterator,
-                            (*argument_iterator)->type_decoration);
-                }
-                ++argument_iterator;
-                ++type_iterator;
-            }
-            if (call->arguments.size() != procedure->parameters.size())
-            {
-                add_error<argument_count_error>(procedure->parameters.size(),
-                        call->arguments.size(), call->position());
-            }
-        }
-    }
-
-    void type_analysis_visitor::visit(record_constructor_expression *expression)
-    {
-        auto record = resolve_underlying_type(expression->type_decoration).get<record_type>();
-
-        if (record == nullptr)
-        {
-            add_error<type_mismatch_error>(
-                    expression->position(), type(std::make_shared<record_type>()),
-                    expression->type_decoration);
-            return;
-        }
-        for (const field_initializer& initializer : expression->field_initializers)
-        {
-            for (const type_field& field : record->fields)
-            {
-                if (field.first == initializer.name())
-                {
-                    if (!is_assignable_from(field.second, initializer.value().type_decoration))
-                    {
-                        add_error<type_mismatch_error>(
-                                initializer.value().position(), field.second,
-                                initializer.value().type_decoration);
-                    }
-                    break;
-                }
-            }
-        }
-    }
-
-    void type_analysis_visitor::visit(array_constructor_expression *expression)
-    {
-        auto array = resolve_underlying_type(expression->type_decoration).get<array_type>();
-
-        if (array == nullptr)
-        {
-            add_error<type_mismatch_error>(
-                    expression->position(), type(std::make_shared<array_type>(type(), 0)),
-                    expression->type_decoration);
-            return;
-        }
-        if (expression->elements.size() > array->size)
-        {
-            add_error<argument_count_error>(array->size, expression->elements.size(),
-                    expression->position());
-            return;
-        }
-        for (auto element : expression->elements)
-        {
-            if (!is_assignable_from(array->base, element->type_decoration))
-            {
-                add_error<type_mismatch_error>(
-                        element->position(), array->base, element->type_decoration);
-            }
-        }
-    }
-
     name_analysis_visitor::name_analysis_visitor(symbol_bag bag)
         : error_container(), bag(bag)
     {
diff --git a/boot/symbol.cc b/boot/symbol.cc
index 9985489..bd6ec49 100644
--- a/boot/symbol.cc
+++ b/boot/symbol.cc
@@ -583,6 +583,6 @@ namespace elna::boot
     {
         return checked.get<pointer_type>() != nullptr
             || checked.get<procedure_type>() != nullptr
-            || is_primitive_type(checked, "Pointer");
+            || is_primitive_type(resolve_underlying_type(checked), "Pointer");
     }
 }
diff --git a/boot/type_check.cc b/boot/type_check.cc
new file mode 100644
index 0000000..3667007
--- /dev/null
+++ b/boot/type_check.cc
@@ -0,0 +1,573 @@
+/* Type analysis.
+   Copyright (C) 2025 Free Software Foundation, Inc.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "elna/boot/type_check.h"
+
+#include <algorithm>
+
+namespace elna::boot
+{
+    type_mismatch_error::type_mismatch_error(const source_position position,
+            type expected, type actual)
+        : error(position), expected(expected), actual(actual)
+    {
+    }
+
+    std::string type_mismatch_error::what() const
+    {
+        return "Expected type '" + expected.to_string()
+            + "', but got '" + actual.to_string() + "'";
+    }
+
+    constant_assignment_error::constant_assignment_error(const source_position position,
+            type assignee)
+        : error(position), assignee(assignee)
+    {
+    }
+
+    std::string constant_assignment_error::what() const
+    {
+        return "Cannot assign to a value of type '" + assignee.to_string()
+            + "', because it is constant or contains constant members";
+    }
+
+    field_not_found_error::field_not_found_error(const identifier& field_name,
+            type composite_type)
+        : error(field_name.position()), field_name(field_name.name()), composite_type(composite_type)
+    {
+    }
+
+    std::string field_not_found_error::what() const
+    {
+        type resolved = resolve_underlying_type(composite_type);
+        bool is_enum = resolved.get<enumeration_type>() != nullptr;
+        bool is_record = resolved.get<record_type>() != nullptr;
+
+        if (is_enum || is_record)
+        {
+            std::string message = is_enum ? "Enumeration" : "Record";
+
+            if (auto alias = composite_type.get<alias_type>())
+            {
+                message += " '" + alias->name + "'";
+            }
+            message += " does not have a ";
+            message += is_enum ? "member" : "field";
+            message += " named '" + field_name + "'";
+            return message;
+        }
+        return "Type '" + composite_type.to_string()
+            + "' does not have a field named '" + field_name + "'";
+    }
+
+    duplicate_member_error::duplicate_member_error(const boot::identifier& member_name,
+            type aggregate, std::optional<source_position> original,
+            std::optional<std::string> base_name)
+        : error(member_name.position()), member_name(member_name.name()), aggregate(aggregate),
+        original(original), base_name(base_name)
+    {
+    }
+
+    std::string duplicate_member_error::what() const
+    {
+        type resolved = resolve_underlying_type(aggregate);
+        bool is_enum = resolved.get<enumeration_type>() != nullptr;
+        std::string kind = is_enum ? "member" : "field";
+        std::string message = is_enum ? "Enumeration" : "Record";
+
+        if (auto alias = aggregate.get<alias_type>())
+        {
+            message += " '" + alias->name + "'";
+        }
+        message += " already has a " + kind + " named '" + member_name + "'";
+
+        if (base_name.has_value())
+        {
+            message += " (defined in base type '" + *base_name + "')";
+        }
+        return message;
+    }
+
+    std::optional<std::pair<std::string, source_position>> duplicate_member_error::note() const
+    {
+        if (original.has_value() && original->start().available())
+        {
+            return std::make_pair("previously declared here", *original);
+        }
+        return std::nullopt;
+    }
+
+    cyclic_declaration_error::cyclic_declaration_error(const std::vector<std::string>& cycle,
+            const source_position position)
+        : error(position), cycle(cycle)
+    {
+    }
+
+    std::string cyclic_declaration_error::what() const
+    {
+        auto segment = std::cbegin(this->cycle);
+        std::string message = "Type declaration forms a cycle: " + *segment;
+
+        ++segment;
+        for (; segment != std::cend(this->cycle); ++segment)
+        {
+            message += " -> " + *segment;
+        }
+        return message;
+    }
+
+    return_error::return_error(const std::string& identifier, const source_position position,
+            type return_type)
+        : error(position), identifier(identifier), return_type(return_type)
+    {
+    }
+
+    std::string return_error::what() const
+    {
+        if (!return_type.empty())
+        {
+            return "Procedure '" + this->identifier
+                + "' does not return a value, but return expression has type '"
+                + return_type.to_string() + "'";
+        }
+        return "Procedure '" + this->identifier
+            + "' is expected to return, but does not have a return statement";
+    }
+
+    base_type_error::base_type_error(type actual, const source_position position)
+        : error(position), actual(actual)
+    {
+    }
+
+    std::string base_type_error::what() const
+    {
+        return "'" + actual.to_string() + "' is not a record type";
+    }
+
+    argument_count_error::argument_count_error(std::size_t expected, std::size_t actual,
+            const source_position position)
+        : error(position), expected(expected), actual(actual)
+    {
+    }
+
+    std::string argument_count_error::what() const
+    {
+        if (actual > expected)
+        {
+            return "Too many arguments, expected " + std::to_string(expected)
+                + ", got " + std::to_string(actual);
+        }
+        else
+        {
+            return "Too few arguments, expected " + std::to_string(expected)
+                + ", got " + std::to_string(actual);
+        }
+    }
+
+    unsupported_trait_type_error::unsupported_trait_type_error(const identifier& trait,
+            type actual)
+        : error(trait.position()), actual(actual), trait_name(trait.name())
+    {
+    }
+
+    std::string unsupported_trait_type_error::what() const
+    {
+        return "Type '" + actual.to_string()
+            + "' does not support trait '#" + trait_name + "'";
+    }
+
+    /*
+     * Whether the type itself is constant or has a constant member at any
+     * nesting level, so that values of this type cannot be reassigned as a
+     * whole. Pointers to constants do not make the type itself constant.
+     */
+    static bool contains_constant_member(const type& checked)
+    {
+        auto referent = resolve_aliases(checked);
+
+        if (referent.get<constant_type>() != nullptr)
+        {
+            return true;
+        }
+        else if (auto record = referent.get<record_type>())
+        {
+            for (const type_field& field : record->fields)
+            {
+                if (contains_constant_member(field.second))
+                {
+                    return true;
+                }
+            }
+            return !record->base.empty() && contains_constant_member(record->base);
+        }
+        else if (auto array = referent.get<array_type>())
+        {
+            return contains_constant_member(array->base);
+        }
+        return false;
+    }
+
+    bool type_analysis_visitor::check_unresolved_symbol(std::shared_ptr<alias_type> alias,
+            std::vector<std::string>& alias_path)
+    {
+        if (std::find(std::cbegin(alias_path), std::cend(alias_path), alias->name) != std::cend(alias_path))
+        {
+            return false;
+        }
+        alias_path.push_back(alias->name);
+
+        if (auto another_alias = alias->reference.get<alias_type>())
+        {
+            return check_unresolved_symbol(another_alias, alias_path);
+        }
+        return true;
+    }
+
+    /*
+     * Checks whether derived has base in its record parent chain.
+     *
+     * Base record type must not be null. Derived record type may be null.
+     */
+    static bool is_base_of(const std::shared_ptr<record_type>& base,
+            const std::shared_ptr<record_type>& derived)
+    {
+        if (derived != nullptr)
+        {
+            if (auto current_record = resolve_underlying_type(derived->base).get<record_type>())
+            {
+                return current_record == base || is_base_of(base, current_record);
+            }
+        }
+        return false;
+    }
+
+    assign_check::verdict assign_check::guard_const_laundering()
+    {
+        if (!is_primitive_type(ctx.aliased_assignee, "Pointer"))
+        {
+            return verdict::pass;
+        }
+        if (auto ptr = ctx.aliased_assignment.get<pointer_type>();
+                ptr != nullptr && resolve_aliases(ptr->base).get<constant_type>() != nullptr)
+        {
+            return verdict::reject;
+        }
+        if (auto const_assign = ctx.aliased_assignment.get<constant_type>();
+                const_assign != nullptr && is_primitive_type(const_assign->unqualified, "Pointer"))
+        {
+            return verdict::reject;
+        }
+        return verdict::pass;
+    }
+
+    assign_check::verdict assign_check::check_exact_match()
+    {
+        return ctx.resolved_assignee == ctx.resolved_assignment ? verdict::accept : verdict::pass;
+    }
+
+    assign_check::verdict assign_check::check_pointer_hatch()
+    {
+        if (is_primitive_type(ctx.resolved_assignee, "Pointer")
+                && is_any_pointer_type(ctx.resolved_assignment))
+        {
+            return verdict::accept;
+        }
+        if (is_primitive_type(ctx.resolved_assignment, "Pointer")
+                && is_any_pointer_type(ctx.resolved_assignee))
+        {
+            return verdict::accept;
+        }
+        return verdict::pass;
+    }
+
+    assign_check::verdict assign_check::check_pointer_conversion()
+    {
+        auto assignee_ptr = ctx.resolved_assignee.get<pointer_type>();
+        auto assignment_ptr = ctx.resolved_assignment.get<pointer_type>();
+
+        if (assignee_ptr == nullptr || assignment_ptr == nullptr)
+        {
+            return verdict::reject;
+        }
+        auto assignee_pointee_const = resolve_aliases(assignee_ptr->base).get<constant_type>();
+        auto assignment_pointee_const = resolve_aliases(assignment_ptr->base).get<constant_type>();
+
+        // Constness can be added at the first indirection level, but not removed.
+        if (assignee_pointee_const != nullptr
+                && assignee_pointee_const->unqualified == assignment_ptr->base)
+        {
+            return verdict::accept;
+        }
+        if (assignment_pointee_const != nullptr && assignee_pointee_const == nullptr)
+        {
+            return verdict::reject;
+        }
+        // A pointer to a record can be assigned to a pointer to its base type.
+        if (auto assignee_record = resolve_underlying_type(assignee_ptr->base).get<record_type>())
+        {
+            return is_base_of(assignee_record,
+                    resolve_underlying_type(assignment_ptr->base).get<record_type>())
+                ? verdict::accept : verdict::pass;
+        }
+        return verdict::pass;
+    }
+
+    bool assign_check::run()
+    {
+        for (auto handler : {&assign_check::guard_const_laundering,
+                &assign_check::check_exact_match,
+                &assign_check::check_pointer_hatch,
+                &assign_check::check_pointer_conversion})
+        {
+            switch ((this->*handler)())
+            {
+                case verdict::accept: return true;
+                case verdict::reject: return false;
+                case verdict::pass:;
+            }
+        }
+        return false;
+    }
+
+    bool type_analysis_visitor::is_assignable_from(const type& assignee, const type& assignment)
+    {
+        return assign_check{
+                resolve_aliases(assignee),
+                resolve_aliases(assignment),
+                resolve_underlying_type(assignee),
+                resolve_underlying_type(assignment)
+            }.run();
+    }
+
+    type_analysis_visitor::type_analysis_visitor(symbol_bag bag)
+        : error_container(), bag(bag)
+    {
+    }
+
+    void type_analysis_visitor::visit(procedure_declaration *declaration)
+    {
+        this->current_procedure = this->bag.lookup(declaration->identifier.name())->is_procedure();
+
+        if (declaration->body.has_value())
+        {
+            this->bag.enter(this->current_procedure->scope);
+        }
+        walking_visitor::visit(declaration);
+
+        if (declaration->body.has_value())
+        {
+            if (declaration->body.value().return_expression != nullptr)
+            {
+                expression *return_expr = declaration->body.value().return_expression;
+                type return_type = this->current_procedure->symbol.return_type.proper_type;
+
+                if (!return_type.empty())
+                {
+                    if (!is_assignable_from(return_type, return_expr->type_decoration))
+                    {
+                        add_error<type_mismatch_error>(
+                                return_expr->position(), return_type, return_expr->type_decoration);
+                    }
+                }
+                else
+                {
+                    add_error<return_error>(declaration->identifier.name(),
+                            return_expr->position(), return_expr->type_decoration);
+                }
+            }
+            else if (declaration->heading().return_type.proper_type != nullptr)
+            {
+                add_error<return_error>(declaration->identifier.name(), declaration->position());
+            }
+            this->bag.leave();
+        }
+        this->current_procedure.reset();
+    }
+
+    void type_analysis_visitor::visit(unit *unit)
+    {
+        walking_visitor::visit(unit);
+    }
+
+    void type_analysis_visitor::visit(assign_statement *statement)
+    {
+        walking_visitor::visit(statement);
+
+        if (contains_constant_member(statement->lvalue().type_decoration))
+        {
+            add_error<constant_assignment_error>(statement->position(),
+                    statement->lvalue().type_decoration);
+        }
+        else if (!is_assignable_from(statement->lvalue().type_decoration, statement->rvalue().type_decoration))
+        {
+            add_error<type_mismatch_error>(statement->position(),
+                    statement->lvalue().type_decoration, statement->rvalue().type_decoration);
+        }
+    }
+
+    void type_analysis_visitor::visit(variable_declaration *declaration)
+    {
+        walking_visitor::visit(declaration);
+
+        if (declaration->initializer == nullptr)
+        {
+            return;
+        }
+        for (const identifier_definition& variable_identifier : declaration->identifiers)
+        {
+            auto variable_symbol = this->bag.lookup(variable_identifier.name())->is_variable();
+            if (!is_assignable_from(variable_symbol->symbol, declaration->initializer->type_decoration))
+            {
+                add_error<type_mismatch_error>(
+                        declaration->initializer->position(),
+                        variable_symbol->symbol, declaration->initializer->type_decoration);
+            }
+        }
+    }
+
+    void type_analysis_visitor::visit(case_statement *statement)
+    {
+        walking_visitor::visit(statement);
+        type condition_type = resolve_underlying_type(statement->condition().type_decoration);
+
+        for (const switch_case& case_block : statement->cases)
+        {
+            for (expression *const case_label : case_block.labels)
+            {
+                if (!is_assignable_from(condition_type, case_label->type_decoration))
+                {
+                    add_error<type_mismatch_error>(
+                            case_label->position(), condition_type, case_label->type_decoration);
+                }
+            }
+        }
+    }
+
+    void type_analysis_visitor::visit(type_declaration *declaration)
+    {
+        std::vector<std::string> alias_path;
+        auto unresolved_type = this->bag.lookup(declaration->identifier.name())->is_type()->symbol.get<alias_type>();
+
+        if (!check_unresolved_symbol(unresolved_type, alias_path))
+        {
+            add_error<cyclic_declaration_error>(alias_path, declaration->position());
+        }
+        else
+        {
+            walking_visitor::visit(declaration);
+        }
+    }
+
+    void type_analysis_visitor::visit(record_type_expression *expression)
+    {
+        if (expression->base.has_value())
+        {
+            type base_type = resolve_underlying_type(this->bag.lookup(expression->base.value().name())->is_type()->symbol);
+            if (base_type.get<record_type>() == nullptr)
+            {
+                add_error<base_type_error>(base_type, expression->position());
+            }
+        }
+        walking_visitor::visit(expression);
+    }
+
+    void type_analysis_visitor::visit(procedure_call *call)
+    {
+        call->callable().accept(this);
+
+        if (auto procedure = call->callable().type_decoration.get<procedure_type>())
+        {
+            std::vector<expression *>::const_iterator argument_iterator = std::cbegin(call->arguments);
+            std::vector<type>::const_iterator type_iterator = std::cbegin(procedure->parameters);
+
+            while (argument_iterator != std::cend(call->arguments)
+                    && type_iterator != std::cend(procedure->parameters))
+            {
+                (*argument_iterator)->accept(this);
+                if (!is_assignable_from(*type_iterator, (*argument_iterator)->type_decoration))
+                {
+                    add_error<type_mismatch_error>(
+                            (*argument_iterator)->position(), *type_iterator,
+                            (*argument_iterator)->type_decoration);
+                }
+                ++argument_iterator;
+                ++type_iterator;
+            }
+            if (call->arguments.size() != procedure->parameters.size())
+            {
+                add_error<argument_count_error>(procedure->parameters.size(),
+                        call->arguments.size(), call->position());
+            }
+        }
+    }
+
+    void type_analysis_visitor::visit(record_constructor_expression *expression)
+    {
+        auto record = resolve_underlying_type(expression->type_decoration).get<record_type>();
+
+        if (record == nullptr)
+        {
+            add_error<type_mismatch_error>(
+                    expression->position(), type(std::make_shared<record_type>()),
+                    expression->type_decoration);
+            return;
+        }
+        for (const field_initializer& initializer : expression->field_initializers)
+        {
+            for (const type_field& field : record->fields)
+            {
+                if (field.first == initializer.name())
+                {
+                    if (!is_assignable_from(field.second, initializer.value().type_decoration))
+                    {
+                        add_error<type_mismatch_error>(
+                                initializer.value().position(), field.second,
+                                initializer.value().type_decoration);
+                    }
+                    break;
+                }
+            }
+        }
+    }
+
+    void type_analysis_visitor::visit(array_constructor_expression *expression)
+    {
+        auto array = resolve_underlying_type(expression->type_decoration).get<array_type>();
+
+        if (array == nullptr)
+        {
+            add_error<type_mismatch_error>(
+                    expression->position(), type(std::make_shared<array_type>(type(), 0)),
+                    expression->type_decoration);
+            return;
+        }
+        if (expression->elements.size() > array->size)
+        {
+            add_error<argument_count_error>(array->size, expression->elements.size(),
+                    expression->position());
+            return;
+        }
+        for (auto element : expression->elements)
+        {
+            if (!is_assignable_from(array->base, element->type_decoration))
+            {
+                add_error<type_mismatch_error>(
+                        element->position(), array->base, element->type_decoration);
+            }
+        }
+    }
+}
diff --git a/gcc/Make-lang.in b/gcc/Make-lang.in
index cb57798..e6d6f2d 100644
--- a/gcc/Make-lang.in
+++ b/gcc/Make-lang.in
@@ -52,7 +52,8 @@ elna_OBJS = \
 	elna/driver.o \
 	elna/lexer.o \
 	elna/parser.o \
-	elna/semantic.o \
+	elna/name_analysis.o \
+	elna/type_check.o \
 	elna/symbol.o \
 	elna/result.o \
 	$(END)
diff --git a/include/elna/boot/name_analysis.h b/include/elna/boot/name_analysis.h
new file mode 100644
index 0000000..4498d0c
--- /dev/null
+++ b/include/elna/boot/name_analysis.h
@@ -0,0 +1,153 @@
+/* Name analysis.
+   Copyright (C) 2025 Free Software Foundation, Inc.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#pragma once
+
+#include <string>
+#include <memory>
+#include <map>
+
+#include "elna/boot/ast.h"
+#include "elna/boot/result.h"
+#include "elna/boot/symbol.h"
+#include "elna/boot/type_check.h"
+
+namespace elna::boot
+{
+    /**
+     * Error declaring a symbol.
+     */
+    class declaration_error : public error
+    {
+    public:
+        enum class kind
+        {
+            undeclared,
+            local_export
+        };
+
+    private:
+        std::string identifier;
+        kind error_kind;
+
+    public:
+
+        declaration_error(const kind error_kind,
+                const boot::identifier& identifier);
+
+        std::string what() const override;
+    };
+
+    /**
+     * Attempted to redefine a name that is already in use in the
+     * current scope.
+     */
+    class redefinition_error : public error
+    {
+        std::string identifier;
+        std::optional<source_position> original;
+
+    public:
+        redefinition_error(const boot::identifier& identifier,
+                std::optional<source_position> original);
+
+        std::string what() const override;
+
+        std::optional<std::pair<std::string, source_position>> note() const override;
+    };
+
+    /**
+     * Origin of a field in a composite type.
+     */
+    struct field_origin
+    {
+        std::optional<source_position> declaration;
+        type base_type;
+    };
+
+    /**
+     * Performs name analysis.
+     */
+    class name_analysis_visitor final : public walking_visitor, public error_container
+    {
+        type current_type;
+
+        symbol_bag bag;
+
+        std::pair<procedure_type, std::vector<std::string>> build_procedure(
+                procedure_type_expression& expression);
+        std::vector<type_field> build_composite_type(const std::vector<field_declaration>& fields,
+                std::map<std::string, field_origin>& known_names,
+                type aggregate);
+        std::shared_ptr<variable_info> register_variable(const std::string& name,
+                const bool is_extern, const source_position position);
+
+        type lookup_primitive_type(const std::string& name);
+        type lookup_field(const type& composite_type, const std::string& field_name);
+
+    public:
+        name_analysis_visitor(symbol_bag bag);
+
+        void visit(array_type_expression *expression) override;
+        void visit(pointer_type_expression *expression) override;
+        void visit(constant_type_expression *expression) override;
+        void visit(type_declaration *declaration) override;
+        void visit(record_type_expression *expression) override;
+        void visit(record_constructor_expression *expression) override;
+        void visit(array_constructor_expression *expression) override;
+        void visit(procedure_type_expression *expression) override;
+        void visit(enumeration_type_expression *expression) override;
+
+        void visit(variable_declaration *declaration) override;
+        void visit(procedure_declaration *declaration) override;
+
+        void visit(procedure_call *call) override;
+        void visit(unit *unit) override;
+        void visit(cast_expression *expression) override;
+        void visit(traits_expression *trait) override;
+        void visit(binary_expression *expression) override;
+        void visit(unary_expression *expression) override;
+        void visit(named_expression *expression) override;
+        void visit(array_access_expression *expression) override;
+        void visit(field_access_expression *expression) override;
+        void visit(dereference_expression *expression) override;
+        void visit(literal<std::int32_t> *literal) override;
+        void visit(literal<std::uint32_t> *literal) override;
+        void visit(literal<double> *literal) override;
+        void visit(literal<bool> *literal) override;
+        void visit(literal<unsigned char> *literal) override;
+        void visit(literal<std::nullptr_t> *literal) override;
+        void visit(literal<std::string> *literal) override;
+    };
+
+    /**
+     * Collects global declarations without resolving any symbols.
+     */
+    class declaration_visitor final : public empty_visitor, public error_container
+    {
+    public:
+        forward_table unresolved;
+
+        explicit declaration_visitor();
+
+        void visit(import_declaration *) override;
+        void visit(unit *unit) override;
+        void visit(type_declaration *declaration) override;
+        void visit(procedure_declaration *declaration) override;
+        void visit(variable_declaration *declaration) override;
+    };
+}
diff --git a/include/elna/boot/semantic.h b/include/elna/boot/type_check.h
index 3d2de10..b250f48 100644
--- a/include/elna/boot/semantic.h
+++ b/include/elna/boot/type_check.h
@@ -1,4 +1,4 @@
-/* Name analysis.
+/* Type analysis.
    Copyright (C) 2025 Free Software Foundation, Inc.
 
 GCC is free software; you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with GCC; see the file COPYING3.  If not see
 
 #include <string>
 #include <memory>
-#include <map>
+#include <vector>
 
 #include "elna/boot/ast.h"
 #include "elna/boot/result.h"
@@ -28,48 +28,6 @@ along with GCC; see the file COPYING3.  If not see
 namespace elna::boot
 {
     /**
-     * Error declaring a symbol.
-     */
-    class declaration_error : public error
-    {
-    public:
-        enum class kind
-        {
-            undeclared,
-            local_export
-        };
-
-    private:
-        std::string identifier;
-        kind error_kind;
-
-    public:
-
-        declaration_error(const kind error_kind,
-                const boot::identifier& identifier);
-
-        std::string what() const override;
-    };
-
-    /**
-     * Attempted to redefine a name that is already in use in the
-     * current scope.
-     */
-    class redefinition_error : public error
-    {
-        std::string identifier;
-        std::optional<source_position> original;
-
-    public:
-        redefinition_error(const boot::identifier& identifier,
-                std::optional<source_position> original);
-
-        std::string what() const override;
-
-        std::optional<std::pair<std::string, source_position>> note() const override;
-    };
-
-    /**
      * Expected type does not match the actual type of an expression.
      */
     class type_mismatch_error : public error
@@ -205,7 +163,37 @@ namespace elna::boot
     };
 
     /**
-     * Checks types.
+     * Chain of responsibility for type compatibility checks.
+     *
+     * Populate \c ctx with pre-resolved types, then call \c run().
+     * Each handler inspects the context and returns a verdict —
+     * the first non-\c pass verdict wins.
+     */
+    struct assign_check
+    {
+        enum class verdict { pass, accept, reject };
+
+        struct context
+        {
+            type aliased_assignee;
+            type aliased_assignment;
+            type resolved_assignee;
+            type resolved_assignment;
+        };
+        context ctx;
+
+        verdict guard_const_laundering();
+        verdict check_exact_match();
+        verdict check_pointer_hatch();
+        verdict check_pointer_conversion();
+
+        bool run();
+    };
+
+    /**
+     * Checks types: assignment compatibility, const-correctness,
+     * procedure argument counts, record field validity,
+     * and type declaration well-formedness.
      */
     class type_analysis_visitor final : public walking_visitor, public error_container
     {
@@ -217,12 +205,6 @@ namespace elna::boot
          * of type assignee.
          */
         static bool is_assignable_from(const type& assignee, const type& assignment);
-        /*
-         * Checks whether derived has base in its parent chain.
-         * base should not be null, derived can be null.
-         */
-        static bool is_base_of(const std::shared_ptr<record_type>& base,
-                const std::shared_ptr<record_type>& derived);
         static bool check_unresolved_symbol(std::shared_ptr<alias_type> alias,
                 std::vector<std::string>& path);
 
@@ -240,85 +222,4 @@ namespace elna::boot
         void visit(record_constructor_expression *expression) override;
         void visit(array_constructor_expression *expression) override;
     };
-
-    /**
-     * Origin of a field in a composite type.
-     */
-    struct field_origin
-    {
-        std::optional<source_position> declaration;
-        type base_type;
-    };
-
-    /**
-     * Performs name analysis.
-     */
-    class name_analysis_visitor final : public walking_visitor, public error_container
-    {
-        type current_type;
-
-        symbol_bag bag;
-
-        std::pair<procedure_type, std::vector<std::string>> build_procedure(
-                procedure_type_expression& expression);
-        std::vector<type_field> build_composite_type(const std::vector<field_declaration>& fields,
-                std::map<std::string, field_origin>& known_names,
-                type aggregate);
-        std::shared_ptr<variable_info> register_variable(const std::string& name,
-                const bool is_extern, const source_position position);
-
-        type lookup_primitive_type(const std::string& name);
-        type lookup_field(const type& composite_type, const std::string& field_name);
-
-    public:
-        name_analysis_visitor(symbol_bag bag);
-
-        void visit(array_type_expression *expression) override;
-        void visit(pointer_type_expression *expression) override;
-        void visit(constant_type_expression *expression) override;
-        void visit(type_declaration *declaration) override;
-        void visit(record_type_expression *expression) override;
-        void visit(record_constructor_expression *expression) override;
-        void visit(array_constructor_expression *expression) override;
-        void visit(procedure_type_expression *expression) override;
-        void visit(enumeration_type_expression *expression) override;
-
-        void visit(variable_declaration *declaration) override;
-        void visit(procedure_declaration *declaration) override;
-
-        void visit(procedure_call *call) override;
-        void visit(unit *unit) override;
-        void visit(cast_expression *expression) override;
-        void visit(traits_expression *trait) override;
-        void visit(binary_expression *expression) override;
-        void visit(unary_expression *expression) override;
-        void visit(named_expression *expression) override;
-        void visit(array_access_expression *expression) override;
-        void visit(field_access_expression *expression) override;
-        void visit(dereference_expression *expression) override;
-        void visit(literal<std::int32_t> *literal) override;
-        void visit(literal<std::uint32_t> *literal) override;
-        void visit(literal<double> *literal) override;
-        void visit(literal<bool> *literal) override;
-        void visit(literal<unsigned char> *literal) override;
-        void visit(literal<std::nullptr_t> *literal) override;
-        void visit(literal<std::string> *literal) override;
-    };
-
-    /**
-     * Collects global declarations without resolving any symbols.
-     */
-    class declaration_visitor final : public empty_visitor, public error_container
-    {
-    public:
-        forward_table unresolved;
-
-        explicit declaration_visitor();
-
-        void visit(import_declaration *) override;
-        void visit(unit *unit) override;
-        void visit(type_declaration *declaration) override;
-        void visit(procedure_declaration *declaration) override;
-        void visit(variable_declaration *declaration) override;
-    };
 }
diff --git a/include/elna/gcc/elna-generic.h b/include/elna/gcc/elna-generic.h
index a1689be..dd5c9ef 100644
--- a/include/elna/gcc/elna-generic.h
+++ b/include/elna/gcc/elna-generic.h
@@ -20,7 +20,6 @@ along with GCC; see the file COPYING3.  If not see
 #include <string>
 #include "elna/boot/ast.h"
 #include "elna/boot/symbol.h"
-#include "elna/boot/semantic.h"
 #include "elna/gcc/elna-tree.h"
 
 #include "config.h"
diff --git a/testsuite/compilable/const_pointer_conversion.elna b/testsuite/compilable/const_pointer_conversion.elna
new file mode 100644
index 0000000..003fbea
--- /dev/null
+++ b/testsuite/compilable/const_pointer_conversion.elna
@@ -0,0 +1,14 @@
+var
+  x: Int
+  c: const Int
+  p: ^Int
+  pc: ^const Int
+  v: Pointer
+  cv: const Pointer := nil
+  cv2: const Pointer := @x
+  cv3: const Pointer := @c
+
+begin
+  v := p;
+  v := @x
+end.
diff --git a/testsuite/fail_compilation/assign_const_to_pointer.elna b/testsuite/fail_compilation/assign_const_to_pointer.elna
new file mode 100644
index 0000000..c3d9230
--- /dev/null
+++ b/testsuite/fail_compilation/assign_const_to_pointer.elna
@@ -0,0 +1,7 @@
+var
+  c: const Int
+  p: Pointer
+
+begin
+  p := @c (* @Error Expected type 'Pointer', but got '\^const Int' *)
+end.
diff --git a/testsuite/fail_compilation/assign_from_const_pointer.elna b/testsuite/fail_compilation/assign_from_const_pointer.elna
new file mode 100644
index 0000000..164bb42
--- /dev/null
+++ b/testsuite/fail_compilation/assign_from_const_pointer.elna
@@ -0,0 +1,7 @@
+var
+  cv: const Pointer
+  p: Pointer
+
+begin
+  p := cv (* @Error Expected type 'Pointer', but got 'const Pointer' *)
+end.