← Back to branch summary

~ubuntu-branches/ubuntu/vivid/nqp/vivid-proposed

« back to all changes in this revision

Viewing changes to src/QRegex/Cursor.nqp

  • Committer: Package Import Robot
  • Author(s): Alessandro Ghedini
  • Date: 2013-11-01 12:09:18 UTC
  • mfrom: (1.1.4)
  • Revision ID: package-import@ubuntu.com-20131101120918-kx51sl0sxl3exsxi
Tags: 2013.10-1
* New upstream release
* Bump versioned (Build-)Depends on parrot
* Update patches
* Install new README.pod
* Fix vcs-field-not-canonical
* Do not install rubyish examples
* Do not Depends on parrot-devel anymore
* Add 07_disable-serialization-tests.patch

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/QRegex/Cursor.nqp
5
5
    has int $!highwater;
6
6
    has @!highexpect;
7
7
    has %!marks;
 
8
    has $!fail_cursor;
 
9
    
 
10
    # Follow is a little simple usage tracing infrastructure, used by the
 
11
    # !cursor_start_* methods when uncommented.
 
12
    my %cursors_created;
 
13
    my $cursors_total;
 
14
    method log_cc($name) {
 
15
        %cursors_created{$name}++;
 
16
        $cursors_total++;
 
17
    }
 
18
    method log_dump() {
 
19
        for %cursors_created {
 
20
            say($_.value ~ "\t" ~ $_.key);
 
21
        }
 
22
        say("TOTAL: " ~ $cursors_total);
 
23
    }
8
24
}
9
25
 
10
26
role NQPCursorRole is export {
79
95
            $shared := nqp::create(ParseShared);
80
96
            nqp::bindattr($shared, ParseShared, '$!orig', $orig);
81
97
            nqp::bindattr_s($shared, ParseShared, '$!target',
 
98
#?if parrot
82
99
                pir::trans_encoding__Ssi($orig, pir::find_encoding__Is('ucs4')));
 
100
#?endif
 
101
#?if !parrot
 
102
                $orig);
 
103
#?endif
83
104
            nqp::bindattr_i($shared, ParseShared, '$!highwater', 0);
84
 
            nqp::bindattr($shared, ParseShared, '@!highexpect', nqp::list());
 
105
            nqp::bindattr($shared, ParseShared, '@!highexpect', nqp::list_s());
85
106
            nqp::bindattr($shared, ParseShared, '%!marks', nqp::hash());
86
107
        }
87
108
        nqp::bindattr($new, $?CLASS, '$!shared', $shared);
93
114
            nqp::bindattr_i($new, $?CLASS, '$!from', $p);
94
115
            nqp::bindattr_i($new, $?CLASS, '$!pos', $p);
95
116
        }
 
117
        nqp::bindattr($shared, ParseShared, '$!fail_cursor', $new.'!cursor_start_cur'());
96
118
        $new;
97
119
    }
98
120
    
100
122
    # The array is valid until the next call to !cursor_start_all.
101
123
    my $NO_RESTART := 0;
102
124
    my $RESTART := 1;
103
 
    my @start_result;
104
125
    method !cursor_start_all() {
 
126
        my @start_result;
105
127
        my $new := nqp::create(self);
106
128
        my $sub := nqp::callercode();
 
129
        # Uncomment following to log cursor creation.
 
130
        #$!shared.log_cc(nqp::getcodename($sub));
107
131
        nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
108
132
        nqp::bindattr($new, $?CLASS, '$!regexsub', nqp::ifnull(nqp::getcodeobj($sub), $sub));
109
133
        if nqp::defined($!restart) {
133
157
    method !cursor_start_cur() {
134
158
        my $new := nqp::create(self);
135
159
        my $sub := nqp::callercode();
 
160
        # Uncomment following to log cursor creation.
 
161
        #$!shared.log_cc(nqp::getcodename($sub));
136
162
        nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
137
163
        nqp::bindattr($new, $?CLASS, '$!regexsub', nqp::ifnull(nqp::getcodeobj($sub), $sub));
138
164
        if nqp::defined($!restart) {
143
169
        nqp::bindattr($new, $?CLASS, '$!bstack', nqp::list_i());
144
170
        $new
145
171
    }
 
172
    
 
173
    method !cursor_start_fail() {
 
174
        nqp::getattr($!shared, ParseShared, '$!fail_cursor');
 
175
    }
146
176
 
147
177
    method !cursor_start_subcapture($from) {
148
178
        my $new := nqp::create(self);
249
279
            $cur := self."$rxname"();
250
280
            @fates := @EMPTY if nqp::getattr_i($cur, $?CLASS, '$!pos') >= 0;
251
281
        }
252
 
        $cur // self."!cursor_start_cur"();
 
282
        $cur // nqp::getattr($shared, ParseShared, '$!fail_cursor');
253
283
    }
254
284
 
255
285
    method !protoregex_nfa($name) {
319
349
        sub precomp_alt_nfas($meth) {
320
350
            if nqp::can($meth, 'ALT_NFAS') {
321
351
                for $meth.ALT_NFAS -> $name {
322
 
                    self.HOW.cache(self, $name, { self.'!alt_nfa'($meth, $name) });
 
352
                    self.HOW.cache(self, $name, { self.'!alt_nfa'($meth, $name.key) });
323
353
                }
324
354
            }
325
355
        }
340
370
        if $pos >= $highwater {
341
371
            $highexpect := nqp::getattr($shared, ParseShared, '@!highexpect');
342
372
            if $pos > $highwater {
343
 
                pir::assign__0Pi($highexpect, 0);
 
373
                nqp::setelems($highexpect, 0);
344
374
                nqp::bindattr_i($shared, ParseShared, '$!highwater', $pos);
345
375
            }
346
376
            nqp::push_s($highexpect, $dba);
357
387
    
358
388
    method !fresh_highexpect() {
359
389
        my @old := nqp::getattr($!shared, ParseShared, '@!highexpect');
360
 
        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
 
390
        nqp::bindattr($!shared, ParseShared, '@!highexpect', nqp::list_s());
361
391
        @old
362
392
    }
363
393
    
367
397
    
368
398
    method !clear_highwater() {
369
399
        my $highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
370
 
        pir::assign__0Pi($highexpect, 0);
 
400
        nqp::setelems($highexpect, 0);
371
401
        nqp::bindattr_i($!shared, ParseShared, '$!highwater', -1)
372
402
    }
373
403
 
388
418
    }
389
419
 
390
420
    method !LITERAL(str $str, int $i = 0) {
391
 
        my $cur := self."!cursor_start_cur"();
 
421
        my $cur;
392
422
        my int $litlen := nqp::chars($str);
393
423
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
394
 
        $cur."!cursor_pass"($!pos + $litlen)
395
 
          if $litlen < 1 
396
 
              ||  ($i ?? nqp::lc(nqp::substr($target, $!pos, $litlen)) eq nqp::lc($str)
397
 
                      !! nqp::substr($target, $!pos, $litlen) eq $str);
 
424
        if $litlen < 1 ||
 
425
            ($i ?? nqp::lc(nqp::substr($target, $!pos, $litlen)) eq nqp::lc($str)
 
426
                !! nqp::substr($target, $!pos, $litlen) eq $str) {
 
427
            $cur := self."!cursor_start_cur"();
 
428
            $cur."!cursor_pass"($!pos + $litlen);
 
429
        }
 
430
        else {
 
431
            $cur := nqp::getattr($!shared, ParseShared, '$!fail_cursor');
 
432
        }
398
433
        $cur;
399
434
    }
400
435
 
407
442
    method before($regex) {
408
443
        my int $orig_highwater := nqp::getattr_i($!shared, ParseShared, '$!highwater');
409
444
        my $orig_highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
410
 
        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
 
445
        nqp::bindattr($!shared, ParseShared, '@!highexpect', nqp::list_s());
411
446
        my $cur := self."!cursor_start_cur"();
412
447
        nqp::bindattr_i($cur, $?CLASS, '$!pos', $!pos);
413
448
        nqp::getattr_i($regex($cur), $?CLASS, '$!pos') >= 0 ??
423
458
    method after($regex) {
424
459
        my int $orig_highwater := nqp::getattr_i($!shared, ParseShared, '$!highwater');
425
460
        my $orig_highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
426
 
        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
 
461
        nqp::bindattr($!shared, ParseShared, '@!highexpect', nqp::list_s());
427
462
        my $cur := self."!cursor_start_cur"();
428
463
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
429
464
        my $shared := nqp::clone($!shared);
430
 
        nqp::bindattr_s($shared, ParseShared, '$!target', $target.reverse());
 
465
        nqp::bindattr_s($shared, ParseShared, '$!target', nqp::flip($target));
431
466
        nqp::bindattr($cur, $?CLASS, '$!shared', $shared);
432
467
        nqp::bindattr_i($cur, $?CLASS, '$!from', nqp::chars($target) - $!pos);
433
468
        nqp::bindattr_i($cur, $?CLASS, '$!pos', nqp::chars($target) - $!pos);
456
491
    }
457
492
    
458
493
    method ww() {
459
 
        my $cur := self."!cursor_start_cur"();
 
494
        my $cur;
460
495
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
461
 
        $cur."!cursor_pass"($!pos, "ww")
462
 
            if $!pos > 0
463
 
            && $!pos != nqp::chars($target)
464
 
            && nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos)
465
 
            && nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos-1);
 
496
        if $!pos > 0 && $!pos != nqp::chars($target)
 
497
                && nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos)
 
498
                && nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos-1) {
 
499
            $cur := self."!cursor_start_cur"();
 
500
            $cur."!cursor_pass"($!pos, "ww");
 
501
        }
 
502
        else {
 
503
            $cur := nqp::getattr($!shared, ParseShared, '$!fail_cursor');
 
504
        }
466
505
        $cur;
467
506
    }
468
507
 
479
518
    }
480
519
 
481
520
    method ident() {
482
 
        my $cur := self."!cursor_start_cur"();
 
521
        my $cur;
483
522
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
484
 
        $cur."!cursor_pass"(
 
523
        if $!pos < nqp::chars($target) &&
 
524
                (nqp::ord($target, $!pos) == 95
 
525
                 || nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $target, $!pos)) {
 
526
            $cur := self."!cursor_start_cur"();
 
527
            $cur."!cursor_pass"(
485
528
                nqp::findnotcclass(
486
529
                    nqp::const::CCLASS_WORD,
487
 
                    $target, $!pos, nqp::chars($target)))
488
 
            if $!pos < nqp::chars($target) &&
489
 
                (nqp::ord($target, $!pos) == 95
490
 
                 || nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $target, $!pos));
 
530
                    $target, $!pos, nqp::chars($target)));
 
531
        }
 
532
        else {
 
533
            $cur := nqp::getattr($!shared, ParseShared, '$!fail_cursor');
 
534
        }
491
535
        $cur;
492
536
    }
493
537
 
603
647
    method orig() { $!orig }
604
648
    method to()   { $!to }
605
649
    method CURSOR() { $!cursor }
 
650
#?if parrot
606
651
    method Str() is parrot_vtable('get_string')  { nqp::substr($!orig, $!from, $!to-$!from) }
607
652
    method Int() is parrot_vtable('get_integer') { +self.Str() }
608
653
    method Num() is parrot_vtable('get_number')  { +self.Str() }
 
654
#?endif
 
655
#?if !parrot
 
656
    method Str() { nqp::substr($!orig, $!from, $!to-$!from) }
 
657
    method Int() { +self.Str() }
 
658
    method Num() { +self.Str() }
 
659
#?endif
609
660
    method Bool() { $!to >= $!from }
610
661
    method chars() { $!to >= $!from ?? $!to - $!from !! 0 }
611
662
    
619
670
        if self.Bool() {
620
671
            my @chunks;
621
672
            
622
 
            sub dump_match($key, $value) {
 
673
            my sub dump_match(@chunks, $indent, $key, $value) {
623
674
                nqp::push(@chunks, nqp::x(' ', $indent));
624
675
                nqp::push(@chunks, '- ');
625
676
                nqp::push(@chunks, $key);
636
687
                }
637
688
            }
638
689
            
639
 
            sub dump_match_array($key, @matches) {
 
690
            my sub dump_match_array(@chunks, $indent, $key, @matches) {
640
691
                nqp::push(@chunks, nqp::x(' ', $indent));
641
692
                nqp::push(@chunks, '- ');
642
693
                nqp::push(@chunks, $key);
652
703
            for self.list() {
653
704
                if $_ {
654
705
                    nqp::islist($_)
655
 
                        ?? dump_match_array($i, $_)
656
 
                        !! dump_match($i, $_);
 
706
                        ?? dump_match_array(@chunks, $indent, $i, $_)
 
707
                        !! dump_match(@chunks, $indent, $i, $_);
657
708
                }
 
709
                $i := $i + 1;
658
710
            }
659
711
            for self.hash() {
660
712
                if $_.value {
661
713
                    nqp::islist($_.value)
662
 
                        ?? dump_match_array($_.key, $_.value)
663
 
                        !! dump_match($_.key, $_.value);
 
714
                        ?? dump_match_array(@chunks, $indent, $_.key, $_.value)
 
715
                        !! dump_match(@chunks, $indent, $_.key, $_.value);
664
716
                }
665
717
            }
666
 
            return nqp::join('', @chunks);
 
718
            return join('', @chunks);
667
719
        }
668
720
        else {
669
721
            return nqp::x(' ', $indent) ~ "- NO MATCH\n";
673
725
    method !dump_str($key) {
674
726
        sub dump_array($key, $item) {
675
727
            my $str := '';
676
 
            if $item ~~ NQPCapture {
 
728
            if nqp::istype($item, NQPCapture) {
677
729
                $str := $str ~ $item."!dump_str"($key)
678
730
            }
679
 
            elsif !nqp::isnull($item) {
 
731
            elsif nqp::islist($item) {
 
732
                $str := $str ~ "$key: list\n";
680
733
                my $n := 0;
681
734
                for $item { $str := $str ~ dump_array($key ~ "[$n]", $_); $n++ }
682
735
            }
683
736
            $str;
684
737
        }
685
738
        my $str := $key ~ ': ' ~ nqp::escape(self.Str) ~ ' @ ' ~ self.from ~ "\n";
686
 
        $str := $str ~ dump_array($key, self.list);
 
739
        my $n := 0;
 
740
        for self.list { $str := $str ~ dump_array($key ~ '[' ~ $n ~ ']', $_); $n++ }
687
741
        for self.hash { $str := $str ~ dump_array($key ~ '<' ~ $_.key ~ '>', $_.value); }
688
742
        $str;
689
743
    }
690
744
}
691
745
 
692
746
class NQPCursor does NQPCursorRole {
693
 
    my $EMPTY_MATCH_LIST := nqp::list();
694
 
    my $EMPTY_MATCH_HASH := nqp::hash();
695
747
    method MATCH() {
696
748
        my $match := nqp::getattr(self, NQPCursor, '$!match');
697
749
        unless nqp::istype($match, NQPMatch) || nqp::ishash($match) {
698
 
            my $list := $EMPTY_MATCH_LIST;
699
 
            my $hash := $EMPTY_MATCH_HASH;
 
750
            my $list := nqp::list();
 
751
            my $hash := nqp::hash();
700
752
            $match := nqp::create(NQPMatch);
701
753
            nqp::bindattr(self, NQPCursor, '$!match', $match);
702
754
            nqp::bindattr($match, NQPMatch, '$!cursor', self);
806
858
    method new($code) {
807
859
        self.bless(:code($code));
808
860
    }
809
 
    method ACCEPTS($target) {
 
861
    multi method ACCEPTS(NQPRegexMethod:D $self: $target) {
810
862
        NQPCursor.parse($target, :rule(self))
811
863
    }
812
 
    method Str() is parrot_vtable('get_string') {
 
864
    method name() {
813
865
        nqp::getcodename($!code)
814
866
    }
 
867
    method Str() {
 
868
        self.name()
 
869
    }
815
870
}
816
871
nqp::setinvokespec(NQPRegexMethod, NQPRegexMethod, '$!code', nqp::null);
817
872
 
818
873
class NQPRegex is NQPRegexMethod {
819
 
    method ACCEPTS($target) {
 
874
    multi method ACCEPTS(NQPRegex:D $self: $target) {
820
875
        NQPCursor.parse($target, :rule(self), :c(0))
821
876
    }
822
877
}