develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35167 - in branches/rvar2/languages/perl6/src: builtins parser

From:
pmichaud
Date:
January 7, 2009 10:54
Subject:
[svn:parrot] r35167 - in branches/rvar2/languages/perl6/src: builtins parser
Message ID:
20090107185445.737F1CB9F9@x12.develooper.com
Author: pmichaud
Date: Wed Jan  7 10:54:44 2009
New Revision: 35167

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

Log:
[rakudo]:  More "has $x" cleanups (jonathan++)
* I may want to refactor this yet again a bit, but this is relatively
  clean and works for now.


Modified: branches/rvar2/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/builtins/guts.pir	(original)
+++ branches/rvar2/languages/perl6/src/builtins/guts.pir	Wed Jan  7 10:54:44 2009
@@ -491,6 +491,17 @@
     .param int has_itype       :opt_flag
     .param pmc attr            :slurpy :named
 
+    # twigil handling
+    .local string twigil
+    twigil = substr name, 1, 1
+    if twigil == '.' goto twigil_public
+    if twigil == '!' goto twigil_done
+    substr name, 1, 0, '!'
+    goto twigil_done
+  twigil_public:
+    substr name, 1, 1, '!'
+  twigil_done:
+
     $P0 = metaclass.'attributes'()
     $I0 = exists $P0[name]
     if $I0 goto attr_exists

Modified: branches/rvar2/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar2/languages/perl6/src/parser/actions.pm	(original)
+++ branches/rvar2/languages/perl6/src/parser/actions.pm	Wed Jan  7 10:54:44 2009
@@ -1075,7 +1075,10 @@
 method param_var($/) {
     my $name := ~$/;
     my $twigil := ~$<twigil>[0];
-    if $twigil && $twigil ne '.' && $twigil ne '!' {
+    if $twigil eq '.' {
+        $name := ~$<sigil> ~ '!' ~ $<identifier>;
+    }
+    elsif $twigil && $twigil ne '!' {
         $/.panic('Invalid twigil used in signature parameter.');
     }
     my $var := PAST::Var.new(
@@ -1083,7 +1086,8 @@
         :scope('parameter'),
         :node($/)
     );
-    $var<itype> := container_itype( $<sigil> );
+    $var<twigil> := $twigil;
+    $var<itype>  := container_itype( $<sigil> );
     # Declare symbol as lexical in current (signature) block.
     # This is needed in case any post_constraints try to reference
     # this new param_var.
@@ -1405,17 +1409,6 @@
             if $_.isa(PAST::Var) {
                 my $var := $_;
 
-                # If it's an attribute with no twigil, need to modify the
-                # name to include one, but also register it in the block
-                # with the original name.
-                if $scope eq 'attribute' && $var<twigil> eq '' {
-                    $block.symbol( $var.name(), :scope($scope) );
-                    $var<twigil> := '!';
-                    my $sigil := substr($var.name(), 0, 1);
-                    my $name  := substr($var.name(), 1);
-                    $var.name($sigil ~ '!' ~ $name);
-                }
-
                 # This is a variable declaration, so we set the scope in
                 # the block's symbol table as well as the variable itself.
                 $block.symbol( $var.name(), :scope($scope) );
@@ -1450,6 +1443,13 @@
                 }
 
                 if $scope eq 'attribute' {
+                    # If no twigil, we need a twigiled entry of
+                    # the attribute in the block's symbol table.
+                    if $var<twigil> eq '' {
+                        my $sigil := substr($var.name(), 0, 1);
+                        my $name  := substr($var.name(), 1);
+                        $block.symbol( $sigil ~ '!' ~ $name, :scope($scope));
+                    }
                     my $pkgdecl := $block<pkgdecl>;
                     unless $pkgdecl eq 'class' || $pkgdecl eq 'role'
                             || $pkgdecl eq 'grammar' {



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