← Back to branch summary

~ubuntu-branches/ubuntu/precise/rakudo/precise

« back to all changes in this revision

Viewing changes to src/metamodel/Attribute.nqp

  • Committer: Bazaar Package Importer
  • Author(s): Alessandro Ghedini
  • Date: 2011-05-17 11:31:09 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20110517113109-rmfir654u1axbpt4
Tags: 0.1~2011.04-1
http://bugs.debian.org/601862
http://bugs.debian.org/585762
http://bugs.debian.org/577502
http://bugs.debian.org/584498
* New upstream release (Closes: #601862, #585762, #577502)
* New maintainer
* Switch to 3.0 (quilt) format
* Update dependencies (Closes: #584498)
* Update debian/copyright to lastest DEP5 revision
* Do not generate/install perl6 manpage (now done by the build system)
* Enable tests
* Bump Standards-Version to 3.9.2 (no changes needed)
* Do not install extra LICENSE files and duplicated docs
* Remove debian/clean (no more needed)
* Add Vcs-* fields in debian/control
* Rewrite (short) description
* Update upstream copyright years
* Upload to unstable

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/metamodel/Attribute.nqp
 
1
class Attribute is Any;
 
2
 
 
3
has $!name;
 
4
has $!type;
 
5
has $!build;
 
6
has $!has_accessor;
 
7
has $!rw;
 
8
has $!handles;
 
9
has $!trait_applier;
 
10
 
 
11
method new(:$name, :$type, :$build, :$has_accessor, :$rw, :$handles) {
 
12
    my $attr := pir::new__PS('Attribute');
 
13
    pir::setattribute__vPSP($attr, '$!name', $name);
 
14
    pir::setattribute__vPSP($attr, '$!type', $type);
 
15
    pir::setattribute__vPSP($attr, '$!build', $build);
 
16
    pir::setattribute__vPSP($attr, '$!has_accessor', $has_accessor);
 
17
    pir::setattribute__vPSP($attr, '$!rw', $rw);
 
18
    pir::setattribute__vPSP($attr, '$!handles', $handles);
 
19
    $attr
 
20
}
 
21
 
 
22
method name() {
 
23
    $!name
 
24
}
 
25
 
 
26
method type() {
 
27
    $!type
 
28
}
 
29
 
 
30
method build() {
 
31
    $!build || Mu
 
32
}
 
33
 
 
34
method has_accessor() {
 
35
    $!has_accessor
 
36
}
 
37
 
 
38
method rw() {
 
39
    $!rw ?? Bool::True !! Bool::False
 
40
}
 
41
 
 
42
method handles() {
 
43
    $!handles
 
44
}
 
45
 
 
46
method readonly() {
 
47
    !$!rw
 
48
}
 
49
 
 
50
method apply_traits($metaclass, $container) {
 
51
    if $!trait_applier {
 
52
        my $decl := AttributeDeclarand.new(
 
53
            container => $container,
 
54
            how => $metaclass,
 
55
            name => $!name
 
56
        );
 
57
        $!trait_applier($decl);
 
58
    }
 
59
}
 
60
 
 
61
method compose($package) {
 
62
    my $name := $!name;
 
63
    
 
64
    # Generate an accessor, if we need one.
 
65
    if $!has_accessor {
 
66
        # Accessor helper subs. We make sure they are surrounded
 
67
        # by annotations to make the backtrace printer ignore them,
 
68
        # or otherwise we get line numbers from this file, which is
 
69
        # totally useless to the dear programmer trying to debug their
 
70
        # codez.
 
71
        sub dummy_1() { Q:PIR { .annotate 'invizible_frame', 1 }; }
 
72
        sub accessor_helper_ro($self) {
 
73
            pir::new__PsP('Perl6Scalar', pir::getattribute__PPS($self, $name))
 
74
        }
 
75
        sub accessor_helper_rw($self) {
 
76
            pir::getattribute__PPS($self, $name)
 
77
        }
 
78
        sub dummy_2() { Q:PIR { .annotate 'invizible_frame', 0 }; }
 
79
 
 
80
        # XXX check there isn't already one...
 
81
 
 
82
        # Decide whether we want an rw one or not.
 
83
        my $is_rw := pir::defined($!rw) ?? $!rw !!
 
84
                     pir::can__ips($package, 'rw') ?? $package.rw !! 0;
 
85
        my $meth := pir::find_lex__ps($is_rw ?? 'accessor_helper_rw' !! 'accessor_helper_ro');
 
86
        $meth := pir::clone($meth);
 
87
 
 
88
        # introspection looks at the actual sub name, so set it
 
89
        # to the value the user expects
 
90
        # set $P0, $S0  is parrot's clunky PIR API for setting the sub name.
 
91
        my $meth_name := pir::substr__SSi($name, 2);
 
92
        pir::set__vps($meth, $meth_name);
 
93
        $package.add_method($package, $meth_name, $meth);
 
94
    }
 
95
 
 
96
    # If we've a handles, pass it along to the handles setup helper.
 
97
    unless pir::isa__ips($!handles, 'Undef') {
 
98
        Rakudo::Guts.add_handles_method($package, $!name, $!handles);
 
99
    }
 
100
}
 
101
 
 
102
# vim: ft=perl6