@@ -187,6 +187,97 @@ class QRegex::P5Regex::Actions is HLL::Actions {
187
187
elsif $ mod eq ' +' { $ ast . backtrack(' g' ) }
188
188
$ ast ;
189
189
}
190
+
191
+ our sub qbuildsub ($ qast , $ block = QAST ::Block. new (), : $ anon , : $ addself ) {
192
+ my $ blockid := $ block . cuid;
193
+ my $ hashpast := QAST ::Op. new ( : op<hash > );
194
+ for capnames($ qast , 0 ) {
195
+ if $ _ . key gt ' ' {
196
+ $ hashpast . push (QAST ::SVal. new ( : value($ _ . key ) ));
197
+ $ hashpast . push (QAST ::IVal. new ( : value(
198
+ nqp ::iscclass(pir::const::CCLASS_NUMERIC, $ _ . key , 0 ) + ($ _ . value > 1 ) * 2 ) ));
199
+ }
200
+ }
201
+ my $ initpast := QAST ::Stmts. new ();
202
+ if $ addself {
203
+ $ initpast . push (QAST ::Var. new ( : name(' self' ), : scope(' local' ), : decl(' param' ) ));
204
+ }
205
+ my $ capblock := QAST ::BlockMemo. new ( : name($ blockid ~ ' _caps' ), $ hashpast );
206
+ $ initpast . push (QAST ::Stmt. new ($ capblock ));
207
+
208
+ my $ nfapast := QRegex::NFA. new . addnode($ qast ). qast;
209
+ if $ nfapast {
210
+ my $ nfablock := QAST ::BlockMemo. new ( : name($ blockid ~ ' _nfa' ), $ nfapast );
211
+ $ initpast . push (QAST ::Stmt. new ($ nfablock ));
212
+ }
213
+
214
+ unless $ block . symbol(' $¢' ) {
215
+ $ initpast . push (QAST ::Var. new (: name<$¢ >, : scope<lexical >, : decl(' var' )));
216
+ $ block . symbol(' $¢' , : scope<lexical >);
217
+ }
218
+
219
+ $ block <orig_qast > := $ qast ;
220
+
221
+ $ qast := QAST ::Regex. new ( : rxtype<concat >,
222
+ QAST ::Regex. new ( : rxtype<scan > ),
223
+ $ qast ,
224
+ ($ anon ??
225
+ QAST ::Regex. new ( : rxtype<pass > ) !!
226
+ QAST ::Regex. new ( : rxtype<pass >, : name(% * RX <name >) )));
227
+ $ block . push ($ initpast );
228
+ $ block . push ($ qast );
229
+ $ block ;
230
+ }
231
+
232
+ sub capnames ($ ast , $ count ) {
233
+ my % capnames ;
234
+ my $ rxtype := $ ast . rxtype;
235
+ if $ rxtype eq ' concat' {
236
+ for $ ast . list {
237
+ my % x := capnames($ _ , $ count );
238
+ for % x { % capnames {$ _ . key } := + % capnames {$ _ . key } + $ _ . value ; }
239
+ $ count := % x {' ' };
240
+ }
241
+ }
242
+ elsif $ rxtype eq ' altseq' || $ rxtype eq ' alt' {
243
+ my $ max := $ count ;
244
+ for $ ast . list {
245
+ my % x := capnames($ _ , $ count );
246
+ for % x {
247
+ % capnames {$ _ . key } := + % capnames {$ _ . key } < 2 && % x {$ _ . key } == 1 ?? 1 !! 2 ;
248
+ }
249
+ $ max := % x {' ' } if % x {' ' } > $ max ;
250
+ }
251
+ $ count := $ max ;
252
+ }
253
+ elsif $ rxtype eq ' subrule' && $ ast . subtype eq ' capture' {
254
+ my $ name := $ ast . name ;
255
+ if $ name eq ' ' { $ name := $ count ; $ ast . name ($ name ); }
256
+ my @ names := nqp :: split (' =' , $ name );
257
+ for @ names {
258
+ if $ _ eq ' 0' || $ _ > 0 { $ count := $ _ + 1 ; }
259
+ % capnames {$ _ } := 1 ;
260
+ }
261
+ }
262
+ elsif $ rxtype eq ' subcapture' {
263
+ for nqp :: split (' ' , $ ast . name ) {
264
+ if $ _ eq ' 0' || $ _ > 0 { $ count := $ _ + 1 ; }
265
+ % capnames {$ _ } := 1 ;
266
+ }
267
+ my % x := capnames($ ast [0 ], $ count );
268
+ for % x { % capnames {$ _ . key } := + % capnames {$ _ . key } + % x {$ _ . key } }
269
+ $ count := % x {' ' };
270
+ }
271
+ elsif $ rxtype eq ' quant' {
272
+ my % astcap := capnames($ ast [0 ], $ count );
273
+ for % astcap { % capnames {$ _ } := 2 }
274
+ $ count := % astcap {' ' };
275
+ }
276
+ % capnames {' ' } := $ count ;
277
+ nqp ::deletekey(% capnames , ' $!from' );
278
+ nqp ::deletekey(% capnames , ' $!to' );
279
+ % capnames ;
280
+ }
190
281
191
282
192
283
# XXX Below here copied from p6regex; needs review
@@ -419,118 +510,6 @@ class QRegex::P5Regex::Actions is HLL::Actions {
419
510
make 0 ;
420
511
}
421
512
422
- our sub qbuildsub ($ qast , $ block = QAST ::Block. new (), : $ anon , : $ addself ) {
423
- my $ blockid := $ block . cuid;
424
- my $ hashpast := QAST ::Op. new ( : op<hash > );
425
- for capnames($ qast , 0 ) {
426
- if $ _ . key gt ' ' {
427
- $ hashpast . push (QAST ::SVal. new ( : value($ _ . key ) ));
428
- $ hashpast . push (QAST ::IVal. new ( : value(
429
- nqp ::iscclass(pir::const::CCLASS_NUMERIC, $ _ . key , 0 ) + ($ _ . value > 1 ) * 2 ) ));
430
- }
431
- }
432
- my $ initpast := QAST ::Stmts. new ();
433
- if $ addself {
434
- $ initpast . push (QAST ::Var. new ( : name(' self' ), : scope(' local' ), : decl(' param' ) ));
435
- }
436
- my $ capblock := QAST ::BlockMemo. new ( : name($ blockid ~ ' _caps' ), $ hashpast );
437
- $ initpast . push (QAST ::Stmt. new ($ capblock ));
438
-
439
- my $ nfapast := QRegex::NFA. new . addnode($ qast ). qast;
440
- if $ nfapast {
441
- my $ nfablock := QAST ::BlockMemo. new ( : name($ blockid ~ ' _nfa' ), $ nfapast );
442
- $ initpast . push (QAST ::Stmt. new ($ nfablock ));
443
- }
444
- qalt_nfas($ qast , $ blockid , $ initpast );
445
-
446
- unless $ block . symbol(' $¢' ) {
447
- $ initpast . push (QAST ::Var. new (: name<$¢ >, : scope<lexical >, : decl(' var' )));
448
- $ block . symbol(' $¢' , : scope<lexical >);
449
- }
450
-
451
- $ block <orig_qast > := $ qast ;
452
-
453
- $ qast := QAST ::Regex. new ( : rxtype<concat >,
454
- QAST ::Regex. new ( : rxtype<scan > ),
455
- $ qast ,
456
- ($ anon ??
457
- QAST ::Regex. new ( : rxtype<pass > ) !!
458
- QAST ::Regex. new ( : rxtype<pass >, : name(% * RX <name >) )));
459
- $ block . push ($ initpast );
460
- $ block . push ($ qast );
461
- $ block ;
462
- }
463
-
464
- sub capnames ($ ast , $ count ) {
465
- my % capnames ;
466
- my $ rxtype := $ ast . rxtype;
467
- if $ rxtype eq ' concat' {
468
- for $ ast . list {
469
- my % x := capnames($ _ , $ count );
470
- for % x { % capnames {$ _ . key } := + % capnames {$ _ . key } + $ _ . value ; }
471
- $ count := % x {' ' };
472
- }
473
- }
474
- elsif $ rxtype eq ' altseq' || $ rxtype eq ' alt' {
475
- my $ max := $ count ;
476
- for $ ast . list {
477
- my % x := capnames($ _ , $ count );
478
- for % x {
479
- % capnames {$ _ . key } := + % capnames {$ _ . key } < 2 && % x {$ _ . key } == 1 ?? 1 !! 2 ;
480
- }
481
- $ max := % x {' ' } if % x {' ' } > $ max ;
482
- }
483
- $ count := $ max ;
484
- }
485
- elsif $ rxtype eq ' subrule' && $ ast . subtype eq ' capture' {
486
- my $ name := $ ast . name ;
487
- if $ name eq ' ' { $ name := $ count ; $ ast . name ($ name ); }
488
- my @ names := nqp :: split (' =' , $ name );
489
- for @ names {
490
- if $ _ eq ' 0' || $ _ > 0 { $ count := $ _ + 1 ; }
491
- % capnames {$ _ } := 1 ;
492
- }
493
- }
494
- elsif $ rxtype eq ' subcapture' {
495
- for nqp :: split (' ' , $ ast . name ) {
496
- if $ _ eq ' 0' || $ _ > 0 { $ count := $ _ + 1 ; }
497
- % capnames {$ _ } := 1 ;
498
- }
499
- my % x := capnames($ ast [0 ], $ count );
500
- for % x { % capnames {$ _ . key } := + % capnames {$ _ . key } + % x {$ _ . key } }
501
- $ count := % x {' ' };
502
- }
503
- elsif $ rxtype eq ' quant' {
504
- my % astcap := capnames($ ast [0 ], $ count );
505
- for % astcap { % capnames {$ _ } := 2 }
506
- $ count := % astcap {' ' };
507
- }
508
- % capnames {' ' } := $ count ;
509
- nqp ::deletekey(% capnames , ' $!from' );
510
- nqp ::deletekey(% capnames , ' $!to' );
511
- % capnames ;
512
- }
513
-
514
- sub qalt_nfas ($ ast , $ subid , $ initpast ) {
515
- my $ rxtype := $ ast . rxtype;
516
- if $ rxtype eq ' alt' {
517
- my $ nfapast := QAST ::Op. new ( : op(' list' ) );
518
- $ ast . name (QAST ::Node. unique (' alt_nfa_' ) ~ ' _' ~ ~ nqp ::time_n());
519
- for $ ast . list {
520
- qalt_nfas($ _ , $ subid , $ initpast );
521
- $ nfapast . push (QRegex::NFA. new . addnode($ _ ). qast(: non_empty));
522
- }
523
- my $ nfablock := QAST ::BlockMemo. new ( : name($ subid ~ ' _' ~ $ ast . name ), $ nfapast );
524
- $ initpast . push (QAST ::Stmt. new ($ nfablock ));
525
- }
526
- elsif $ rxtype eq ' subcapture' || $ rxtype eq ' quant' {
527
- qalt_nfas($ ast [0 ], $ subid , $ initpast )
528
- }
529
- elsif $ rxtype eq ' concat' || $ rxtype eq ' altseq' || $ rxtype eq ' conj' || $ rxtype eq ' conjseq' {
530
- for $ ast . list { qalt_nfas($ _ , $ subid , $ initpast ) }
531
- }
532
- }
533
-
534
513
method subrule_alias ($ ast , $ name ) {
535
514
if $ ast . name gt ' ' { $ ast . name ( $ name ~ ' =' ~ $ ast . name ); }
536
515
else { $ ast . name ($ name ); }
0 commit comments