Cursor.nqp

# Some things that all cursors involved in a given parse share.
my class ParseShared {
    has $!orig;
    has str $!target;
    has int $!highwater;
    has @!highexpect;
}

role NQPCursorRole is export {
    has $!shared;
    has int $!from;
    has int $!pos;
    has $!match;
    has $!name;
    has $!bstack;
    has $!cstack;
    has $!regexsub;
    has $!restart;

    method orig() { nqp::getattr($!shared, ParseShared, '$!orig') }
    method target() { nqp::getattr_s($!shared, ParseShared, '$!target') }
    method from() { $!from }
    method pos() { $!pos }

    my $NO_CAPS := nqp::hash();
    method CAPHASH() {
        my $caps    := nqp::hash();
        my %caplist := $NO_CAPS;
        my $iter;
        my str $curcap;
        my $cs;
        my int $csi;
        my int $cselems;
        my $subcur;
        my $submatch;
        my $name;
        
        if !nqp::isnull($!regexsub) && nqp::defined($!regexsub) {
            %caplist := nqp::can($!regexsub, 'CAPS') ?? $!regexsub.CAPS() !! nqp::null();
            if !nqp::isnull(%caplist) && %caplist {
                $iter := nqp::iterator(%caplist);
                while $iter {
                    $curcap := nqp::shift_s($iter);
                    $caps{$curcap} := nqp::list() if %caplist{$curcap} >= 2;
                }
            }
        }
        if !nqp::isnull($!cstack) && $!cstack {
            $cs      := $!cstack;
            $cselems := nqp::elems($cs);
            while $csi < $cselems {
                $subcur := nqp::atpos($cs, $csi);
                $submatch := $subcur.MATCH;
                $name := nqp::getattr($subcur, $?CLASS, '$!name');
                if !nqp::isnull($name) && nqp::defined($name) {
                    if nqp::index($name, '=') < 0 {
                        %caplist{$name} >= 2
                            ?? nqp::push($caps{$name}, $submatch)
                            !! nqp::bindkey($caps, $name, $submatch);
                    }
                    else {
                        for nqp::split('=', $name) -> $name {
                            %caplist{$name} >= 2
                                ?? nqp::push($caps{$name}, $submatch)
                                !! nqp::bindkey($caps, $name, $submatch);
                        }
                    }
                }
                $csi++;
            }
        } 
        $caps;
    }

    method !cursor_init($orig, :$p = 0, :$c, :$shared) {
        my $new := self.CREATE();
        unless $shared {
            $shared := nqp::create(ParseShared);
            nqp::bindattr($shared, ParseShared, '$!orig', $orig);
            nqp::bindattr_s($shared, ParseShared, '$!target',
                pir::trans_encoding__Ssi($orig, pir::find_encoding__Is('ucs4')));
            nqp::bindattr_i($shared, ParseShared, '$!highwater', 0);
            nqp::bindattr($shared, ParseShared, '@!highexpect', nqp::list());
        }
        nqp::bindattr($new, $?CLASS, '$!shared', $shared);
        if nqp::defined($c) {
            nqp::bindattr_i($new, $?CLASS, '$!from', -1);
            nqp::bindattr_i($new, $?CLASS, '$!pos', $c);
        }
        else {
            nqp::bindattr_i($new, $?CLASS, '$!from', $p);
            nqp::bindattr_i($new, $?CLASS, '$!pos', $p);
        }
        $new;
    }

    method !cursor_start() {
        my $new := nqp::create(self);
        my $sub := nqp::callercode();
        nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
        nqp::bindattr($new, $?CLASS, '$!regexsub', nqp::ifnull(nqp::getcodeobj($sub), $sub));
        if nqp::defined($!restart) {
            nqp::bindattr_i($new, $?CLASS, '$!pos', $!pos);
            nqp::bindattr($new, $?CLASS, '$!cstack', nqp::clone($!cstack)) if $!cstack;
            pir::return__0PsiPPi(
                $new,
                nqp::getattr_s($!shared, ParseShared, '$!target'),
                nqp::bindattr_i($new, $?CLASS, '$!from', $!from),
                $?CLASS,
                nqp::bindattr($new, $?CLASS, '$!bstack', nqp::clone($!bstack)),
                1);
        }
        nqp::bindattr_i($new, $?CLASS, '$!pos', -3);
        pir::return__0PsiPPi(
            $new,
            nqp::getattr_s($!shared, ParseShared, '$!target'),
            nqp::bindattr_i($new, $?CLASS, '$!from', $!pos),
            $?CLASS,
            nqp::bindattr($new, $?CLASS, '$!bstack', nqp::list_i()),
            0
        )
    }
    
    # Starts a new Cursor, returning all information relating to it in an array.
    # The array is valid until the next call to !cursor_start_all.
    my $NO_RESTART := 0;
    my $RESTART := 1;
    my @start_result;
    method !cursor_start_all() {
        my $new := nqp::create(self);
        my $sub := nqp::callercode();
        nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
        nqp::bindattr($new, $?CLASS, '$!regexsub', nqp::ifnull(nqp::getcodeobj($sub), $sub));
        if nqp::defined($!restart) {
            nqp::bindattr_i($new, $?CLASS, '$!pos', $!pos);
            nqp::bindattr($new, $?CLASS, '$!cstack', nqp::clone($!cstack)) if $!cstack;
            nqp::bindpos(@start_result, 0, $new);
            nqp::bindpos(@start_result, 1, nqp::getattr_s($!shared, ParseShared, '$!target'));
            nqp::bindpos(@start_result, 2, nqp::bindattr_i($new, $?CLASS, '$!from', $!from));
            nqp::bindpos(@start_result, 3, $?CLASS);
            nqp::bindpos(@start_result, 4, nqp::bindattr($new, $?CLASS, '$!bstack', nqp::clone($!bstack)));
            nqp::bindpos(@start_result, 5, $RESTART);
            @start_result
        }
        else {
            nqp::bindattr_i($new, $?CLASS, '$!pos', -3);
            nqp::bindpos(@start_result, 0, $new);
            nqp::bindpos(@start_result, 1, nqp::getattr_s($!shared, ParseShared, '$!target'));
            nqp::bindpos(@start_result, 2, nqp::bindattr_i($new, $?CLASS, '$!from', $!pos));
            nqp::bindpos(@start_result, 3, $?CLASS);
            nqp::bindpos(@start_result, 4, nqp::bindattr($new, $?CLASS, '$!bstack', nqp::list_i()));
            nqp::bindpos(@start_result, 5, $NO_RESTART);
            @start_result
        }
    }
    
    # Starts a new cursor, returning nothing but the cursor.
    method !cursor_start_cur() {
        my $new := nqp::create(self);
        my $sub := nqp::callercode();
        nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
        nqp::bindattr($new, $?CLASS, '$!regexsub', nqp::ifnull(nqp::getcodeobj($sub), $sub));
        if nqp::defined($!restart) {
            nqp::die("!cursor_start_cur cannot restart a cursor");
        }
        nqp::bindattr_i($new, $?CLASS, '$!pos', -3);
        nqp::bindattr_i($new, $?CLASS, '$!from', $!pos);
        nqp::bindattr($new, $?CLASS, '$!bstack', nqp::list_i());
        $new
    }

    method !cursor_start_subcapture($from) {
        my $new := nqp::create(self);
        nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
        nqp::bindattr_i($new, $?CLASS, '$!from', $from);
        nqp::bindattr_i($new, $?CLASS, '$!pos', -3);
        $new;
    }

    method !cursor_capture($capture, $name) {
        $!match  := nqp::null();
        $!cstack := [] unless nqp::defined($!cstack);
        nqp::push($!cstack, $capture);
        nqp::bindattr($capture, $?CLASS, '$!name', $name);
        nqp::push_i($!bstack, 0);
        nqp::push_i($!bstack, $!pos);
        nqp::push_i($!bstack, 0);
        nqp::push_i($!bstack, nqp::elems($!cstack));
        $!cstack;
    }
    
    method !cursor_push_cstack($capture) {
        $!cstack := [] unless nqp::defined($!cstack);
        nqp::push($!cstack, $capture);
        $!cstack;
    }

    my $pass_mark := 1; # NQP has no constant table yet
    method !cursor_pass(int $pos, $name?, :$backtrack) {
        $!match := $pass_mark;
        $!pos := $pos;
        $!restart := $!regexsub
            if $backtrack;
        $!bstack := nqp::null()
            unless $backtrack;
        self.'!reduce'($name) if $name;
    }

    method !cursor_fail() {
        $!match  := nqp::null();
        $!bstack := nqp::null();
        $!pos    := -3;
    }
    
    method !cursor_pos(int $pos) {
        $!pos := $pos;
    }

    method !cursor_next() {
        if nqp::defined($!restart) {
            $!restart(self);
        }
        else {
            my $cur := self."!cursor_start"();
            $cur."!cursor_fail"();
            $cur
        }
    }

    method !cursor_more(*%opts) {
        return self."!cursor_next"() if %opts<ex>;
        my $new := self.CREATE();
        nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
        nqp::bindattr_i($new, $?CLASS, '$!from', -1);
        nqp::bindattr_i($new, $?CLASS, '$!pos',
            (%opts<ov> || $!from >= $!pos) ?? $!from+1 !! $!pos);
        $!regexsub($new);
    }

    method !reduce(str $name) {
        my $actions := nqp::getlexdyn('$*ACTIONS');
        nqp::findmethod($actions, $name)($actions, self.MATCH)
            if !nqp::isnull($actions) && nqp::can($actions, $name);
    }

    method !reduce_with_match($name, $key, $match) {
        my $actions := nqp::getlexdyn('$*ACTIONS');
        nqp::findmethod($actions, $name)($actions, $match, $key)
            if !nqp::isnull($actions) && nqp::can($actions, $name);
    }
    
    method !shared() { $!shared }

    my @EMPTY := [];
    method !protoregex($name) {
        # Obtain and run NFA.
        my $shared := $!shared;
        my $nfa := self.HOW.cache(self, $name, { self.'!protoregex_nfa'($name) });
        my @fates := $nfa.run(nqp::getattr_s($shared, ParseShared, '$!target'), $!pos);
        
        # Update highwater mark.
        my int $highwater := nqp::getattr_i($shared, ParseShared, '$!highwater');
        if $!pos > $highwater {
            nqp::bindattr_i($shared, ParseShared, '$!highwater', $!pos);
        }
        
        # Visit rules in fate order.
        my @rxfate := $nfa.states[0];
        my $cur;
        my $rxname;
        while @fates {
            $rxname := nqp::atpos(@rxfate, nqp::pop_i(@fates));
            #nqp::say("invoking $rxname");
            $cur := self."$rxname"();
            @fates := @EMPTY if nqp::getattr_i($cur, $?CLASS, '$!pos') >= 0;
        }
        $cur // self."!cursor_start"();
    }

    method !protoregex_nfa($name) {
        my %protorx := self.HOW.cache(self, "!protoregex_table", { self."!protoregex_table"() });
        my $nfa := QRegex::NFA.new;
        my @fates := $nfa.states[0];
        my int $start := 1;
        my int $fate := 0;
        if nqp::existskey(%protorx, $name) {
            for %protorx{$name} -> $rxname {
                $fate := $fate + 1;
                @fates[$fate] := $rxname;
                $nfa.mergesubrule($start, 0, $fate, self, $rxname);
            }
        }
        $nfa;
    }

    method !protoregex_table() {
        my %protorx;
        for self.HOW.methods(self) -> $meth {
            my str $methname := ~$meth;
            my int $sympos   := nqp::index($methname, ':sym<');
            if $sympos > 0 {
                my str $prefix := nqp::substr($methname, 0, $sympos);
                %protorx{$prefix} := [] unless nqp::existskey(%protorx, $prefix);
                nqp::push(%protorx{$prefix}, $methname);
            }
        }
        %protorx;
    }

    method !alt(int $pos, str $name, @labels = []) {
        # Update highwater mark.
        my $shared := $!shared;
        my int $highwater := nqp::getattr_i($shared, ParseShared, '$!highwater');
        if $pos > $highwater {
            nqp::bindattr_i($shared, ParseShared, '$!highwater', $pos);
        }
        
        # Evaluate the alternation.
        my $nfa := self.HOW.cache(self, $name, { self.'!alt_nfa'($!regexsub, $name) });
        $nfa.run_alt(nqp::getattr_s($shared, ParseShared, '$!target'), $pos, $!bstack, $!cstack, @labels);
    }

    method !alt_nfa($regex, str $name) {
        my $nfa := QRegex::NFA.new;
        my @fates := $nfa.states[0];
        my int $start := 1;
        my int $fate := 0;
        for $regex.ALT_NFA($name) {
            @fates[$fate] := $fate;
            $nfa.mergesubstates($start, 0, $fate, $_, self);
            $fate++;
        }
        $nfa
    }

    method !precompute_nfas() {
        # Pre-compute all of the proto-regex NFAs.
        my %protorx := self.HOW.cache(self, "!protoregex_table", { self."!protoregex_table"() });
        for %protorx {
            self.HOW.cache(self, $_.key, { self.'!protoregex_nfa'($_.key) });
        }

        # Pre-compute all the alternation NFAs.
        sub precomp_alt_nfas($meth) {
            if nqp::can($meth, 'ALT_NFAS') {
                for $meth.ALT_NFAS -> $name {
                    self.HOW.cache(self, $name, { self.'!alt_nfa'($meth, $name) });
                }
            }
        }
        for self.HOW.methods(self) -> $meth {
            precomp_alt_nfas($meth);
            if nqp::can($meth, 'NESTED_CODES') {
                for $meth.NESTED_CODES -> $code {
                    precomp_alt_nfas($code);
                }
            }
        }
    }
    
    method !dba(int $pos, str $dba) {
        my $shared := $!shared;
        my int $highwater := nqp::getattr_i($shared, ParseShared, '$!highwater');
        my $highexpect;
        if $pos >= $highwater {
            $highexpect := nqp::getattr($shared, ParseShared, '@!highexpect');
            if $pos > $highwater {
                pir::assign__0Pi($highexpect, 0);
                nqp::bindattr_i($shared, ParseShared, '$!highwater', $pos);
            }
            nqp::push_s($highexpect, $dba);
        }
    }
    
    method !highwater() {
        nqp::getattr_i($!shared, ParseShared, '$!highwater')
    }
    
    method !highexpect() {
        nqp::getattr($!shared, ParseShared, '@!highexpect')
    }
    
    method !fresh_highexpect() {
        my @old := nqp::getattr($!shared, ParseShared, '@!highexpect');
        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
        @old
    }
    
    method !set_highexpect(@highexpect) {
        nqp::bindattr($!shared, ParseShared, '@!highexpect', @highexpect)
    }
    
    method !clear_highwater() {
        my $highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
        pir::assign__0Pi($highexpect, 0);
        nqp::bindattr_i($!shared, ParseShared, '$!highwater', -1)
    }

    method !BACKREF($name) {
        my $cur   := self."!cursor_start"();
        my int $n := $!cstack ?? nqp::elems($!cstack) - 1 !! -1;
        $n-- while $n >= 0 && (nqp::isnull(nqp::getattr($!cstack[$n], $?CLASS, '$!name')) ||
                               nqp::getattr($!cstack[$n], $?CLASS, '$!name') ne $name);
        if $n >= 0 {
            my $subcur := $!cstack[$n];
            my int $litlen := $subcur.pos - $subcur.from;
            my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
            $cur."!cursor_pass"($!pos + $litlen, '')
              if nqp::substr($target, $!pos, $litlen) 
                   eq nqp::substr($target, $subcur.from, $litlen);
        }
        $cur;
    }

    method !LITERAL(str $str, int $i = 0) {
        my $cur := self."!cursor_start"();
        my int $litlen := nqp::chars($str);
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos + $litlen)
          if $litlen < 1 
              ||  ($i ?? nqp::lc(nqp::substr($target, $!pos, $litlen)) eq nqp::lc($str)
                      !! nqp::substr($target, $!pos, $litlen) eq $str);
        $cur;
    }

    method at($pos) {
        my $cur := self."!cursor_start"();
        $cur."!cursor_pass"($!pos) if +$pos == $!pos;
        $cur;
    }

    method before($regex) {
        my int $orig_highwater := nqp::getattr_i($!shared, ParseShared, '$!highwater');
        my $orig_highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
        my $cur := self."!cursor_start"();
        nqp::bindattr_i($cur, $?CLASS, '$!pos', $!pos);
        nqp::getattr_i($regex($cur), $?CLASS, '$!pos') >= 0 ??
            $cur."!cursor_pass"($!pos, 'before') !!
            nqp::bindattr_i($cur, $?CLASS, '$!pos', -3);
        nqp::bindattr_i($!shared, ParseShared, '$!highwater', $orig_highwater);
        nqp::bindattr($!shared, ParseShared, '@!highexpect', $orig_highexpect);
        $cur;
    }

    # Expects to get a regex whose syntax tree was flipped during the
    # compile.
    method after($regex) {
        my int $orig_highwater := nqp::getattr_i($!shared, ParseShared, '$!highwater');
        my $orig_highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        my $shared := nqp::clone($!shared);
        nqp::bindattr_s($shared, ParseShared, '$!target', $target.reverse());
        nqp::bindattr($cur, $?CLASS, '$!shared', $shared);
        nqp::bindattr_i($cur, $?CLASS, '$!from', nqp::chars($target) - $!pos);
        nqp::bindattr_i($cur, $?CLASS, '$!pos', nqp::chars($target) - $!pos);
        nqp::getattr_i($regex($cur), $?CLASS, '$!pos') >= 0 ??
            $cur."!cursor_pass"($!pos, 'after') !!
            nqp::bindattr_i($cur, $?CLASS, '$!pos', -3);
        nqp::bindattr_i($!shared, ParseShared, '$!highwater', $orig_highwater);
        nqp::bindattr($!shared, ParseShared, '@!highexpect', $orig_highexpect);
        $cur;
    }

    method ws() {
        # skip over any whitespace, fail if between two word chars
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        my $cur := self."!cursor_start"();
        $!pos >= nqp::chars($target)
          ?? $cur."!cursor_pass"($!pos, 'ws')
          !! ($!pos < 1
              || !nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos)
              || !nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos-1)
             ) && $cur."!cursor_pass"(
                      nqp::findnotcclass(
                          nqp::const::CCLASS_WHITESPACE, $target, $!pos, nqp::chars($target)),
                      'ws');
        $cur;
    }
    
    method ww() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos, "ww")
            if $!pos > 0
            && $!pos != nqp::chars($target)
            && nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos)
            && nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos-1);
        $cur;
    }

    method wb() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos, "wb")
            if ($!pos == 0 && nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos))
               || ($!pos == nqp::chars($target)
                   && nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos-1))
               || nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos-1)
                  != nqp::iscclass(nqp::const::CCLASS_WORD, $target, $!pos);
        $cur;
    }

    method ident() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"(
                nqp::findnotcclass(
                    nqp::const::CCLASS_WORD,
                    $target, $!pos, nqp::chars($target)))
            if $!pos < nqp::chars($target) &&
                (nqp::ord($target, $!pos) == 95
                 || nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $target, $!pos));
        $cur;
    }

    method alpha() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'alpha')
          if $!pos < nqp::chars($target)
             && (nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $target, $!pos)
                 || nqp::ord($target, $!pos) == 95);
        $cur;
    }

    method alnum() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'alnum')
          if $!pos < nqp::chars($target)
             && (nqp::iscclass(nqp::const::CCLASS_ALPHANUMERIC, $target, $!pos)
                 || nqp::ord($target, $!pos) == 95);
        $cur;
    }

    method upper() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'upper')
          if $!pos < nqp::chars($target)
             && nqp::iscclass(nqp::const::CCLASS_UPPERCASE, $target, $!pos);
        $cur;
    }

    method lower() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'lower')
          if $!pos < nqp::chars($target)
             && nqp::iscclass(nqp::const::CCLASS_LOWERCASE, $target, $!pos);
        $cur;
    }

    method digit() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'digit')
          if $!pos < nqp::chars($target)
             && nqp::iscclass(nqp::const::CCLASS_NUMERIC, $target, $!pos);
        $cur;
    }

    method xdigit() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'xdigit')
          if $!pos < nqp::chars($target)
             && nqp::iscclass(nqp::const::CCLASS_HEXADECIMAL, $target, $!pos);
        $cur;
    }

    method space() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'space')
          if $!pos < nqp::chars($target)
             && nqp::iscclass(nqp::const::CCLASS_WHITESPACE, $target, $!pos);
        $cur;
    }

    method blank() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'blank')
          if $!pos < nqp::chars($target)
             && nqp::iscclass(nqp::const::CCLASS_BLANK, $target, $!pos);
        $cur;
    }

    method cntrl() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'cntrl')
          if $!pos < nqp::chars($target)
             && nqp::iscclass(nqp::const::CCLASS_CONTROL, $target, $!pos);
        $cur;
    }

    method punct() {
        my $cur := self."!cursor_start"();
        my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
        $cur."!cursor_pass"($!pos+1, 'punct')
          if $!pos < nqp::chars($target)
             && nqp::iscclass(nqp::const::CCLASS_PUNCTUATION, $target, $!pos);
        $cur;
    }

    method FAILGOAL($goal, $dba?) {
        unless $dba {
            $dba := ~nqp::callercode();
        }
        nqp::die("Unable to parse expression in $dba; couldn't find final $goal");
    }
}


class NQPMatch is NQPCapture {
    has $!orig;
    has int $!from;
    has int $!to;
    has $!ast;
    has $!cursor;

    method from() { $!from }
    method orig() { $!orig }
    method to()   { $!to }
    method CURSOR() { $!cursor }
    method Str() is parrot_vtable('get_string')  { nqp::substr($!orig, $!from, $!to-$!from) }
    method ()    is parrot_vtable('get_integer') { +self.Str() }
    method ()    is parrot_vtable('get_number')  { +self.Str() }
    method Bool() { $!to >= $!from }
    method chars() { $!to >= $!from ?? $!to - $!from !! 0 }
    
    method !make($ast) { $!ast := $ast }
    method ast()       { $!ast }

    method !dump_str($key) {
        sub dump_array($key, $item) {
            my $str := '';
            if $item ~~ NQPCapture {
                $str := $str ~ $item."!dump_str"($key)
            }
            elsif !nqp::isnull($item) {
                my $n := 0;
                for $item { $str := $str ~ dump_array($key ~ "[$n]", $_); $n++ }
            }
            $str;
        }
        my $str := $key ~ ': ' ~ nqp::escape(self.Str) ~ ' @ ' ~ self.from ~ "\n";
        $str := $str ~ dump_array($key, self.list);
        for self.hash { $str := $str ~ dump_array($key ~ '<' ~ $_.key ~ '>', $_.value); }
        $str;
    }
}

class NQPCursor does NQPCursorRole {
    my $EMPTY_MATCH_LIST := nqp::list();
    my $EMPTY_MATCH_HASH := nqp::hash();
    method MATCH() {
        my $match := nqp::getattr(self, NQPCursor, '$!match');
        unless nqp::istype($match, NQPMatch) || nqp::ishash($match) {
            my $list := $EMPTY_MATCH_LIST;
            my $hash := $EMPTY_MATCH_HASH;
            $match := nqp::create(NQPMatch);
            nqp::bindattr(self, NQPCursor, '$!match', $match);
            nqp::bindattr($match, NQPMatch, '$!cursor', self);
            nqp::bindattr($match, NQPMatch, '$!orig', self.orig());
            nqp::bindattr_i($match, NQPMatch, '$!from', nqp::getattr_i(self, NQPCursor, '$!from'));
            nqp::bindattr_i($match, NQPMatch, '$!to', nqp::getattr_i(self, NQPCursor, '$!pos'));
            my %ch := self.CAPHASH;
            my str $key;
            my $iter := nqp::iterator(%ch);
            while $iter {
                $key := ~nqp::shift($iter);
                if $key eq '$!from' || $key eq '$!to' {
                    nqp::bindattr_i($match, NQPMatch, $key, %ch{$key}.from);
                }
                elsif nqp::iscclass(nqp::const::CCLASS_NUMERIC, $key, 0) {
                    $list := nqp::list() unless $list;
                    nqp::bindpos($list, $key, %ch{$key});
                }
                else {
                    $hash := nqp::hash() unless $hash;
                    nqp::bindkey($hash, $key, %ch{$key});
                }
            }
            nqp::bindattr($match, NQPCapture, '@!array', $list);
            nqp::bindattr($match, NQPCapture, '%!hash', $hash);
        }
        $match
    }

    method Bool() {
        !nqp::isnull(nqp::getattr(self, $?CLASS, '$!match'))
          && nqp::istrue(nqp::getattr(self, $?CLASS, '$!match'));
    }

    method parse($target, :$rule = 'TOP', :$actions, *%options) {
        my $*ACTIONS := $actions;
        my $cur := self.'!cursor_init'($target, |%options);
        nqp::isinvokable($rule) ??
            $rule($cur).MATCH() !!
            nqp::findmethod($cur, $rule)($cur).MATCH()
    }

    method !INTERPOLATE($var) {
        if nqp::islist($var) {
            my int $maxlen := -1;
            my $cur := self.'!cursor_start'();
            my int $pos := nqp::getattr_i($cur, $?CLASS, '$!from');
            my str $tgt := $cur.target;
            my int $eos := nqp::chars($tgt);
            for $var {
                if nqp::isinvokable($_) {
                    my $res := $_(self);
                    if $res {
                        my int $adv := nqp::getattr_i($res, $?CLASS, '$!pos');
                        $adv := $adv - $pos;
                        $maxlen := $adv if $adv > $maxlen;
                    }
                }
                else {
                    my int $len := nqp::chars($_);
                    $maxlen := $len if $len > $maxlen && $pos + $len <= $eos
                        && nqp::substr($tgt, $pos, $len) eq $_;
                }
            }
            $cur.'!cursor_pass'($pos + $maxlen, '') if $maxlen >= 0;
            return $cur;
        }
        else {
            return $var(self) if nqp::isinvokable($var);
            my $cur := self.'!cursor_start'();
            my int $pos := nqp::getattr_i($cur, $?CLASS, '$!from');
            my str $tgt := $cur.target;
            my int $len := nqp::chars($var);
            my int $adv := $pos + $len;
            return $cur if $adv > nqp::chars($tgt)
                || nqp::substr($tgt, $pos, $len) ne $var;
            $cur.'!cursor_pass'($adv, '');
            return $cur;
        }
    }

    method !INTERPOLATE_REGEX($var) {
        unless nqp::isinvokable($var) {
            my $rxcompiler := nqp::getcomp('QRegex::P6Regex');
            if nqp::islist($var) {
                my $res := [];
                for $var {
                    my $elem := $_;
                    $elem := $rxcompiler.compile($elem) unless nqp::isinvokable($elem);
                    nqp::push($res, $elem);
                }
                $var := $res;
            }
            else {
                $var := $rxcompiler.compile($var);
            }
        }
        return self.'!INTERPOLATE'($var);
    }
}

class NQPRegexMethod {
    has $!code is parrot_vtable_handler('invoke');
    method new($code) {
        self.bless(:code($code));
    }
    method ACCEPTS($target) {
        NQPCursor.parse($target, :rule(self))
    }
    method Str() is parrot_vtable('get_string') {
        ~$!code
    }
}

class NQPRegex is NQPRegexMethod {
    method ACCEPTS($target) {
        NQPCursor.parse($target, :rule(self), :c(0))
    }
}