[svn:parrot] r34943 - in branches/rvar/languages/perl6/src: builtins parser

Author: pmichaud
Date: Sun Jan  4 14:34:29 2009
New Revision: 34943

Modified:
   branches/rvar/languages/perl6/src/builtins/guts.pir
   branches/rvar/languages/perl6/src/parser/actions.pm

Log:
[rakudo]:  Handle default initialization of some 'has' attributes.


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	Sun Jan  4 14:34:29 2009
@@ -438,7 +438,8 @@
 .sub '!meta_attribute'
     .param pmc metaclass
     .param string name
-    .param string itype
+    .param string itype        :optional
+    .param int has_itype       :opt_flag
     .param pmc attr            :slurpy :named
 
     # twigil handling
@@ -452,14 +453,20 @@
     substr name, 1, 1, '!'
   twigil_done:
 
-    # Add the attribute to the metaclass.
+    $P0 = metaclass.'attributes'()
+    $I0 = exists $P0[name]
+    if $I0 goto attr_exists
     metaclass.'add_attribute'(name)
+    $P0 = metaclass.'attributes'()
+  attr_exists:
 
-    # Set the itype for the attribute.
     .local pmc attrhash, it
-    $P0 = metaclass.'attributes'()
     attrhash = $P0[name]
+
+    # Set any itype for the attribute.
+    unless has_itype goto itype_done
     attrhash['itype'] = itype
+  itype_done:
 
     # and set any other attributes that came in via the slurpy hash
     it = iter attr

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	Sun Jan  4 14:34:29 2009
@@ -1491,9 +1491,12 @@
         }
         $i++;
     }
-    if    $scope eq 'attribute' { $past := PAST::Stmts.new(); }
-    elsif +@($past) == 1        { $past := $past[0]; }
-    else  { $past.name('infix:,'); $past.pasttype('call'); }
+    if $scope eq 'attribute' { 
+        $past.pasttype('null'); 
+        $past<scopedecl> := $scope; 
+    }
+    elsif +@($past) == 1 { $past := $past[0]; }
+    else { $past.name('infix:,'); $past.pasttype('call'); }
     make $past;
 }
 
@@ -1998,26 +2001,14 @@
         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('register')
-                    ),
-                    $lhs.name(),
-                    $rhs
-                )
+        if $lhs<scopedecl> eq 'attribute' {
+            $rhs.named('init_value');
+            our $?METACLASS;
+            $past := PAST::Op.new( :name('!meta_attribute'),
+                         $?METACLASS, $lhs[0].name(), $rhs
             );
-
-            # Nothing to emit at this point.
+            our @?BLOCK;
+            @?BLOCK[0][0].push($past);
             $past := PAST::Stmts.new();
         }
         else {

• [svn:parrot] r34943 - in branches/rvar/languages/perl6/src: builtins parser by pmichaud