Author: pmichaud
Date: Fri Jan 2 17:11:46 2009
New Revision: 34842
Modified:
branches/rvar/languages/perl6/src/builtins/guts.pir
branches/rvar/languages/perl6/src/parser/actions.pm
Log:
[rakudo]: Handle public accessors for 'has' variables.
Modified: branches/rvar/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rvar/languages/perl6/src/builtins/guts.pir (original)
+++ branches/rvar/languages/perl6/src/builtins/guts.pir Fri Jan 2 17:11:46 2009
@@ -441,11 +441,22 @@
.param string itype
.param pmc attr :slurpy :named
- # If the name doesn't have a twigil, we give it one.
- $S0 = substr name, 1, 1
- if $S0 == '!' goto have_name
+ # twigil handling
+ .local string twigil
+ twigil = substr name, 1, 1
+ if twigil == '.' goto twigil_public
+ if twigil == '!' goto twigil_done
substr name, 1, 0, '!'
- have_name:
+ goto twigil_done
+ twigil_public:
+ substr name, 1, 1, '!'
+ .const 'Sub' accessor = '!default_accessor'
+ $P0 = clone accessor
+ $P1 = box name
+ setprop $P0, 'name', $P1
+ $S0 = substr name, 2
+ metaclass.'add_method'($S0, $P0)
+ twigil_done:
# Add the attribute to the metaclass.
metaclass.'add_attribute'(name)
@@ -468,6 +479,17 @@
.end
+.sub '!default_accessor' :anon :method
+ .local pmc interp, accessor
+ interp = getinterp
+ accessor = interp['sub']
+ $P0 = getprop 'name', accessor
+ $S0 = $P0
+ $P1 = getattribute self, $S0
+ .return ($P1)
+.end
+
+
=item !keyword_class(name)
Internal helper method to create a class.
Modified: branches/rvar/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar/languages/perl6/src/parser/actions.pm (original)
+++ branches/rvar/languages/perl6/src/parser/actions.pm Fri Jan 2 17:11:46 2009
@@ -1512,6 +1512,11 @@
method variable_declarator($/) {
our @?BLOCK;
my $var := $( $<variable> );
+
+ ## The $<variable> subrule might've saved a PAST::Var node for
+ ## us (e.g., $.x), if so, use it instead.
+
+ if $var<vardecl> { $var := $var<vardecl>; }
my $name := $var.name();
my $symbol := @?BLOCK[0].symbol( $name );
if $symbol<scope> eq 'lexical' {
@@ -1536,6 +1541,13 @@
my $varname := $sigil ~ $name;
$past := PAST::Var.new( :name($varname), :node($/) );
+ ## if namespace qualified or has a '*' twigil, it's a package var
+ if @identifier || $twigil eq '*' {
+ $past.namespace(@identifier);
+ $past.scope('package');
+ $past.viviself( container_itype($sigil) );
+ }
+
if $varname eq '@_' || $varname eq '%_' {
unless $?BLOCK.symbol($varname) {
$?BLOCK.symbol( $varname, :scope('lexical') );
@@ -1548,6 +1560,7 @@
}
if $sigil eq '&' {
+ $sigil := '';
$varname := $name;
$past.name($varname);
$past.scope('package');
@@ -1575,20 +1588,33 @@
}
}
- ## if namespace qualified or has a '*' twigil, it's a package var
- if @identifier || $twigil eq '*' {
- $past.namespace(@identifier);
- $past.scope('package');
- $past.viviself( container_itype($sigil) );
+ ## if no twigil, but variable is 'attribute' in an outer scope,
+ ## it's really a private attribute
+ if !$twigil {
+ my $sym := outer_symbol($varname);
+ if $sym && $sym<scope> eq 'attribute' { $twigil := '!' };
}
- ## if ! twigil, it's a private attribute
- if $twigil eq '!' {
+ ## handle ! and . twigil as attribute lookup...
+ our @?IN_DECL;
+ if $twigil eq '!' || $twigil eq '.' {
$varname := $sigil ~ $twigil ~ $name;
$past.name($varname);
$past.scope('attribute');
$past.unshift( PAST::Var.new( :name('self'), :scope('lexical') ) );
}
+
+ ## ...but return . twigil as a method call, saving the
+ ## PAST::Var node in $past <vardecl>where it can be easily
+ ## retrieved by <variable_declarator> if we're called from there.
+ if $twigil eq '.' {
+ my $var := $past;
+ $past := PAST::Op.new( :node($/), :pasttype('callmethod'),
+ :name($name),
+ PAST::Var.new( :name('self'), :scope('lexical') )
+ );
+ $past<vardecl> := $var;
+ }
}
elsif $key eq 'special_variable' {
$past := $( $<special_variable> );
