Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Various bits of alignment with STD_P5.
This also allows the empty alternation branch.
  • Loading branch information
jnthn committed Sep 29, 2012
1 parent ea7a053 commit 9a42dc5
Show file tree
Hide file tree
Showing 2 changed files with 33 additions and 31 deletions.
51 changes: 27 additions & 24 deletions src/QRegex/P5Regex/Actions.nqp
Expand Up @@ -3,36 +3,41 @@ class QRegex::P5Regex::Actions is HLL::Actions {
make qbuildsub($<nibbler>.ast, :anon(1), :addself(1));
}

method nibbler($/) { make $<termaltseq>.ast }
method nibbler($/) { make $<alternation>.ast }

method termaltseq($/) {
my $qast := $<termish>[0].ast;
if +$<termish> > 1 {
method alternation($/) {
my $qast := $<sequence>[0].ast;
if +$<sequence> > 1 {
$qast := QAST::Regex.new( :rxtype<altseq>, :node($/) );
for $<termish> { $qast.push($_.ast); }
for $<sequence> { $qast.push($_.ast); }
}
make $qast;
}

method termish($/) {
my $qast := QAST::Regex.new( :rxtype<concat>, :node($/) );
my $lastlit := 0;
for $<noun> {
my $ast := $_.ast;
if $ast {
if $lastlit && $ast.rxtype eq 'literal'
&& !QAST::Node.ACCEPTS($ast[0]) {
$lastlit[0] := $lastlit[0] ~ $ast[0];
}
else {
$qast.push($_.ast);
$lastlit := $ast.rxtype eq 'literal'
&& !QAST::Node.ACCEPTS($ast[0])
?? $ast !! 0;
method sequence($/) {
if $<quantified_atom> {
my $qast := QAST::Regex.new( :rxtype<concat>, :node($/) );
my $lastlit := 0;
for $<quantified_atom> {
my $ast := $_.ast;
if $ast {
if $lastlit && $ast.rxtype eq 'literal'
&& !QAST::Node.ACCEPTS($ast[0]) {
$lastlit[0] := $lastlit[0] ~ $ast[0];
}
else {
$qast.push($_.ast);
$lastlit := $ast.rxtype eq 'literal'
&& !QAST::Node.ACCEPTS($ast[0])
?? $ast !! 0;
}
}
}
make $qast;
}
else {
make QAST::Regex.new( :rxtype<anchor>, :name<pass>, :node($/) );
}
make $qast;
}

method quantified_atom($/) {
Expand Down Expand Up @@ -86,9 +91,7 @@ class QRegex::P5Regex::Actions is HLL::Actions {

method p5metachar:sym<( )>($/) {
make QAST::Regex.new( :rxtype<subcapture>, :node($/),
$<nibbler>
?? $<nibbler>[0].ast
!! QAST::Regex.new( :rxtype<anchor>, :subtype<pass> ) );
$<nibbler>.ast );
}

method p5metachar:sym<[ ]>($/) {
Expand Down
13 changes: 6 additions & 7 deletions src/QRegex/P5Regex/Grammar.nqp
Expand Up @@ -15,17 +15,16 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
{
for $OLDRX { %*RX{$_.key} := $_.value; }
}
<termaltseq>
<alternation>
}

token termaltseq {
<termish>
[ '|' <![|]> [ <termish> || <.panic: 'Null pattern not allowed'> ] ]*
token alternation {
<sequence>+ % '|'
}

token termish {
token sequence {
<.ws> # XXX assuming old /x here?
<noun=.quantified_atom>+
<quantified_atom>*
}

token quantified_atom {
Expand Down Expand Up @@ -59,7 +58,7 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
'(?' {} <assertion=p5assertion>
[ ')' || <.panic: "Perl 5 regex assertion not terminated by parenthesis"> ]
}
token p5metachar:sym<( )> { '(' {} <nibbler>? ')' }
token p5metachar:sym<( )> { '(' {} <nibbler> ')' }
token p5metachar:sym<[ ]> { <?before '['> <cclass> }

token cclass {
Expand Down

0 comments on commit 9a42dc5

Please sign in to comment.