Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
implement sigil-change (@A, $a[0])
  • Loading branch information
@FROGGS
FROGGS committed Mar 24, 2013
1 parent 7ecd591 commit 450a0e0
Show file tree
Hide file tree
Showing 2 changed files with 52 additions and 85 deletions.
40 changes: 4 additions & 36 deletions lib/Perl6/P5Actions.pm
View file
Expand Up @@ -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 ~ '>';
Expand Down
97 changes: 48 additions & 49 deletions lib/Perl6/P5Grammar.pm
View file
Expand Up @@ -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 '&' {
Expand Down Expand Up @@ -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 {
Expand Down

0 comments on commit 450a0e0

Please sign in to comment.