Skip to content

Commit

Permalink
Get either parametric or concrete roles in MRO when requested
Browse files Browse the repository at this point in the history 
Change semantics of `:roles` named parameter to returning parametric
groups instead of concretizations to make it conform to `.^roles`
methods.

Add `:concretizations` named for cases when concretizations are more
useful. For example, for methods traversal by `WALK`.
  • Loading branch information
@vrurg
vrurg committed Nov 10, 2021
1 parent 09f5069 commit 856f1af
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 23 deletions.
59 changes: 38 additions & 21 deletions src/Perl6/Metamodel/C3MRO.nqp
View file
Expand Up @@ -6,12 +6,14 @@ role Perl6::Metamodel::C3MRO {
method compute_mro($class) {
%!mro := nqp::hash(
'all', nqp::hash(
'all', nqp::list(),
'no_roles', nqp::list(),
'no_roles', nqp::list(), # MRO with roles excluded
'all', nqp::list(), # MRO with roles as parametric groups
'all_conc', nqp::list(), # MRO with roles as concretizations
),
'unhidden', nqp::hash(
'all', nqp::list(),
'no_roles', nqp::list(),
'all', nqp::list(),
'all_conc', nqp::list(), # MRO with roles as concretizations
),
);
my @immediate_parents := $class.HOW.parents($class, :local);
Expand All @@ -22,16 +24,16 @@ role Perl6::Metamodel::C3MRO {
}

# Provided we have immediate parents...
my @all; # MRO with classes and roles
my @all; # MRO with classes and roles as groups
my @all_conc; # MRO with classes and roles as concretizations
my @no_roles; # MRO with classes only
if +@immediate_parents {
if (+@immediate_parents == 1) && (+@immediate_roles == 0) {
my $parent := @immediate_parents[0];
@all := nqp::clone(
nqp::istype($parent.HOW, Perl6::Metamodel::C3MRO)
?? $parent.HOW.mro($parent, :roles)
!! $parent.HOW.mro($parent)
);
@all_conc := nqp::clone(
nqp::istype($parent.HOW, Perl6::Metamodel::C3MRO)
?? $parent.HOW.mro($parent, :concretizations)
!! $parent.HOW.mro($parent));
}
else {
# Build merge list of linearizations of all our parents, add
Expand All @@ -40,30 +42,41 @@ role Perl6::Metamodel::C3MRO {
@merge_list.push(@immediate_roles);
for @immediate_parents {
@merge_list.push(
nqp::istype($_.HOW, Perl6::Metamodel::C3MRO) ?? $_.HOW.mro($_, :roles) !! $_.HOW.mro($_)
nqp::istype($_.HOW, Perl6::Metamodel::C3MRO) ?? $_.HOW.mro($_, :concretizations) !! $_.HOW.mro($_)
);
}
@merge_list.push(@immediate_parents);
@all := self.c3_merge(@merge_list);
@all_conc := self.c3_merge(@merge_list);
}
}

# Put this class on the start of the list, and we're done.
@all.unshift($class);
@all_conc.unshift($class);

for @all {
if $_.HOW.archetypes.inheritable || nqp::istype($_.HOW, Perl6::Metamodel::NativeHOW) { # i.e. classes or natives
for @all_conc {
if $_.HOW.archetypes.inheritable || nqp::istype($_.HOW, Perl6::Metamodel::NativeHOW) { # I.e. classes or natives
nqp::push(@no_roles, $_);
nqp::push(@all, $_);
}
elsif nqp::istype($_.HOW, Perl6::Metamodel::ConcreteRoleHOW) { # For concretizations fetch their respective parametric groups
my $parametric := $_.HOW.roles($_, :!transitive)[0];
nqp::push(@all, $parametric.HOW.group($parametric));
}
else {
nqp::push(@all, $_);
}
}

# Also compute the unhidden MRO (all the things in the MRO that
# are not somehow hidden).
my @unhidden_all_conc;
my @unhidden_all;
my @unhidden_no_roles;
my %hidden;
my $skip_hidden_roles := 0;
for @all -> $c {
my $i := -1;
while ++$i < nqp::elems(@all_conc) {
my $c := @all_conc[$i];
my $is_inheritable := $c.HOW.archetypes.inheritable;

next if $skip_hidden_roles && !$is_inheritable;
Expand All @@ -73,7 +86,8 @@ role Perl6::Metamodel::C3MRO {
$skip_hidden_roles := 1
}
else {
nqp::push(@unhidden_all, $c);
nqp::push(@unhidden_all_conc, $c);
nqp::push(@unhidden_all, @all[$i]);
nqp::push(@unhidden_no_roles, $c) if $is_inheritable || nqp::istype($c.HOW, Perl6::Metamodel::NativeHOW);
}
if nqp::can($c.HOW, 'hides') {
Expand All @@ -86,10 +100,12 @@ role Perl6::Metamodel::C3MRO {
%!mro := nqp::hash(
'all', nqp::hash(
'all', @all,
'all_conc', @all_conc,
'no_roles', @no_roles,
),
'unhidden', nqp::hash(
'all', @unhidden_all,
'all_conc', @unhidden_all_conc,
'no_roles', @unhidden_no_roles,
),
);
Expand Down Expand Up @@ -162,20 +178,21 @@ role Perl6::Metamodel::C3MRO {
}

# Introspects the Method Resolution Order.
method mro($obj, :$roles = 0, :$unhidden = 0) {
method mro($obj, :$roles = 0, :$concretizations = 0, :$unhidden = 0) {
unless nqp::existskey(%!mro, 'all') {
self.compute_mro($obj);
}
my $all_key := $concretizations ?? 'all_conc' !! 'all';
nqp::atkey(
nqp::atkey(%!mro, $unhidden ?? 'unhidden' !! 'all'),
$roles ?? 'all' !! 'no_roles'
)
$concretizations ?? 'all_conc' !! ($roles ?? 'all' !! 'no_roles')
);
}

# Introspects the Method Resolution Order without anything that has
# been hidden.
method mro_unhidden($obj, :$roles = 0) {
self.mro($obj, :$roles, :unhidden)
method mro_unhidden($obj, :$roles = 0, :$concretizations = 0) {
self.mro($obj, :$roles, :$concretizations, :unhidden)
}

method mro_hash() {
Expand Down
4 changes: 2 additions & 2 deletions src/core.c/Mu.pm6
View file
Expand Up @@ -1040,7 +1040,7 @@ my class Mu { # declared in BOOTSTRAP
}

method !batch-call(Mu \SELF: \name, Capture:D \c, :$throw = False, :$reverse = False, :$roles = False) {
my @mro := SELF.^mro(:$roles);
my @mro := SELF.^mro(concretizations => $roles);
my $results := nqp::create(IterationBuffer);
my int $mro_high = $reverse ?? 0 !! @mro.elems - 1;
my int $i = @mro.elems;
Expand Down Expand Up @@ -1143,7 +1143,7 @@ my class Mu { # declared in BOOTSTRAP
} else {
# Canonical, the default (just whatever the meta-class says) with us
# on the start.
@classes = self.^mro(:$roles);
@classes = self.^mro(concretizations => $roles);
}

# Now we have classes, build method list.
Expand Down

0 comments on commit 856f1af

Please sign in to comment.