Permalink
Browse files

implement sigil-change (@a, $a[0])

  • Loading branch information...
1 parent 7ecd591 commit 450a0e0a96cf1bcd530f25f7ea59f3748741bfed @FROGGS FROGGS committed Mar 24, 2013
Showing with 52 additions and 85 deletions.
  1. +4 −36 lib/Perl6/P5Actions.pm
  2. +48 −49 lib/Perl6/P5Grammar.pm
View
@@ -1247,42 +1247,10 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
}
elsif $<semilist> {
$past := $<semilist>.ast;
- if $<sigil> eq '$' && ~$<semilist> eq '' { # for '$()'
- my $result_var := $past.unique('sm_result');
- $past := QAST::Stmt.new(
- # Evaluate RHS and call ACCEPTS on it, passing in $_. Bind the
- # return value to a result variable.
- QAST::Op.new( :op('bind'),
- QAST::Var.new( :name($result_var), :scope('local'), :decl('var') ),
- QAST::Op.new(
- :op('if'),
- # condition
- QAST::Op.new(
- :op('callmethod'), :name('ast'),
- QAST::Var.new( :name('$/'), :scope('lexical') )
- ),
- # when true
- QAST::Op.new(
- :op('callmethod'), :name('ast'),
- QAST::Var.new( :name('$/'), :scope('lexical') )
- ),
- # when false
- QAST::Op.new(
- :op('callmethod'), :name('Str'),
- QAST::Var.new( :name('$/'), :scope('lexical') )
- )
- )
- ),
- # And finally evaluate to the smart-match result.
- QAST::Var.new( :name($result_var), :scope('local') )
- );
- }
- else {
- my $name := ~$<sigil> eq '@' ?? 'list' !!
- ~$<sigil> eq '%' ?? 'hash' !!
- 'item';
- $past := QAST::Op.new( :op('callmethod'), :name($name), $past );
- }
+ my $name := ~$<sigil> eq '@' ?? 'list' !!
+ ~$<sigil> eq '%' ?? 'hash' !!
+ 'item';
+ $past := QAST::Op.new( :op('callmethod'), :name($name), $past );
}
elsif $<infixish> {
my $name := '&infix:<' ~ $<infixish>.Str ~ '>';
View
@@ -271,12 +271,60 @@ role STD5 {
);
}
+# method check_variable ($variable) {
+# my $name := $variable.Str;
+# my $here := self.cursor($variable.from);
+# #self.deb("check_variable $name") if $*DEBUG +& DEBUG::symtab;
+# if $variable<really> { $name := $variable<really> ~ nqp::substr($name,1) }
+# my @parts := $name ~~ /(\$|\@|\%|\&|\*)(.?)/;
+# my $sigil := @parts[0];
+# my $first := @parts[1];
+# return self if $first eq '{';
+# my $ok := 0;
+# $ok := $ok || $*IN_DECL;
+# $ok := $ok || $first lt 'A';
+# $ok := $ok || $sigil eq '*';
+# $ok := $ok || self.is_known($name);
+# $ok := $ok || ($*IN_SORT && ($name eq '$a' || $name eq '$b'));
+# if !$ok {
+# my $id := $name;
+# #$id ~~ s/^\W\W?//;
+# $id := nqp::substr($id, 1, nqp::chars($id) - 1) if $id ~~ /^\W/;
+# $id := nqp::substr($id, 1, nqp::chars($id) - 1) if $id ~~ /^\W/;
+# if $sigil eq '&' {
+# $here.add_mystery($variable<sublongname>, self.pos, 'var')
+# }
+# elsif $name eq '@_' || $name eq '%_' {
+#
+# }
+# else { # guaranteed fail now
+# if my $scope := @*MEMOS[$variable.from]<declend> {
+# return $here.sorry("Variable $name is not predeclared (declarators are tighter than comma, so maybe your '$scope' signature needs parens?)");
+# }
+# elsif !($id ~~ /\:\:/) {
+# if self.is_known('@' ~ $id) {
+# return $here.sorry("Variable $name is not predeclared (did you mean \@$id?)");
+# }
+# elsif self.is_known('%' ~ $id) {
+# return $here.sorry("Variable $name is not predeclared (did you mean \%$id?)");
+# }
+# }
+# return $here.sorry("Variable $name is not predeclared");
+# }
+# }
+# elsif $*CURLEX{$name} {
+# $*CURLEX{$name}<used> := $*CURLEX{$name}<used> + 1;
+# }
+# self;
+# }
method check_variable($var) {
my $varast := $var.ast;
if nqp::istype($varast, QAST::Op) && $varast.op eq 'ifnull' {
$varast := $varast[0];
}
if !$*IN_DECL && nqp::istype($varast, QAST::Var) && $varast.scope eq 'lexical' {
+ # Change the sigil if needed.
+ $varast.name( ~$var<really> ~ ~$var<desigilname> ) if $var<really>;
my $name := $varast.name;
if $name ne '%_' && $name ne '@_' && !$*W.is_lexical($name) {
if $var<sigil> ne '&' {
@@ -3672,55 +3720,6 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
]
]
}
-
-
-
-# method check_variable ($variable) {
-# my $name := $variable.Str;
-# my $here := self.cursor($variable.from);
-# #self.deb("check_variable $name") if $*DEBUG +& DEBUG::symtab;
-# if $variable<really> { $name := $variable<really> ~ nqp::substr($name,1) }
-# my @parts := $name ~~ /(\$|\@|\%|\&|\*)(.?)/;
-# my $sigil := @parts[0];
-# my $first := @parts[1];
-# return self if $first eq '{';
-# my $ok := 0;
-# $ok := $ok || $*IN_DECL;
-# $ok := $ok || $first lt 'A';
-# $ok := $ok || $sigil eq '*';
-# $ok := $ok || self.is_known($name);
-# $ok := $ok || ($*IN_SORT && ($name eq '$a' || $name eq '$b'));
-# if !$ok {
-# my $id := $name;
-# #$id ~~ s/^\W\W?//;
-# $id := nqp::substr($id, 1, nqp::chars($id) - 1) if $id ~~ /^\W/;
-# $id := nqp::substr($id, 1, nqp::chars($id) - 1) if $id ~~ /^\W/;
-# if $sigil eq '&' {
-# $here.add_mystery($variable<sublongname>, self.pos, 'var')
-# }
-# elsif $name eq '@_' || $name eq '%_' {
-#
-# }
-# else { # guaranteed fail now
-# if my $scope := @*MEMOS[$variable.from]<declend> {
-# return $here.sorry("Variable $name is not predeclared (declarators are tighter than comma, so maybe your '$scope' signature needs parens?)");
-# }
-# elsif !($id ~~ /\:\:/) {
-# if self.is_known('@' ~ $id) {
-# return $here.sorry("Variable $name is not predeclared (did you mean \@$id?)");
-# }
-# elsif self.is_known('%' ~ $id) {
-# return $here.sorry("Variable $name is not predeclared (did you mean \%$id?)");
-# }
-# }
-# return $here.sorry("Variable $name is not predeclared");
-# }
-# }
-# elsif $*CURLEX{$name} {
-# $*CURLEX{$name}<used> := $*CURLEX{$name}<used> + 1;
-# }
-# self;
-# }
}
grammar Perl6::P5QGrammar is HLL::Grammar does STD5 {

0 comments on commit 450a0e0

Please sign in to comment.