Permalink
Browse files

Get $x.Foo::bar method syntax working again, minus a bug the version …

…in alpha had.
  • Loading branch information...
1 parent 8edd6c9 commit 04102ca84d4a5d7651ecd0c5fad01f4a0be9e854 @jnthn jnthn committed Mar 13, 2010
Showing with 49 additions and 4 deletions.
  1. +21 −3 src/Perl6/Actions.pm
  2. +1 −1 src/Perl6/Grammar.pm
  3. +27 −0 src/glue/dispatch.pir
View
@@ -1565,6 +1565,9 @@ method dotty:sym<.>($/) { make $<dottyop>.ast; }
method dotty:sym<.*>($/) {
my $past := $<dottyop>.ast;
+ unless $past.isa(PAST::Op) && $past.pasttype() eq 'callmethod' {
+ $/.CURSOR.panic("Can not use " ~ $<sym>.Str ~ " on a non-identifier method call");
+ }
$past.unshift($past.name);
$past.name('!dispatch_' ~ $<sym>.Str);
$past.pasttype('call');
@@ -1592,13 +1595,28 @@ method privop($/) {
method methodop($/) {
my $past := $<args> ?? $<args>[0].ast !! PAST::Op.new( :node($/) );
- if $<identifier> {
- $past.name( ~$<identifier> );
+ $past.pasttype('callmethod');
+ if $<longname> {
+ # May just be .foo, but could also be .Foo::bar
+ my @parts := Perl6::Grammar::parse_name(~$<longname>);
+ my $name := @parts.pop;
+ if +@parts {
+ $past.unshift(PAST::Var.new(
+ :name(@parts.pop),
+ :namespace(@parts),
+ :scope('package')
+ ));
+ $past.unshift($name);
+ $past.name('!dispatch_::');
+ $past.pasttype('call');
+ }
+ else {
+ $past.name( $name );
+ }
}
elsif $<quote> {
$past.name( $<quote>.ast );
}
- $past.pasttype('callmethod');
make $past;
}
@@ -1092,7 +1092,7 @@ token privop {
token methodop {
[
- | <identifier>
+ | <longname>
| <?before <[ ' " ]> >
<quote>
[ <?before '(' | '.(' | '\\'> || <.panic: "Quoted method name requires parenthesized arguments"> ]
View
@@ -258,6 +258,33 @@ there are none.
.end
+=item !dispatch_::
+
+Helper for handling calls of the form .Foo::bar.
+
+=cut
+
+.sub '!dispatch_::'
+ .param pmc invocant
+ .param string name
+ .param pmc target
+ .param pmc pos_args :slurpy
+ .param pmc named_args :slurpy :named
+ $I0 = target.'ACCEPTS'(invocant)
+ unless $I0 goto not_allowed
+ $P0 = find_method target, name
+ .tailcall $P0(invocant, pos_args :flat, named_args :flat :named)
+ not_allowed:
+ $S0 = "Can not call method '"
+ concat $S0, name
+ concat $S0, "' on unrelated type '"
+ $S1 = target.'perl'()
+ concat $S0, $S1
+ concat $S0, "'"
+ '&die'($S0)
+.end
+
+
=item !deferal_fail
Used by P6invocation to help us get soft-failure semantics when no deferal

0 comments on commit 04102ca

Please sign in to comment.