develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r33728 - in trunk/languages/perl6/src: builtins parser

From:
jonathan
Date:
December 9, 2008 14:24
Subject:
[svn:parrot] r33728 - in trunk/languages/perl6/src: builtins parser
Message ID:
20081209222400.4474ACB9AF@x12.develooper.com
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)
     { ... }



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About