Permalink
Browse files

[GGE::Perl6Regex] multiple subrules in same scope

Detect them, and toggle the 'isarray' flag in those subrules.
  • Loading branch information...
1 parent 32df777 commit 6a3be2863f61d63f67dc957d2918a250841bf3e7 @masak committed Jan 25, 2010
Showing with 25 additions and 12 deletions.
  1. +11 −10 lib/GGE/Exp.pm
  2. +13 −1 lib/GGE/Perl6Regex.pm
  3. +1 −1 t/perl6regex/01-regex.t
View
@@ -163,32 +163,33 @@ class GGE::Exp is GGE::Match {
my $captgen = CodeString.new;
my $captsave = CodeString.new;
my $captback = CodeString.new;
+ my $indexing = $cname.substr(0, 1) eq q[']
+ ?? "\$captscope.hash-access($cname)"
+ !! "\$captscope[$cname]";
if self.hash-access('iscapture') {
if self.hash-access('isarray') {
- $captsave.emit('$captscope[%0].push($captob);', $cname);
- $captback.emit('$captscope[%0].pop();', $cname);
- $captgen.emit( q[[if defined $captscope[%0] {
+ $captsave.emit('%0.push($captob);', $indexing);
+ $captback.emit('%0.pop();', $indexing);
+ $captgen.emit( q[[if defined %0 {
goto('%1_cgen');
break;
}
- $captscope[%0] = [];
+ %0 = [];
local-branch('%1_cgen');
}
when '%1_cont' {
- $captscope[%0] = undef;
+ %0 = undef;
goto('fail');
}
- when '%1_cgen' { ]], $cname, $label);
+ when '%1_cgen' { ]], $indexing, $label);
}
else {
+ $captsave.emit('%0 = $captob;', $indexing);
if $cname.substr(0, 1) eq q['] {
- $captsave.emit('$captscope.hash-access(%0) = $captob;',
- $cname);
$captback.emit('$captscope.delete(%0);', $cname);
}
else {
- $captsave.emit('$captscope[%0] = $captob;', $cname);
- $captback.emit('$captscope[%0] = undef;', $cname);
+ $captback.emit('%0 = undef;', $indexing);
}
}
}
View
@@ -163,7 +163,7 @@ class GGE::Perl6Regex {
my $match = $optable.parse($pattern);
die 'Perl6Regex rule error: can not parse expression'
if $match.to < $pattern.chars;
- my $exp = perl6exp($match.hash-access('expr'), {});
+ my $exp = perl6exp($match.hash-access('expr'), { lexscope => {} });
my $binary = $exp.compile(:$debug);
return self.bless(*, :$exp, :$binary);
}
@@ -698,6 +698,18 @@ class GGE::Perl6Regex {
return $exp;
}
+ multi sub perl6exp(GGE::Exp::Subrule $exp is rw, %pad) {
+ my $cname = $exp.hash-access('cname');
+ my $isarray = %pad<isarray> // undef;
+ if %pad<lexscope>.exists($cname) {
+ %pad<lexscope>{$cname}.hash-access('isarray') = True;
+ $isarray = True;
+ }
+ %pad<lexscope>{$cname} = $exp;
+ $exp.hash-access('isarray') = $isarray;
+ return $exp;
+ }
+
multi sub perl6exp(GGE::Exp::Cut $exp is rw, %pad) {
$exp.hash-access('cutmark') =
$exp.ast eq '::' ?? CUT_GROUP
@@ -7,12 +7,12 @@ my %cached;
sub dirname($path) { $path.comb(/<-[/]>+ '/'/).join() } #' (vim fix)
my @test-files = <
+ captures
metachars
quantifiers
backtrack
charclass
modifiers
- captures
subrules
>;

0 comments on commit 6a3be28

Please sign in to comment.