From 4b996568757ad6477b1261cc165b7a109a1f362d Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Wed, 16 Jun 2021 22:45:46 -0400 Subject: [PATCH] Support generics with consumtion/inheritance in roles Make the following two constructs possible: role R1[::T] does T {} role R2[::T] is T {} These were assumed possible, according to a comment in ParametricRoleHOW code. But a few final touches needed to make them possible: - traits must accept generics when applied to a parametric type - typechecks must be done against instantiated typeobjects too, including parents - additional validation for archetype of a consumed typeobject after instantiation since it bypassed trait validation Spectests are passing. --- src/Perl6/Metamodel/CurriedRoleHOW.nqp | 41 +++++++++++++++++++---- src/Perl6/Metamodel/ParametricRoleHOW.nqp | 17 ++++++++-- src/core.c/traits.pm6 | 13 ++++--- 3 files changed, 59 insertions(+), 12 deletions(-) diff --git a/src/Perl6/Metamodel/CurriedRoleHOW.nqp b/src/Perl6/Metamodel/CurriedRoleHOW.nqp index 064fedca2a3..5ffda049fd8 100644 --- a/src/Perl6/Metamodel/CurriedRoleHOW.nqp +++ b/src/Perl6/Metamodel/CurriedRoleHOW.nqp @@ -28,6 +28,7 @@ class Perl6::Metamodel::CurriedRoleHOW has @!pos_args; has %!named_args; has @!role_typecheck_list; + has @!parent_typecheck_list; # Only for parents instantiated from generics has $!is_complete; has $!archetypes; @@ -86,20 +87,41 @@ class Perl6::Metamodel::CurriedRoleHOW } if nqp::istype($!curried_role.HOW, Perl6::Metamodel::ParametricRoleGroupHOW) { $!candidate := $!curried_role.HOW.select_candidate($!curried_role, @pos_args, %!named_args); + my $candidate-how := $!candidate.HOW; - self.set_language_revision($obj, $!candidate.HOW.language-revision($!candidate)); + self.set_language_revision($obj, $candidate-how.language-revision($!candidate)); my $type_env; try { - my @result := $!candidate.HOW.body_block($!candidate)(|@pos_args, |%!named_args); + my @result := $candidate-how.body_block($!candidate)(|@pos_args, |%!named_args); $type_env := @result[1]; } - for $!candidate.HOW.roles($!candidate, :!transitive) -> $role { - if nqp::can($role.HOW, 'curried_role') && $role.HOW.archetypes.generic && $type_env { + for $candidate-how.roles($!candidate, :!transitive) -> $role { + if $role.HOW.archetypes.generic && $type_env { $role := $role.HOW.instantiate_generic($role, $type_env); } + unless $role.HOW.archetypes.generic || $role.HOW.archetypes.parametric { + my $target-name := $obj.HOW.name($obj); + my $role-name := $role.HOW.name($role); + Perl6::Metamodel::Configuration.throw_or_die( + 'X::Composition::NotComposable', + $role-name ~ " is not composable, so " ~ $target-name ~ " cannot compose it", + :$target-name, + composer => $role, + ) + } self.add_role($obj, $role); } + # Contrary to roles, we only consider generic parents. I.e. cases like: + # role R[::T] is T {} + if $type_env { + for $candidate-how.parents($!candidate, :local) -> $parent { + if $parent.HOW.archetypes.generic { + my $ins := $parent.HOW.instantiate_generic($parent, $type_env); + nqp::push(@!parent_typecheck_list, $ins) + } + } + } } self.update_role_typecheck_list($obj); } @@ -112,9 +134,11 @@ class Perl6::Metamodel::CurriedRoleHOW # nqp::push(@rtl, $_); # } for self.roles_to_compose($obj) { - nqp::push(@rtl, $_); - for $_.HOW.role_typecheck_list($_) { + if $_.HOW.archetypes.composable() || $_.HOW.archetypes.composalizable() { nqp::push(@rtl, $_); + for $_.HOW.role_typecheck_list($_) { + nqp::push(@rtl, $_); + } } } @!role_typecheck_list := @rtl; @@ -184,6 +208,11 @@ class Perl6::Metamodel::CurriedRoleHOW if !($!candidate =:= NQPMu) && $!candidate.HOW.type_check_parents($!candidate, $decont) { return 1 } + for @!parent_typecheck_list -> $parent { + if nqp::istype($decont, $parent) { + return 1 + } + } for @!role_typecheck_list { my $dr := nqp::decont($_); if $decont =:= $dr { diff --git a/src/Perl6/Metamodel/ParametricRoleHOW.nqp b/src/Perl6/Metamodel/ParametricRoleHOW.nqp index b1f31c579d0..cbd98f42554 100644 --- a/src/Perl6/Metamodel/ParametricRoleHOW.nqp +++ b/src/Perl6/Metamodel/ParametricRoleHOW.nqp @@ -83,9 +83,12 @@ class Perl6::Metamodel::ParametricRoleHOW @rtl.push($!group); } for self.roles_to_compose($obj) { - @rtl.push($_); - for $_.HOW.role_typecheck_list($_) { + my $how := $_.HOW; + if $how.archetypes.composable || $how.archetypes.composalizable { @rtl.push($_); + for $_.HOW.role_typecheck_list($_) { + @rtl.push($_); + } } } @!role_typecheck_list := @rtl; @@ -213,6 +216,16 @@ class Perl6::Metamodel::ParametricRoleHOW my $ins := my $r := $_; if $_.HOW.archetypes.generic { $ins := $ins.HOW.instantiate_generic($ins, $type_env); + unless $ins.HOW.archetypes.parametric { + my $target-name := $obj.HOW.name($obj); + my $role-name := $ins.HOW.name($ins); + Perl6::Metamodel::Configuration.throw_or_die( + 'X::Composition::NotComposable', + $role-name ~ " is not composable, so " ~ $target-name ~ " cannot compose it", + :$target-name, + composer => $ins, + ) + } $conc.HOW.add_to_role_typecheck_list($conc, $ins); } $ins := $ins.HOW.specialize($ins, @pos_args[0]); diff --git a/src/core.c/traits.pm6 b/src/core.c/traits.pm6 index 7b7378fee4d..773ca96b3b0 100644 --- a/src/core.c/traits.pm6 +++ b/src/core.c/traits.pm6 @@ -13,7 +13,9 @@ my class Pod::Block::Declarator { ... } proto sub trait_mod:(Mu $, |) {*} multi sub trait_mod:(Mu:U $child, Mu:U $parent) { - if $parent.HOW.archetypes.inheritable() { + if $parent.HOW.archetypes.inheritable() + || ($child.HOW.archetypes.parametric && $parent.HOW.archetypes.generic) + { $child.^add_parent($parent); } elsif $parent.HOW.archetypes.inheritalizable() { @@ -371,11 +373,14 @@ multi sub trait_mod:(Mu:U $docee, :$trailing_docs!) { proto sub trait_mod:(Mu, Mu, *%) {*} multi sub trait_mod:(Mu:U $doee, Mu:U $role) { - if $role.HOW.archetypes.composable() { + my $how := $role.HOW; + if $how.archetypes.parametric() + || ($doee.HOW.archetypes.parametric && $how.archetypes.generic) + { $doee.^add_role($role) } - elsif $role.HOW.archetypes.composalizable() { - $doee.^add_role($role.HOW.composalize($role)) + elsif $how.archetypes.composalizable() { + $doee.^add_role($how.composalize($role)) } else { X::Composition::NotComposable.new(