@@ -304,6 +304,12 @@ class QRegex::P6Regex::Actions is HLL::Actions {
304
304
my $ qast := QAST ::Regex. new ( ~ $/ , : rxtype(' literal' ), : node($/ ) );
305
305
make $ qast ;
306
306
}
307
+
308
+ method backlit ($/ ) {
309
+ my $ qast := QAST ::Regex. new ( ' \\ ' , : rxtype(' enumcharlist' ),
310
+ : node($/ ) );
311
+ make $ qast ;
312
+ }
307
313
308
314
method assertion :sym <? >($/ ) {
309
315
my $ qast ;
@@ -406,20 +412,39 @@ class QRegex::P6Regex::Actions is HLL::Actions {
406
412
my $ qast ;
407
413
if $ < name > {
408
414
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($/ ) );
410
417
}
411
418
else {
419
+ my @ alts ;
412
420
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 ] {
414
432
my $ ord0 := nqp :: ord ($ _ [0 ]);
415
433
my $ ord1 := nqp :: ord ($ _ [1 ][0 ]);
416
434
$ str := nqp ::concat($ str , nqp :: chr ($ ord0 ++ )) while $ ord0 <= $ ord1 ;
417
435
}
418
436
else { $ str := $ str ~ $ _ [0 ]; }
419
437
}
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 '-' );
423
448
make $ qast ;
424
449
}
425
450
0 commit comments