/
RoleToClassApplier.nqp
98 lines (77 loc) · 2.49 KB
/
RoleToClassApplier.nqp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
=begin
=head1 TITLE
Perl6::Metamodel::RoleToClassApplier
=head1 DESCRIPTION
Applies roles to a class.
=head1 METHODS
=over 4
=item apply(target, composees)
Applies the composees to the class. If there is more than one, it builds up a
composite role first.
=end
class Perl6::Metamodel::RoleToClassApplier;
sub has_method($target, $name, $local) {
my @methods := $target.methods($target, :local($local));
for @methods {
if $_.name eq $name { return 1; }
}
return 0;
}
sub has_attribute($target, $name) {
my @attributes := $target.attributes($target, :local(1));
for @attributes {
if $_.name eq $name { return 1; }
}
return 0;
}
method apply($target, @composees) {
# If we have many things to compose, then get them into a single helper
# role first.
my $to_compose;
my $to_compose_meta;
if +@composees == 1 {
$to_compose := @composees[0];
$to_compose_meta := $to_compose.HOW;
}
else {
$to_compose_meta := RoleHOW.new();
for @composees {
RoleHOW.add_composable($to_compose_meta, $_);
}
$to_compose := RoleHOW.compose($to_compose_meta);
}
# Collisions?
my @collisions := RoleHOW.collisions($to_compose_meta);
for @collisions {
unless has_method($target, ~$_, 1) {
# XXX This error is LTA.
pir::die("Method '$_' collides and a resolution must be provided by the class");
}
}
# Unsatisfied requirements?
my @requirements := RoleHOW.requirements($to_compose_meta);
for @requirements {
unless has_method($target, ~$_, 0) {
# XXX This error is LTA.
pir::die("Method '$_' is required by a role and must be provided by the class, a parent class or by composing another role that implements it");
}
}
# Do Parrot-level composition, which handles the methods.
pir::addrole__vPP(pir::getattribute__PPS($target, 'parrotclass'), $to_compose);
# Compose in any role attributes.
my @attributes := RoleHOW.attributes($to_compose_meta);
for @attributes {
if has_attribute($target, $_.name) {
pir::die("Attribute '" ~ $_.name ~ "' already exists in the class, but a role also wishes to compose it");
}
$target.add_attribute($target, $_);
}
# Add any parents that are passed along as impl detail.
my @parents := RoleHOW.parents($to_compose_meta);
for @parents {
$target.add_parent($target, $_);
}
}
=begin
=back
=end