/
AttributeContainer.pm
67 lines (57 loc) · 1.86 KB
/
AttributeContainer.pm
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
role Perl6::Metamodel::AttributeContainer {
# Attributes list.
has @!attributes;
has %!attribute_lookup;
# Do we default them to rw?
has $!attr_rw_by_default;
# Adds an attribute.
method add_attribute($obj, $meta_attr) {
my $name := $meta_attr.name;
if pir::exists(%!attribute_lookup, $name) {
pir::die("Package '" ~ self.name($obj) ~
"' already has an attribute named '$name'");
}
@!attributes[+@!attributes] := $meta_attr;
%!attribute_lookup{$name} := $meta_attr;
}
# Composes all attributes.
method compose_attributes($obj) {
for @!attributes {
if $!attr_rw_by_default { $_.default_to_rw() }
$_.compose($obj);
}
}
# Makes setting the type represented by the meta-object rw mean that its
# attributes are rw by default.
method set_rw($obj) {
$!attr_rw_by_default := 1;
}
# Is this type's attributes rw by default?
method rw($obj) {
$!attr_rw_by_default
}
# Gets the attribute meta-object for an attribute if it exists.
# This is called by the parser so it should only return attributes
# that are visible inside the current package.
method get_attribute_for_usage($obj, $name) {
unless pir::exists(%!attribute_lookup, $name) {
pir::die("No $name attribute in " ~ self.name($obj))
}
%!attribute_lookup{$name}
}
# Introspect attributes.
method attributes($obj, :$local, :$excl, :$all) {
my @attrs;
for @!attributes {
@attrs.push($_);
}
unless $local {
for self.parents($obj, :excl($excl), :all($all)) {
for $_.HOW.attributes($_, :local(1)) {
@attrs.push($_);
}
}
}
@attrs
}
}