← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/core/Signature.pm

  • 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/core/Signature.pm
 
1
augment class Signature {
 
2
    method ACCEPTS(Signature) {
 
3
        die("Sorry, smart-matching a Signature against a Signature is not yet implemented.");
 
4
    }
 
5
    
 
6
    method ACCEPTS(Callable) {
 
7
        die("Sorry, smart-matching a Callable against a Signature is not yet implemented.");
 
8
    }
 
9
    
 
10
    method ACCEPTS(Capture $c) {
 
11
        my $result = Bool::False;
 
12
        try {
 
13
            self!BIND($c);
 
14
            $result = Bool::True;
 
15
        }
 
16
        $result
 
17
    }
 
18
    
 
19
    method ACCEPTS($any) {
 
20
        my $result = Bool::False;
 
21
        try {
 
22
            self!BIND((|$any).Capture);
 
23
            $result = Bool::True;
 
24
        }
 
25
        $result
 
26
    }
 
27
 
 
28
    method perl() {
 
29
        my @parts = gather {
 
30
            take ':(';
 
31
            my $sep = '';
 
32
            my $last_was_multi_inv = True;
 
33
            for $.params -> $param {
 
34
                # First, separator, if any.
 
35
                if $last_was_multi_inv && !$param.multi_invocant { $sep = ';; ' }
 
36
                take ~$sep;
 
37
                $sep = ', ';
 
38
 
 
39
                # First the type.
 
40
                my $name = $param.name;
 
41
 
 
42
                if !$param.slurpy {
 
43
                    my $sigil = $name.substr(0, 1);
 
44
                    my $perl = $param.type.perl;
 
45
                    if $sigil eq '$' {
 
46
                        take $perl ~ ' ';
 
47
                    }
 
48
                    elsif $sigil eq '@' {
 
49
                        if $perl ne 'Positional' {
 
50
                            take $perl.substr(11, $perl.chars - 12) ~ ' ';
 
51
                        }
 
52
                    }
 
53
                    elsif $sigil eq '%' {
 
54
                        if $perl ne 'Associative' {
 
55
                            take $perl.substr(12, $perl.chars - 13) ~ ' ';
 
56
                        }
 
57
                    }
 
58
                    elsif $perl.substr(0, 8) eq 'Callable' {
 
59
                        if $perl ne 'Callable' {
 
60
                            take $perl.substr(9, $perl.chars - 10) ~ ' ';
 
61
                        }
 
62
                    }
 
63
                    else {
 
64
                        take $perl ~ ' ';
 
65
                    }
 
66
                }
 
67
 
 
68
                # Any type captures.
 
69
                for @($param.type_captures) -> $name {
 
70
                    take '::' ~ $name ~ ' ';
 
71
                }
 
72
 
 
73
                # Slurpiness, namedness, then the name.
 
74
                if $param.slurpy  { take '*' }
 
75
                if $param.capture { take '|' }
 
76
                if $param.parcel  { take '\|' }
 
77
                my @names = @($param.named_names);
 
78
                for @names -> $name {
 
79
                    take ':' ~ $name ~ '(';
 
80
                }
 
81
                take $name;
 
82
                take ')' x +@names;
 
83
 
 
84
                # Optionality.
 
85
                if $param.optional && !$param.named && !$param.default   { take '?' }
 
86
                elsif !$param.optional && $param.named && !$param.slurpy { take '!' }
 
87
 
 
88
                # Any constraints?
 
89
                my $cons_perl = $param.constraints.perl;
 
90
                if $cons_perl ne 'Bool::True' {
 
91
                    take ' where ' ~ $cons_perl;
 
92
                }
 
93
                
 
94
                # Any sub-signature?
 
95
                if $param.signature {
 
96
                    take ' ' ~ $param.signature.perl.substr(1);
 
97
                }
 
98
 
 
99
                # Default.
 
100
                if $param.default {
 
101
                    take ' = ' ~ $param.default.perl;
 
102
                }
 
103
 
 
104
                # Invocant/multi invocant marking.
 
105
                if $param.invocant { $sep = ': '; }
 
106
                $last_was_multi_inv = $param.multi_invocant;
 
107
            }
 
108
            take ')';
 
109
        };
 
110
        return @parts.join('');
 
111
    }
 
112
}
 
113
 
 
114
# vim: ft=perl6