Skip to content

Commit 856a79c

Browse files
committed
enable backslash sequences in character classes, enable negated character classes. patch mostly from jnthn++
1 parent fd2fd16 commit 856a79c

File tree

2 files changed

+36
-7
lines changed

2 files changed

+36
-7
lines changed

src/QRegex/P6Regex/Actions.nqp

Lines changed: 30 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -304,6 +304,12 @@ class QRegex::P6Regex::Actions is HLL::Actions {
304304
my $qast := QAST::Regex.new( ~$/ , :rxtype('literal'), :node($/) );
305305
make $qast;
306306
}
307+
308+
method backlit($/) {
309+
my $qast := QAST::Regex.new( '\\', :rxtype('enumcharlist'),
310+
:node($/) );
311+
make $qast;
312+
}
307313

308314
method assertion:sym<?>($/) {
309315
my $qast;
@@ -406,20 +412,39 @@ class QRegex::P6Regex::Actions is HLL::Actions {
406412
my $qast;
407413
if $<name> {
408414
my $name := ~$<name>;
409-
$qast := QAST::Regex.new( PAST::Node.new($name), :rxtype<subrule>, :subtype<method>, :node($/) );
415+
$qast := QAST::Regex.new( PAST::Node.new($name), :rxtype<subrule>, :subtype<method>,
416+
:negate( $<sign> eq '-' ), :node($/) );
410417
}
411418
else {
419+
my @alts;
412420
for $<charspec> {
413-
if $_[1] {
421+
if $_<backslash> {
422+
my $bs := $_<backslash>.ast;
423+
$bs.negate(!$bs.negate) if $<sign> eq '-';
424+
@alts.push($bs);
425+
}
426+
elsif $_<backlit> {
427+
my $bslit := $_<backlit>.ast;
428+
$bslit.negate(!$bslit.negate) if $<sign> eq '-';
429+
@alts.push($bslit);
430+
}
431+
elsif $_[1] {
414432
my $ord0 := nqp::ord($_[0]);
415433
my $ord1 := nqp::ord($_[1][0]);
416434
$str := nqp::concat($str, nqp::chr($ord0++)) while $ord0 <= $ord1;
417435
}
418436
else { $str := $str ~ $_[0]; }
419437
}
420-
$qast := QAST::Regex.new( $str, :rxtype<enumcharlist>, :node($/) );
421-
}
422-
$qast.negate( $<sign> eq '-' );
438+
@alts.push(QAST::Regex.new( $str, :rxtype<enumcharlist>, :node($/), :negate( $<sign> eq '-' ) ))
439+
if nqp::chars($str);
440+
$qast := +@alts == 1 ?? @alts[0] !!
441+
$<sign> eq '-' ??
442+
QAST::Regex.new( :rxtype<concat>, :node($/),
443+
QAST::Regex.new( :rxtype<conj>, :subtype<zerowidth>, |@alts ),
444+
QAST::Regex.new( :rxtype<cclass>, :subtype<.> ) ) !!
445+
QAST::Regex.new( :rxtype<alt>, |@alts );
446+
}
447+
#$qast.negate( $<sign> eq '-' );
423448
make $qast;
424449
}
425450

src/QRegex/P6Regex/Grammar.nqp

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -195,13 +195,17 @@ grammar QRegex::P6Regex::Grammar is HLL::Grammar {
195195

196196
token assertion:sym<[> { <?before '['|'+'|'-'> <cclass_elem>+ }
197197

198+
token backlit { '\\' }
199+
198200
token cclass_elem {
199201
$<sign>=['+'|'-'|<?>]
200202
<.normspace>?
201203
[
202204
| '[' $<charspec>=(
203-
| \s* '-' <!before \s* ']'> <.obs: '- as character range','.. for range, for explicit - in character class, escape it or place as last thing'>
204-
| \s* [ \\ (.) | (<-[\]\\]>) ] [ \s* '..' \s* (.) ]?
205+
|| \s* '-' <!before \s* ']'> <.obs: '- as character range','.. for range, for explicit - in character class, escape it or place as last thing'>
206+
|| \s* '\\' <backlit>
207+
|| \s* '\\' <backslash>
208+
|| \s* (<-[\]\\]>) [ \s* '..' \s* (.) ]?
205209
)*
206210
\s* ']'
207211
| $<name>=[\w+]

0 commit comments

Comments
 (0)