Skip to content

Commit

Permalink
Support generics with consumtion/inheritance in roles
Browse files Browse the repository at this point in the history 
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.
  • Loading branch information
@vrurg
vrurg committed Jun 17, 2021
1 parent 4f61a10 commit 4b99656
Show file tree
Hide file tree
Showing 3 changed files with 59 additions and 12 deletions.
41 changes: 35 additions & 6 deletions src/Perl6/Metamodel/CurriedRoleHOW.nqp
View file
Expand Up @@ -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;

Expand Down Expand Up @@ -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);
}
Expand All @@ -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;
Expand Down Expand Up @@ -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 {
Expand Down
17 changes: 15 additions & 2 deletions src/Perl6/Metamodel/ParametricRoleHOW.nqp
View file
Expand Up @@ -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;
Expand Down Expand Up @@ -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]);
Expand Down
13 changes: 9 additions & 4 deletions src/core.c/traits.pm6
View file
Expand Up @@ -13,7 +13,9 @@ my class Pod::Block::Declarator { ... }

proto sub trait_mod:<is>(Mu $, |) {*}
multi sub trait_mod:<is>(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() {
Expand Down Expand Up @@ -371,11 +373,14 @@ multi sub trait_mod:<is>(Mu:U $docee, :$trailing_docs!) {

proto sub trait_mod:<does>(Mu, Mu, *%) {*}
multi sub trait_mod:<does>(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(
Expand Down

0 comments on commit 4b99656

Please sign in to comment.