/
Attribute.nqp
75 lines (61 loc) · 1.65 KB
/
Attribute.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
class Attribute;
has $!name;
has $!type;
has $!build;
has $!has_accessor;
has $!rw;
has $!handles;
method new(:$name, :$type, :$build, :$has_accessor, :$rw, :$handles) {
my $attr := pir::new__PS('Attribute');
pir::setattribute__vPSP($attr, '$!name', $name);
pir::setattribute__vPSP($attr, '$!type', $type);
pir::setattribute__vPSP($attr, '$!build', $build);
pir::setattribute__vPSP($attr, '$!has_accessor', $has_accessor);
pir::setattribute__vPSP($attr, '$!rw', $rw);
pir::setattribute__vPSP($attr, '$!handles', $handles);
$attr
}
method name() {
$!name
}
method type() {
$!type
}
method build() {
$!build;
}
method has_accessor() {
$!has_accessor
}
method rw() {
$!rw
}
method handles() {
$!handles
}
method readonly() {
!$!rw
}
method compose($package) {
my $name := $!name;
# Generate an accessor, if we need one.
if $!has_accessor {
# Accessor helper subs.
sub accessor_helper_ro($self) {
pir::new__PsP('Perl6Scalar', pir::getattribute__PPS($self, $name))
}
sub accessor_helper_rw($self) {
pir::getattribute__PPS($self, $name)
}
# XXX check there isn't already one...
my $meth := $!rw ?? pir::find_lex__Ps('accessor_helper_rw') !! pir::find_lex__Ps('accessor_helper_ro');
my $meth_name := pir::substr__SSi($name, 2);
$meth := pir::clone__PP($meth);
# introspection looks at the actual sub name, so set it
# to the value the user expects
pir::set__vps($meth, $meth_name);
$package.add_method($package, $meth_name, $meth);
}
# XXX Handles...
}
# vim: ft=perl6