Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

1088 lines (1004 sloc) 40.776 kb
# Some things that all cursors involved in a given parse share.
my class ParseShared is export {
has $!CUR_CLASS;
has $!orig;
has str $!target;
has int $!highwater;
has @!highexpect;
has %!marks;
has $!fail_cursor;
has str $!target_flipped;
# Follow is a little simple usage tracing infrastructure, used by the
# !cursor_start_* methods when uncommented.
my %cursors_created;
my $cursors_total;
method log_cc($name) {
%cursors_created{$name}++;
$cursors_total++;
}
method log_dump() {
for %cursors_created {
say($_.value ~ "\t" ~ $_.key);
}
say("TOTAL: " ~ $cursors_total);
}
}
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 }
method prune() {
$!match := NQPMu;
$!bstack := NQPMu;
$!cstack := NQPMu;
$!regexsub := NQPMu;
}
method !APPEND_TO_ORIG($value) {
my $orig := nqp::getattr($!shared, ParseShared, '$!orig');
$orig := $orig ~ $value;
nqp::bindattr($!shared, ParseShared, '$!orig', $orig);
my $target := nqp::getattr_s($!shared, ParseShared, '$!target');
$target := $target ~ $value;
nqp::bindattr_s($!shared, ParseShared, '$!target', $target);
}
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::iterkey_s(nqp::shift($iter));
$caps{$curcap} := nqp::list() if nqp::atkey(%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++;
}
}
# Once we've produced the captures, and if we know we're finished and
# will never be backtracked into, we can release cstack and regexsub.
unless nqp::defined($!bstack) {
$!cstack := nqp::null();
$!regexsub := nqp::null();
}
$caps;
}
method !cursor_init($orig, :$p = 0, :$c, :$shared) {
my $new := self.CREATE();
unless $shared {
$shared := nqp::create(ParseShared);
nqp::bindattr($shared, ParseShared, '$!CUR_CLASS', $?CLASS);
nqp::bindattr($shared, ParseShared, '$!orig', $orig);
nqp::bindattr_s($shared, ParseShared, '$!target',
#?if parrot
pir::trans_encoding__Ssi($orig, pir::find_encoding__Is('ucs4')));
#?endif
#?if !parrot
$orig);
#?endif
nqp::bindattr_i($shared, ParseShared, '$!highwater', 0);
nqp::bindattr($shared, ParseShared, '@!highexpect', nqp::list_s());
nqp::bindattr($shared, ParseShared, '%!marks', nqp::hash());
}
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);
}
nqp::bindattr($shared, ParseShared, '$!fail_cursor', $new.'!cursor_start_cur'());
$new;
}
# 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;
method !cursor_start_all() {
my @start_result;
my $new := nqp::create(self);
my $sub := nqp::callercode();
# Uncomment following to log cursor creation.
#$!shared.log_cc(nqp::getcodename($sub));
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 or restarts an existing one. Returns the newly
# created Cursor.
method !cursor_start() {
my $new := nqp::create(self);
my $sub := nqp::callercode();
# Uncomment following to log cursor creation.
#$!shared.log_cc(nqp::getcodename($sub));
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::bindattr_i($new, $?CLASS, '$!from', $!from);
nqp::bindattr($new, $?CLASS, '$!bstack', nqp::clone($!bstack));
$new
}
else {
nqp::bindattr_i($new, $?CLASS, '$!pos', -3);
nqp::bindattr_i($new, $?CLASS, '$!from', $!pos);
nqp::bindattr($new, $?CLASS, '$!bstack', nqp::list_i());
$new
}
}
# Starts a new cursor, returning nothing but the cursor.
method !cursor_start_cur() {
my $new := nqp::create(self);
my $sub := nqp::callercode();
# Uncomment following to log cursor creation.
#$!shared.log_cc(nqp::getcodename($sub));
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_fail() {
nqp::getattr($!shared, ParseShared, '$!fail_cursor');
}
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) {
if !nqp::defined($!cstack) { $!cstack := [$capture] }
elsif !nqp::isnull($capture) {
my $name := nqp::getattr($capture, $?CLASS, '$!name');
if !nqp::isnull($name) && nqp::defined($name) {
nqp::push($!cstack, $capture);
}
}
$!cstack;
}
my $pass_mark := 1; # NQP has no constant table yet
method !cursor_pass(int $pos, str $name = '', :$backtrack) {
$!match := $pass_mark;
$!pos := $pos;
$!restart := $!regexsub
if $backtrack;
$!bstack := nqp::null()
unless $backtrack;
self.'!reduce'($name) if $name;
self
}
method !cursor_fail() {
$!match := nqp::null();
$!bstack := nqp::null();
$!cstack := nqp::null();
$!regexsub := 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"();
$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);
self;
}
method !reduce_with_match(str $name, str $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_get(self, $name);
if nqp::isnull($nfa) {
$nfa := self.'!protoregex_nfa'($name);
self.HOW.cache_add(self, $name, $nfa);
}
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::printfh(nqp::getstderr(), "invoking $rxname\n");
$cur := self."$rxname"();
@fates := @EMPTY if nqp::getattr_i($cur, $?CLASS, '$!pos') >= 0;
}
$cur // nqp::getattr($shared, ParseShared, '$!fail_cursor');
}
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;
$nfa.mergesubrule($start, 0, $fate, self, $rxname);
@fates[$fate] := $rxname; # override default fate #
}
}
$nfa.optimize();
$nfa;
}
method !protoregex_table() {
my %protorx;
for self.HOW.methods(self) -> $meth {
my str $methname := $meth.name();
my int $sympos := nqp::index($methname, ':');
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_get(self, $name);
if nqp::isnull($nfa) {
$nfa := self.'!alt_nfa'($!regexsub, $name);
self.HOW.cache_add(self, $name, $nfa);
}
$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 int $start := 1;
my int $fate := 0;
for $regex.ALT_NFA($name) {
$nfa.mergesubstates($start, 0, $fate, $_, self);
$fate++;
}
$nfa.optimize();
$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.key) });
}
}
}
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 {
nqp::setelems($highexpect, 0);
nqp::bindattr_i($shared, ParseShared, '$!highwater', $pos);
}
nqp::push_s($highexpect, $dba);
}
NQPMu;
}
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', nqp::list_s());
@old
}
method !set_highexpect(@highexpect) {
nqp::bindattr($!shared, ParseShared, '@!highexpect', @highexpect)
}
method !clear_highwater() {
my $highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
nqp::setelems($highexpect, 0);
nqp::bindattr_i($!shared, ParseShared, '$!highwater', -1)
}
method !BACKREF($name) {
my $cur := self."!cursor_start_cur"();
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;
my int $litlen := nqp::chars($str);
my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
if $litlen < 1 ||
($i ?? nqp::lc(nqp::substr($target, $!pos, $litlen)) eq nqp::lc($str)
!! nqp::substr($target, $!pos, $litlen) eq $str) {
$cur := self."!cursor_start_cur"();
$cur."!cursor_pass"($!pos + $litlen);
}
else {
$cur := nqp::getattr($!shared, ParseShared, '$!fail_cursor');
}
$cur;
}
method !DYNQUANT_LIMITS($mm) {
if nqp::islist($mm) {
+$mm > 1 ?? nqp::list_i($mm[0], $mm[1]) !! nqp::list_i($mm[0], $mm[0])
}
else {
nqp::list_i($mm, $mm)
}
}
method !DELEGATE_ACCEPTS($obj, $arg) {
$obj.ACCEPTS($arg) ?? 1 !! 0
}
method at($pos) {
my $cur := self."!cursor_start_cur"();
$cur."!cursor_pass"($!pos) if +$pos == $!pos;
$cur;
}
method before($regex, $off = 0) {
my int $orig_highwater := nqp::getattr_i($!shared, ParseShared, '$!highwater');
my $orig_highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
nqp::bindattr($!shared, ParseShared, '@!highexpect', nqp::list_s());
my $cur := self."!cursor_start_cur"();
nqp::bindattr_i($cur, $?CLASS, '$!pos', $!pos - $off);
$!pos >= $off && 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', nqp::list_s());
my $cur := self."!cursor_start_cur"();
my str $target_flipped := nqp::getattr_s($!shared, ParseShared, '$!target_flipped');
if nqp::isnull_s($target_flipped) {
$target_flipped := nqp::flip(nqp::getattr_s($!shared, ParseShared, '$!target'));
nqp::bindattr_s($!shared, ParseShared, '$!target_flipped', $target_flipped);
}
my $shared := nqp::clone($!shared);
nqp::bindattr_s($shared, ParseShared, '$!target', $target_flipped);
nqp::bindattr($cur, $?CLASS, '$!shared', $shared);
nqp::bindattr_i($cur, $?CLASS, '$!from', nqp::chars($target_flipped) - $!pos);
nqp::bindattr_i($cur, $?CLASS, '$!pos', nqp::chars($target_flipped) - $!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_cur"();
$!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;
my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
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 := self."!cursor_start_cur"();
$cur."!cursor_pass"($!pos, "ww");
}
else {
$cur := nqp::getattr($!shared, ParseShared, '$!fail_cursor');
}
$cur;
}
method wb() {
my $cur := self."!cursor_start_cur"();
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;
my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
if $!pos < nqp::chars($target) &&
(nqp::ord($target, $!pos) == 95
|| nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $target, $!pos)) {
$cur := self."!cursor_start_cur"();
$cur."!cursor_pass"(
nqp::findnotcclass(
nqp::const::CCLASS_WORD,
$target, $!pos, nqp::chars($target)));
}
else {
$cur := nqp::getattr($!shared, ParseShared, '$!fail_cursor');
}
$cur;
}
method alpha() {
my $cur := self."!cursor_start_cur"();
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_cur"();
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_cur"();
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_cur"();
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_cur"();
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_cur"();
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_cur"();
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_cur"();
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_cur"();
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_cur"();
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::getcodename(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 $!made;
has $!cursor;
method from() { $!from }
method orig() { $!orig }
method to() { $!to }
method CURSOR() { $!cursor }
method PRECURSOR() { $!cursor."!cursor_init"($!orig,:p($!from)) }
#?if parrot
method Str() is parrot_vtable('get_string') { nqp::substr($!orig, $!from, $!to-$!from) }
method Int() is parrot_vtable('get_integer') { +self.Str() }
method Num() is parrot_vtable('get_number') { +self.Str() }
#?endif
#?if !parrot
method Str() { nqp::substr($!orig, $!from, $!to-$!from) }
method Int() { +self.Str() }
method Num() { +self.Str() }
#?endif
method Bool() { $!to >= $!from }
method chars() { $!to >= $!from ?? $!to - $!from !! 0 }
method prune() {
self.capture_prune();
$!cursor := NQPMu;
}
method !make($made) { $!made := $made } # remove after rebootstrap
method make($made) { $!made := $made }
method made() { $!made }
method ast() { $!made } # for historical reasons
method dump($indent?) {
unless nqp::defined($indent) {
$indent := 0;
}
if self.Bool() {
my @chunks;
my sub dump_match(@chunks, $indent, $key, $value) {
nqp::push(@chunks, nqp::x(' ', $indent));
nqp::push(@chunks, '- ');
nqp::push(@chunks, $key);
nqp::push(@chunks, ': ');
if nqp::can($value, 'Str') {
nqp::push(@chunks, $value.Str());
}
else {
nqp::push(@chunks, '<object>');
}
nqp::push(@chunks, "\n");
if nqp::can($value, 'dump') {
nqp::push(@chunks, $value.dump($indent + 2));
}
}
my sub dump_match_array(@chunks, $indent, $key, @matches) {
nqp::push(@chunks, nqp::x(' ', $indent));
nqp::push(@chunks, '- ');
nqp::push(@chunks, $key);
nqp::push(@chunks, ': ');
nqp::push(@chunks, ~+@matches);
nqp::push(@chunks, " matches\n");
for @matches {
nqp::push(@chunks, $_.dump($indent + 2));
}
}
my int $i := 0;
if self.list() {
for self.list() {
if $_ {
nqp::islist($_)
?? dump_match_array(@chunks, $indent, $i, $_)
!! dump_match(@chunks, $indent, $i, $_);
}
$i := $i + 1;
}
}
if self.hash() {
for self.hash() {
if $_.value {
nqp::islist($_.value)
?? dump_match_array(@chunks, $indent, $_.key, $_.value)
!! dump_match(@chunks, $indent, $_.key, $_.value);
}
}
}
join('', @chunks);
}
else {
nqp::x(' ', $indent) ~ "- NO MATCH\n";
}
}
method !dump_str($key) {
sub dump_array($key, $item) {
my $str := '';
if nqp::istype($item, NQPCapture) {
$str := $str ~ $item."!dump_str"($key)
}
elsif nqp::islist($item) {
$str := $str ~ "$key: list\n";
my int $n := 0;
for $item { $str := $str ~ dump_array($key ~ "[$n]", $_); $n++ }
}
$str;
}
my $str := $key ~ ': ' ~ nqp::escape(self.Str) ~ ' @ ' ~ self.from ~ "\n";
my int $n := 0;
for self.list { $str := $str ~ dump_array($key ~ '[' ~ $n ~ ']', $_); $n++ }
for self.hash { $str := $str ~ dump_array($key ~ '<' ~ $_.key ~ '>', $_.value); }
$str;
}
}
class NQPCursor does NQPCursorRole {
my @EMPTY_LIST := [];
my $NO_CAPS := nqp::hash();
method MATCH() {
my $match := nqp::getattr(self, NQPCursor, '$!match');
if nqp::isnull($match) || (!nqp::istype($match, NQPMatch) && !nqp::ishash($match)) {
# Set up basic state of Match.
my $list;
my $hash := nqp::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'));
# For captures with lists, initialize the lists.
my %caplist := $NO_CAPS;
my $rxsub := nqp::getattr(self, NQPCursor, '$!regexsub');
my $onlyname := '';
my int $namecount := 0;
if !nqp::isnull($rxsub) && nqp::defined($rxsub) {
%caplist := nqp::can($rxsub, 'CAPS') ?? $rxsub.CAPS() !! nqp::null();
if !nqp::isnull(%caplist) && nqp::istrue(%caplist) {
my $iter := nqp::iterator(%caplist);
while $iter {
my $curcap := nqp::shift($iter);
my str $name := nqp::iterkey_s($curcap);
$namecount++;
if nqp::iterval($curcap) >= 2 {
$onlyname := $name if $namecount == 1;
nqp::ord($name) < 58
?? nqp::bindpos(
nqp::defor($list, $list := nqp::list()),
$name, nqp::list())
!! nqp::bindkey($hash, $name, nqp::list());
}
}
}
}
# Walk the Cursor stack and populate the Cursor.
my $cs := nqp::getattr(self, NQPCursor, '$!cstack');
if nqp::isnull($cs) || !nqp::istrue($cs) {}
elsif $namecount == 1 && $onlyname ne '' && !nqp::eqat($onlyname,'$!',0) {
# If there's only one destination, avoid repeated hash lookups
my int $cselems := nqp::elems($cs);
my int $csi;
my $dest;
if nqp::ord($onlyname) < 58 {
$dest := nqp::atpos($list, $onlyname);
}
else {
$dest := nqp::atkey($hash, $onlyname);
}
while $csi < $cselems {
my $subcur := nqp::atpos($cs, $csi);
my $name := nqp::getattr($subcur, $?CLASS, '$!name');
if !nqp::isnull($name) && nqp::defined($name) {
my $submatch := $subcur.MATCH();
nqp::push($dest, $submatch);
}
$csi++;
}
}
elsif !nqp::isnull(%caplist) && %caplist {
my int $cselems := nqp::elems($cs);
my int $csi;
# note($cselems);
while $csi < $cselems {
my $subcur := nqp::atpos($cs, $csi);
my $name := nqp::getattr($subcur, $?CLASS, '$!name');
if !nqp::isnull($name) && nqp::defined($name) && $name ne '' {
my $submatch := $subcur.MATCH();
if nqp::ordat($name, 0) == 36 && ($name eq '$!from' || $name eq '$!to') {
nqp::bindattr_i($match, NQPMatch, $name, $submatch.from);
}
elsif nqp::index($name, '=') < 0 {
my int $needs_list := %caplist{$name} >= 2;
if nqp::ord($name) < 58 {
$list := nqp::list() unless nqp::isconcrete($list);
$needs_list
?? nqp::push(nqp::atpos($list, $name), $submatch)
!! nqp::bindpos($list, $name, $submatch);
}
else {
$needs_list
?? nqp::push($hash{$name}, $submatch)
!! nqp::bindkey($hash, $name, $submatch);
}
}
else {
for nqp::split('=', $name) -> $name {
my int $needs_list := %caplist{$name} >= 2;
if nqp::ord($name) < 58 {
$list := nqp::list() unless nqp::isconcrete($list);
$needs_list
?? nqp::push(nqp::atpos($list, $name), $submatch)
!! nqp::bindpos($list, $name, $submatch);
}
else {
$needs_list
?? nqp::push($hash{$name}, $submatch)
!! nqp::bindkey($hash, $name, $submatch);
}
}
}
}
$csi++;
}
# {
# my $iter := nqp::iterator(%caplist);
# while $iter {
# my $curcap := nqp::shift($iter);
# my str $name := nqp::iterkey_s($curcap);
# my int $iv := nqp::iterval($curcap);
# if $iv >= 2 {
# if nqp::iscclass(nqp::const::CCLASS_NUMERIC, $name, 0) {
# note("\t" ~ $name ~ "\t" ~ nqp::elems(nqp::atpos($list, $name)));
# }
# else {
# note("\t" ~ $name ~ "\t" ~ nqp::elems(nqp::atkey($hash, $name)));
# }
# }
# elsif $iv >= 1 {
# if nqp::iscclass(nqp::const::CCLASS_NUMERIC, $name, 0) {
# note("\t" ~ $name ~ "\t" ~ nqp::defined(nqp::atpos($list, $name)));
# }
# else {
# note("\t" ~ $name ~ "\t" ~ nqp::defined(nqp::atkey($hash, $name)));
# }
# }
# }
# }
}
nqp::bindattr($match, NQPCapture, '@!array', nqp::isconcrete($list) ?? $list !! @EMPTY_LIST);
nqp::bindattr($match, NQPCapture, '%!hash', $hash);
# Once we've produced the captures, and if we know we're finished and
# will never be backtracked into, we can release cstack and regexsub.
unless nqp::defined(nqp::getattr(self, NQPCursor, '$!bstack')) {
nqp::bindattr(self, NQPCursor, '$!cstack', nqp::null());
nqp::bindattr(self, NQPCursor, '$!regexsub', nqp::null());
}
}
$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, $s = 0) {
if nqp::islist($var) {
my int $maxlen := -1;
my $cur := self.'!cursor_start_cur'();
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 $_;
}
last if $s && $maxlen > -1;
}
$cur.'!cursor_pass'($pos + $maxlen, '') if $maxlen >= 0;
$cur;
}
else {
return $var(self) if nqp::isinvokable($var);
my $cur := self.'!cursor_start_cur'();
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, '');
$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);
}
}
self.'!INTERPOLATE'($var);
}
}
class NQPRegexMethod {
has $!code;
method new($code) {
self.bless(:code($code));
}
multi method ACCEPTS(NQPRegexMethod:D $self: $target) {
NQPCursor.parse($target, :rule(self))
}
method name() {
nqp::getcodename($!code)
}
method Str() {
self.name()
}
}
nqp::setinvokespec(NQPRegexMethod, NQPRegexMethod, '$!code', nqp::null);
class NQPRegex is NQPRegexMethod {
multi method ACCEPTS(NQPRegex:D $self: $target) {
NQPCursor.parse($target, :rule(self), :c(0))
}
}
nqp::setinvokespec(NQPRegex, NQPRegexMethod, '$!code', nqp::null);
Jump to Line
Something went wrong with that request. Please try again.