Skip to content
Permalink
Browse files

Fixed #2657

  • Loading branch information...
vrurg committed Feb 6, 2019
1 parent 92ebc33 commit a6c8180f5d7e8eceb575c34573531ce86af8164f
@@ -22,10 +22,10 @@ class Perl6::Metamodel::ClassHOW
does Perl6::Metamodel::REPRComposeProtocol
does Perl6::Metamodel::InvocationProtocol
does Perl6::Metamodel::Finalization
does Perl6::Metamodel::Concretization
{
has @!roles;
has @!role_typecheck_list;
has @!concretizations;
has @!fallbacks;
has $!composed;

@@ -98,7 +98,7 @@ class Perl6::Metamodel::ClassHOW
@!role_typecheck_list[+@!role_typecheck_list] := $r;
my $ins := $r.HOW.specialize($r, $obj);
@ins_roles.push($ins);
nqp::push(@!concretizations, [$r, $ins]);
self.add_concretization($obj, $r, $ins);
}
self.compute_mro($obj); # to the best of our knowledge, because the role applier wants it.
@stubs := RoleToClassApplier.apply($obj, @ins_roles);
@@ -249,15 +249,6 @@ class Perl6::Metamodel::ClassHOW
$!composed ?? @!role_typecheck_list !! self.roles_to_compose($obj)
}

method concretization($obj, $ptype) {
for @!concretizations {
if nqp::decont($_[0]) =:= nqp::decont($ptype) {
return $_[1];
}
}
nqp::die("No concretization found for " ~ $ptype.HOW.name($ptype));
}

method is_composed($obj) {
$!composed
}
@@ -8,6 +8,7 @@ class Perl6::Metamodel::ConcreteRoleHOW
does Perl6::Metamodel::RoleContainer
does Perl6::Metamodel::MultipleInheritance
does Perl6::Metamodel::ArrayType
does Perl6::Metamodel::Concretization
{
# Any collisions to resolve.
has @!collisions;
@@ -0,0 +1,37 @@
# Support for mapping of non-specialized roles into their concretized state.
role Perl6::Metamodel::Concretization {
has @!concretizations;

method add_concretization($obj, $role, $concrete) {
@!concretizations[+@!concretizations] := [$role, $concrete];
}

method concretization_lookup($obj, $ptype, :$local, :$transitive) {
my @result;
if nqp::istype($obj, $ptype) {
for @!concretizations {
if nqp::decont($_[0]) =:= nqp::decont($ptype) {
return [1, $_[1]];
}
# Do preliminary type check for concrete role to avoid extra calls.
if $transitive && nqp::istype($_[1], $ptype) {
@result := $_[1].HOW.concretization_lookup($_[1], $ptype, :$local, :transitive(1));
return @result if @result[0];
}
}
unless $local {
for self.parents($obj, :local(1)) {
@result := $_.HOW.concretization_lookup($_, $ptype, :local(0), :$transitive);
return @result if @result[0];
}
}
}
[0]
}

method concretization($obj, $ptype, :$local = 0, :$transitive = 1) {
my @result := self.concretization_lookup($obj, $ptype, :$local, :$transitive);
nqp::die("No concretization found for " ~ $ptype.HOW.name($ptype)) unless @result[0];
@result[1]
}
}
@@ -26,8 +26,8 @@ role Perl6::Metamodel::MROBasedMethodDispatch {

method find_method_qualified($obj, $qtype, $name) {
if $qtype.HOW.archetypes.parametric && nqp::can(self, 'concretization') {
# Resolve it via the concrete form of this parametric.
my $conc := self.concretization($obj, $qtype);
# Resolve it via the concrete form of this parametric. Look deep for a candidate.
my $conc := self.concretization($obj, $qtype, :local(0), :transitive(1));
nqp::hllize($conc.HOW.method_table($conc)){$name}
}
else {
@@ -192,12 +192,14 @@ class Perl6::Metamodel::ParametricRoleHOW
# Roles done by this role need fully specializing also; all
# they'll be missing is the target class (e.g. our first arg).
for self.roles_to_compose($obj) {
my $r := $_;
my $ins := my $r := $_;
if $_.HOW.archetypes.generic {
$r := $r.HOW.instantiate_generic($r, $type_env);
$conc.HOW.add_to_role_typecheck_list($conc, $r);
$ins := $ins.HOW.instantiate_generic($ins, $type_env);
$conc.HOW.add_to_role_typecheck_list($conc, $ins);
}
$conc.HOW.add_role($conc, $r.HOW.specialize($r, @pos_args[0]));
$ins := $ins.HOW.specialize($ins, @pos_args[0]);
$conc.HOW.add_role($conc, $ins);
$conc.HOW.add_concretization($conc, $r, $ins);
}

# Pass along any parents that have been added, resolving them in
@@ -31,6 +31,7 @@ src/Perl6/Metamodel/InvocationProtocol.nqp
src/Perl6/Metamodel/RolePunning.nqp
src/Perl6/Metamodel/ArrayType.nqp
src/Perl6/Metamodel/RoleToRoleApplier.nqp
src/Perl6/Metamodel/Concretization.nqp
src/Perl6/Metamodel/ConcreteRoleHOW.nqp
src/Perl6/Metamodel/CurriedRoleHOW.nqp
src/Perl6/Metamodel/ParametricRoleHOW.nqp

0 comments on commit a6c8180

Please sign in to comment.
You can’t perform that action at this time.