view release on metacpan or  search on metacpan

inc/Pegex/Optimizer.pm  view on Meta::CPAN

                    }
                    die "No rule '$rule' defined in grammar";
                }
            }
            $node->{method} ||= $self->parser->can("match_$kind") or die;
            last;
        }
    }

    if ($node->{kind} =~ /^(?:all|any)$/) {
        $self->optimize_node($_) for @{$node->{rule}};
    }
    elsif ($node->{kind} eq 'ref') {
        my $ref = $node->{rule};
        my $rule = $self->grammar->{tree}{$ref};
        $rule ||= $self->{extra}{$ref} = {};
        if (my $action = $self->receiver->can("got_$ref")) {
            $rule->{action} = $action;
        }
        elsif (my $gotrule = $self->receiver->can("gotrule")) {
            $rule->{action} = $gotrule;
        }
        if ($self->parser->{debug}) {
            $node->{method} = $self->make_trace_wrapper($node->{method});
        }
    }
    elsif ($node->{kind} eq 'rgx') {
      # XXX $node;
    }
}

sub make_method_wrapper {
    my ($self, $method) = @_;
    return sub {
        my ($parser, $ref, $parent) = @_;
        @{$parser}{'rule', 'parent'} = ($ref, $parent);
        $method->(
            $parser->{grammar},
            $parser,
            $parser->{buffer},
            $parser->{position},
        );
    }
}

sub make_trace_wrapper {
    my ($self, $method) = @_;
    return sub {
        my ($self, $ref, $parent) = @_;
        my $asr = $parent->{'+asr'};
        my $note =
            $asr == -1 ? '(!)' :
            $asr == 1 ? '(=)' :
            '';
        $self->trace("try_$ref$note");
        my $result;
        if ($result = $self->$method($ref, $parent)) {
            $self->trace("got_$ref$note");
        }
        else {
            $self->trace("not_$ref$note");
        }
        return $result;
    }
}

sub set_max_parse {
    require Pegex::Parser;
    my ($self) = @_;
    my $maxparse = $self->parser->{maxparse};
    no warnings 'redefine';
    my $method = \&Pegex::Parser::match_ref;
    my $counter = 0;
    *Pegex::Parser::match_ref = sub {
        die "Maximum parsing rules reached ($maxparse)\n"
            if $counter++ >= $maxparse;
        my $self = shift;
        $self->$method(@_);
    };
}

1;