Author: jonathan
Date: Tue Dec 9 14:23:59 2008
New Revision: 33728
Modified:
trunk/languages/perl6/src/builtins/guts.pir
trunk/languages/perl6/src/parser/actions.pm
trunk/languages/perl6/src/parser/grammar-oper.pg
Log:
[rakudo] First cut of initializing attributes at the point of declaration (has
$.x = 42).
Modified: trunk/languages/perl6/src/builtins/guts.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/guts.pir (original)
+++ trunk/languages/perl6/src/builtins/guts.pir Tue Dec 9 14:23:59 2008
@@ -525,6 +525,63 @@
.end
+=item !ADD_TO_WHENCE
+
+Adds a key/value mapping to what will become the WHENCE on a proto-object (we
+don't have a proto-object to stick them on yet, so we put a property on the
+class temporarily, then attach it as the WHENCE clause later).
+
+=cut
+
+.sub '!ADD_TO_WHENCE'
+ .param pmc class
+ .param pmc attr_name
+ .param pmc value
+
+ # Get hash if we have it, if not make it.
+ .local pmc whence_hash
+ whence_hash = getprop '%!WHENCE', class
+ unless null whence_hash goto have_hash
+ whence_hash = new 'Perl6Hash'
+ setprop class, '%!WHENCE', whence_hash
+
+ # Make entry.
+ have_hash:
+ whence_hash[attr_name] = value
+.end
+
+
+=item !PROTOINIT
+
+Called after a new proto-object has been made for a new class or grammar. It
+finds any WHENCE data that we may need to add.
+
+=cut
+
+.sub '!PROTOINIT'
+ .param pmc proto
+
+ # See if there's any attribute initializers.
+ .local pmc p6meta, WHENCE
+ p6meta = get_hll_global ['Perl6Object'], '$!P6META'
+ $P0 = p6meta.'get_parrotclass'(proto)
+ WHENCE = getprop '%!WHENCE', $P0
+ if null WHENCE goto no_whence
+
+ # Attach the WHENCE property.
+ .local pmc props
+ props = getattribute proto, '%!properties'
+ unless null props goto have_props
+ props = new 'Hash'
+ have_props:
+ props['WHENCE'] = WHENCE
+ setattribute proto, '%!properties', props
+ no_whence:
+
+ .return (proto)
+.end
+
+
=item !anon_enum(value_list)
Constructs a Mapping, based upon the values list.
Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Tue Dec 9 14:23:59 2008
@@ -1859,20 +1859,24 @@
# Make proto-object for grammar.
$?GRAMMAR.push(
PAST::Op.new(
- :pasttype('callmethod'),
- :name('register'),
- PAST::Var.new(
- :scope('package'),
- :name('$!P6META'),
- :namespace('Perl6Object')
- ),
- PAST::Var.new(
- :scope('lexical'),
- :name('$def')
- ),
- PAST::Val.new(
- :value('Grammar'),
- :named( PAST::Val.new( :value('parent') ) )
+ :pasttype('call'),
+ :name('!PROTOINIT'),
+ PAST::Op.new(
+ :pasttype('callmethod'),
+ :name('register'),
+ PAST::Var.new(
+ :scope('package'),
+ :name('$!P6META'),
+ :namespace('Perl6Object')
+ ),
+ PAST::Var.new(
+ :scope('lexical'),
+ :name('$def')
+ ),
+ PAST::Val.new(
+ :value('Grammar'),
+ :named( PAST::Val.new( :value('parent') ) )
+ )
)
)
);
@@ -1896,20 +1900,24 @@
# It's a new class definition. Make proto-object.
$?CLASS.push(
PAST::Op.new(
- :pasttype('callmethod'),
- :name('register'),
- PAST::Var.new(
- :scope('package'),
- :name('$!P6META'),
- :namespace('Perl6Object')
- ),
- PAST::Var.new(
- :scope('lexical'),
- :name('$def')
- ),
- PAST::Val.new(
- :value('Any'),
- :named( PAST::Val.new( :value('parent') ) )
+ :pasttype('call'),
+ :name('!PROTOINIT'),
+ PAST::Op.new(
+ :pasttype('callmethod'),
+ :name('register'),
+ PAST::Var.new(
+ :scope('package'),
+ :name('$!P6META'),
+ :namespace('Perl6Object')
+ ),
+ PAST::Var.new(
+ :scope('lexical'),
+ :name('$def')
+ ),
+ PAST::Val.new(
+ :value('Any'),
+ :named( PAST::Val.new( :value('parent') ) )
+ )
)
)
);
@@ -2260,8 +2268,14 @@
my $name :=
~$<scoped><declarator><variable_declarator><variable><name>;
declare_attribute($/, $declarator, $sigil, $twigil, $name);
- # We don't have any PAST at the point of the declaration.
- $past := PAST::Stmts.new();
+ # Always leave a PAST::Var attribute node behind (can't just use
what was
+ # produced as . twigil may have transformed it to a method call).
+ $past := PAST::Var.new(
+ :node($<scoped><declarator><variable_declarator><variable>),
+ :name($name),
+ :scope('attribute'),
+ :isdecl(1)
+ );
}
# If we're in a class and have something declared with a sigil, then
@@ -2881,6 +2895,46 @@
if $key eq 'end' {
make $($<expr>);
}
+ elsif ~$type eq 'infix:=' {
+ my $lhs := $( $/[0] );
+ my $rhs := $( $/[1] );
+ my $past;
+
+ # Is it an assignment to an attribute?
+ if $lhs.isa(PAST::Var) && $lhs.scope() eq 'attribute' && $lhs.isdecl()
{
+ # Add this to the WHENCE clause.
+ # XXX Need to make it a closure, but will need :subid to get
+ # scoping right.
+ our $?CLASS;
+ $?CLASS.push(
+ PAST::Op.new(
+ :pasttype('call'),
+ :name('!ADD_TO_WHENCE'),
+ PAST::Var.new(
+ :name('$def'),
+ :scope('lexical')
+ ),
+ $lhs.name(),
+ $rhs
+ )
+ );
+
+ # Nothing to emit at this point.
+ $past := PAST::Stmts.new();
+ }
+ else {
+ # Just a normal assignment.
+ $past := PAST::Op.new(
+ :pasttype('call'),
+ :name('infix:='),
+ :lvalue(1),
+ $lhs,
+ $rhs
+ );
+ }
+
+ make $past;
+ }
elsif ~$type eq 'infix:.=' {
my $invocant := $( $/[0] );
my $call := $( $/[1] );
Modified: trunk/languages/perl6/src/parser/grammar-oper.pg
==============================================================================
--- trunk/languages/perl6/src/parser/grammar-oper.pg (original)
+++ trunk/languages/perl6/src/parser/grammar-oper.pg Tue Dec 9 14:23:59 2008
@@ -164,8 +164,6 @@
## list assignment
proto infix:<=> is precedence('e=')
-# is pasttype('copy')
- is pasttype('call')
is assoc('right')
is lvalue(1)
{ ... }
