Alt-Math-Prime-FastSieve-Inline

 view release on metacpan or  search on metacpan

inc/Parse/RecDescent.pm  view on Meta::CPAN

                "calls"    => [],
                "changed"  => 0,
                "line"     => $line,
                "impcount" => 0,
                "opcount"  => 0,
                "vars"     => "",
            }, $class;
    }
}

sub reset($)
{
    @{$_[0]->{"prods"}} = ();
    @{$_[0]->{"calls"}} = ();
    $_[0]->{"changed"}  = 0;
    $_[0]->{"impcount"}  = 0;
    $_[0]->{"opcount"}  = 0;
    $_[0]->{"vars"}  = "";
}

sub DESTROY {}

sub hasleftmost($$)
{
    my ($self, $ref) = @_;

    my $prod;
    foreach $prod ( @{$self->{"prods"}} )
    {
        return 1 if $prod->hasleftmost($ref);
    }

    return 0;
}

sub leftmostsubrules($)
{
    my $self = shift;
    my @subrules = ();

    my $prod;
    foreach $prod ( @{$self->{"prods"}} )
    {
        push @subrules, $prod->leftmostsubrule();
    }

    return @subrules;
}

sub expected($)
{
    my $self = shift;
    my @expected = ();

    my $prod;
    foreach $prod ( @{$self->{"prods"}} )
    {
        my $next = $prod->expected();
        unless (! $next or _contains($next,@expected) )
        {
            push @expected, $next;
        }
    }

    return join ', or ', @expected;
}

sub _contains($@)
{
    my $target = shift;
    my $item;
    foreach $item ( @_ ) { return 1 if $target eq $item; }
    return 0;
}

sub addcall($$)
{
    my ( $self, $subrule ) = @_;
    unless ( _contains($subrule, @{$self->{"calls"}}) )
    {
        push @{$self->{"calls"}}, $subrule;
    }
}

sub addprod($$)
{
    my ( $self, $prod ) = @_;
    push @{$self->{"prods"}}, $prod;
    $self->{"changed"} = 1;
    $self->{"impcount"} = 0;
    $self->{"opcount"} = 0;
    $prod->{"number"} = $#{$self->{"prods"}};
    return $prod;
}

inc/Parse/RecDescent.pm  view on Meta::CPAN

}

sub addautoscore
{
    my ( $self, $code ) = @_;
    $self->{"autoscore"} = $code;
    $self->{"changed"} = 1;
    return 1;
}

sub nextoperator($)
{
    my $self = shift;
    my $prodcount = scalar @{$self->{"prods"}};
    my $opcount = ++$self->{"opcount"};
    return "_operator_${opcount}_of_production_${prodcount}_of_rule_$self->{name}";
}

sub nextimplicit($)
{
    my $self = shift;
    my $prodcount = scalar @{$self->{"prods"}};
    my $impcount = ++$self->{"impcount"};
    return "_alternation_${impcount}_of_production_${prodcount}_of_rule_$self->{name}";
}


sub code
{

inc/Parse/RecDescent.pm  view on Meta::CPAN

    }
    $_[1] = $text;
    return $return;
}
';

    return $code;
}

my @left;
sub isleftrec($$)
{
    my ($self, $rules) = @_;
    my $root = $self->{"name"};
    @left = $self->leftmostsubrules();
    my $next;
    foreach $next ( @left )
    {
        next unless defined $rules->{$next}; # SKIP NON-EXISTENT RULES
        return 1 if $next eq $root;
        my $child;

inc/Parse/RecDescent.pm  view on Meta::CPAN

    return ($itemcount) ? $_[0]->{"items"}[0]->describe(1) : '';
}

sub hasleftmost ($$)
{
    my ($self, $ref) = @_;
    return ${$self->{"items"}}[0] eq $ref  if scalar @{$self->{"items"}};
    return 0;
}

sub isempty($)
{
    my $self = shift;
    return 0 == @{$self->{"items"}};
}

sub leftmostsubrule($)
{
    my $self = shift;

    if ( $#{$self->{"items"}} >= 0 )
    {
        my $subrule = $self->{"items"}[0]->issubrule();
        return $subrule if defined $subrule;
    }

    return ();
}

sub checkleftmost($)
{
    my @items = @{$_[0]->{"items"}};
    if (@items==1 && ref($items[0]) =~ /\AParse::RecDescent::Error/
        && $items[0]->{commitonly} )
    {
        Parse::RecDescent::_warn(2,"Lone <error?> in production treated
                        as <error?> <reject>");
        Parse::RecDescent::_hint("A production consisting of a single
                      conditional <error?> directive would
                      normally succeed (with the value zero) if the

inc/Parse/RecDescent.pm  view on Meta::CPAN

                  . ", so you may have been expecting some other behaviour."
                : "You can safely ignore this message.";
        Parse::RecDescent::_hint("The production starts with $what. That means that the
                      production can never successfully match, so it was
                      optimized out of the final parser$caveat. $advice");
        return 0;
    }
    return 1;
}

sub changesskip($)
{
    my $item;
    foreach $item (@{$_[0]->{"items"}})
    {
        if (ref($item) =~ /Parse::RecDescent::(Action|Directive)/)
        {
            return 1 if $item->{code} =~ /\$skip\s*=/;
        }
    }
    return 0;

inc/Parse/RecDescent.pm  view on Meta::CPAN

sub postitempos
{
    return q
    {
        $itempos[$#itempos]{'offset'}{'to'} = $prevoffset;
        $itempos[$#itempos]{'line'}{'to'}   = $prevline;
        $itempos[$#itempos]{'column'}{'to'} = $prevcolumn;
    }
}

sub code($$$$)
{
    my ($self,$namespace,$rule,$parser) = @_;
    my $code =
'
    while (!$_matched'
    . (defined $self->{"uncommit"} ? '' : ' && !$commit')
    . ')
    {
        ' .
        ($self->changesskip()

inc/Parse/RecDescent.pm  view on Meta::CPAN

    {
        "code"      => $_[1],
        "lookahead" => $_[2],
        "line"      => $_[3],
    }, $class;
}

sub issubrule { undef }
sub isterminal { 0 }

sub code($$$$)
{
    my ($self, $namespace, $rule) = @_;

'
        Parse::RecDescent::_trace(q{Trying action},
                      Parse::RecDescent::_tracefirst($text),
                      q{' . $rule->{name} . '},
                      $tracelevel)
                        if defined $::RD_TRACE;
        ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .'

inc/Parse/RecDescent.pm  view on Meta::CPAN

    my $class = ref($_[0]) || $_[0];
    bless
    {
        "code"      => $_[1],
        "lookahead" => $_[2],
        "line"      => $_[3],
        "name"      => $_[4],
    }, $class;
}

sub code($$$$)
{
    my ($self, $namespace, $rule) = @_;

'
        ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .'

        Parse::RecDescent::_trace(q{Trying directive: ['
                    . $self->describe . ']},
                    Parse::RecDescent::_tracefirst($text),
                      q{' . $rule->{name} . '},

inc/Parse/RecDescent.pm  view on Meta::CPAN

    {
        "lookahead" => $_[1],
        "line"      => $_[2],
        "name"      => $_[3],
    }, $class;
}

# MARK, YOU MAY WANT TO OPTIMIZE THIS.


sub code($$$$)
{
    my ($self, $namespace, $rule) = @_;

'
        Parse::RecDescent::_trace(q{>>Rejecting production<< (found '
                     . $self->describe . ')},
                     Parse::RecDescent::_tracefirst($text),
                      q{' . $rule->{name} . '},
                      $tracelevel)
                        if defined $::RD_TRACE;

inc/Parse/RecDescent.pm  view on Meta::CPAN

    my $class = ref($_[0]) || $_[0];
    bless
    {
        "msg"        => $_[1],
        "lookahead"  => $_[2],
        "commitonly" => $_[3],
        "line"       => $_[4],
    }, $class;
}

sub code($$$$)
{
    my ($self, $namespace, $rule) = @_;

    my $action = '';

    if ($self->{"msg"})  # ERROR MESSAGE SUPPLIED
    {
        #WAS: $action .= "Parse::RecDescent::_error(qq{$self->{msg}}" .  ',$thisline);';
        $action .= 'push @{$thisparser->{errors}}, [qq{'.$self->{msg}.'},$thisline];';

inc/Parse/RecDescent.pm  view on Meta::CPAN

        "ldelim"      => $ldel,
        "rdelim"      => $rdel,
        "mod"         => $mod,
        "lookahead"   => $_[4],
        "line"        => $_[5],
        "description" => $desc,
    }, $class;
}


sub code($$$$$)
{
    my ($self, $namespace, $rule, $check) = @_;
    my $ldel = $self->{"ldelim"};
    my $rdel = $self->{"rdelim"};
    my $sdel = $ldel;
    my $mod  = $self->{"mod"};

    $sdel =~ s/[[{(<]/{}/;

my $code = '

inc/Parse/RecDescent.pm  view on Meta::CPAN

    bless
    {
        "pattern"     => $pattern,
        "lookahead"   => $_[2],
        "line"        => $_[3],
        "description" => "'$desc'",
    }, $class;
}


sub code($$$$)
{
    my ($self, $namespace, $rule, $check) = @_;

my $code = '
        Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe
                      . ']},
                      Parse::RecDescent::_tracefirst($text),
                      q{' . $rule->{name} . '},
                      $tracelevel)
                        if defined $::RD_TRACE;

inc/Parse/RecDescent.pm  view on Meta::CPAN

    bless
    {
        "pattern"   => $pattern,
        "lookahead" => $_[2],
        "line"      => $_[3],
        "description" => "'$desc'",
    }, $class;
}

sub code($$$$)
{
    my ($self, $namespace, $rule, $check) = @_;

my $code = '
        Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe
                      . ']},
                      Parse::RecDescent::_tracefirst($text),
                      q{' . $rule->{name} . '},
                      $tracelevel)
                        if defined $::RD_TRACE;

inc/Parse/RecDescent.pm  view on Meta::CPAN

sub isterminal { 0 }
sub sethashname {}

sub describe ($)
{
    my $desc = $_[0]->{"implicit"} || $_[0]->{"subrule"};
    $desc = "<matchrule:$desc>" if $_[0]->{"matchrule"};
    return $desc;
}

sub callsyntax($$)
{
    if ($_[0]->{"matchrule"})
    {
        return "&{'$_[1]'.qq{$_[0]->{subrule}}}";
    }
    else
    {
        return $_[1].$_[0]->{"subrule"};
    }
}

inc/Parse/RecDescent.pm  view on Meta::CPAN

        "subrule"   => $_[1],
        "lookahead" => $_[2],
        "line"      => $_[3],
        "implicit"  => $_[4] || undef,
        "matchrule" => $_[5],
        "argcode"   => $_[6] || undef,
    }, $class;
}


sub code($$$$)
{
    my ($self, $namespace, $rule, $check) = @_;

'
        Parse::RecDescent::_trace(q{Trying subrule: [' . $self->{"subrule"} . ']},
                  Parse::RecDescent::_tracefirst($text),
                  q{' . $rule->{"name"} . '},
                  $tracelevel)
                    if defined $::RD_TRACE;
        if (1) { no strict qw{refs};

inc/Parse/RecDescent.pm  view on Meta::CPAN

sub isterminal { 0 }
sub sethashname {  }

sub describe ($)
{
    my $desc = $_[0]->{"expected"} || $_[0]->{"subrule"};
    $desc = "<matchrule:$desc>" if $_[0]->{"matchrule"};
    return $desc;
}

sub callsyntax($$)
{
    if ($_[0]->{matchrule})
        { return "sub { goto &{''.qq{$_[1]$_[0]->{subrule}}} }"; }
    else
        { return "\\&$_[1]$_[0]->{subrule}"; }
}

sub new ($$$$$$$$$$)
{
    my ($self, $subrule, $repspec, $min, $max, $lookahead, $line, $parser, $matchrule, $argcode) = @_;

inc/Parse/RecDescent.pm  view on Meta::CPAN

        "min"       => $min,
        "max"       => $max,
        "lookahead" => $lookahead,
        "line"      => $line,
        "expected"  => $desc,
        "argcode"   => $argcode || undef,
        "matchrule" => $matchrule,
    }, $class;
}

sub code($$$$)
{
    my ($self, $namespace, $rule, $check) = @_;

    my ($subrule, $repspec, $min, $max, $lookahead) =
        @{$self}{ qw{subrule repspec min max lookahead} };

'
        Parse::RecDescent::_trace(q{Trying repeated subrule: [' . $self->describe . ']},
                  Parse::RecDescent::_tracefirst($text),
                  q{' . $rule->{"name"} . '},

inc/Parse/RecDescent.pm  view on Meta::CPAN

sub isterminal { 0 }
sub describe { '' }

sub new
{
    my ($class, $pos) = @_;

    bless {}, $class;
}

sub code($$$$)
{
    my ($self, $namespace, $rule) = @_;

    '
        $return = $item[-1];
    ';
}

package Parse::RecDescent::Operator;

inc/Parse/RecDescent.pm  view on Meta::CPAN

        "type"      => "${type}op",
        "leftarg"   => $leftarg,
        "op"        => $op,
        "min"       => $minrep,
        "max"       => $maxrep,
        "rightarg"  => $rightarg,
        "expected"  => "<${type}op: ".$leftarg->describe." ".$op->describe." ".$rightarg->describe.">",
    }, $class;
}

sub code($$$$)
{
    my ($self, $namespace, $rule, $check) = @_;

    my @codeargs = @_[1..$#_];

    my ($leftarg, $op, $rightarg) =
        @{$self}{ qw{leftarg op rightarg} };

    my $code = '
        Parse::RecDescent::_trace(q{Trying operator: [' . $self->describe . ']},

inc/Parse/RecDescent.pm  view on Meta::CPAN

my $ERRORS = 0;

our $VERSION = '1.967009';
$VERSION = eval $VERSION;
$_FILENAME=__FILE__;

# BUILDING A PARSER

my $nextnamespace = "namespace000001";

sub _nextnamespace()
{
    return "Parse::RecDescent::" . $nextnamespace++;
}

# ARGS ARE: $class, $grammar, $compiling, $namespace
sub new ($$$$)
{
    my $class = ref($_[0]) || $_[0];
    local $Parse::RecDescent::compiling = $_[2];
    my $name_space_name = defined $_[3]

inc/Parse/RecDescent.pm  view on Meta::CPAN

        $self->{_check}{itempos} =
            $sourcecode =~ /\@itempos\b|\$itempos\s*\[/;
        $self->{_AUTOACTION}
            = new Parse::RecDescent::Action($sourcecode,0,-1)
    }

    bless $self, $class;
    return $self->Replace($_[1])
}

sub Compile($$$$) {
    die "Compilation of Parse::RecDescent grammars not yet implemented\n";
}

sub DESTROY {
    my ($self) = @_;
    my $namespace = $self->{namespace};
    $namespace =~ s/Parse::RecDescent:://;
    if ($self->{_not_precompiled}) {
        # BEGIN WORKAROUND
        # Perl has a bug that creates a circular reference between

inc/Parse/RecDescent.pm  view on Meta::CPAN

        local $::RD_HINT = defined $::RD_HINT ? $::RD_HINT : 1;
        _hint('Set $::RD_HINT (or -RD_HINT if you\'re using "perl -s")
               for hints on fixing these problems.  Use $::RD_HINT = 0
               to disable this message.');
    }
    if ($ERRORS) { $ERRORS=0; return }
    return $self;
}


sub _addstartcode($$)
{
    my ($self, $code) = @_;
    $code =~ s/\A\s*\{(.*)\}\Z/$1/s;

    $self->{"startcode"} .= "$code;\n";
}

# CHECK FOR GRAMMAR PROBLEMS....

sub _check_insatiable($$$$)
{
    my ($subrule,$repspec,$grammar,$line) = @_;
    pos($grammar)=pos($_[2]);
    return if $grammar =~ m/$OPTIONAL/gco || $grammar =~ m/$ANY/gco;
    my $min = 1;
    if ( $grammar =~ m/$MANY/gco
      || $grammar =~ m/$EXACTLY/gco
      || $grammar =~ m/$ATMOST/gco
      || $grammar =~ m/$BETWEEN/gco && do { $min=$2; 1 }
      || $grammar =~ m/$ATLEAST/gco && do { $min=$2; 1 }

inc/Parse/RecDescent.pm  view on Meta::CPAN

                  last;
              }
              $hasempty ||= $prod->isempty();
          }
      }
    }
}

# GENERATE ACTUAL PARSER CODE

sub _code($)
{
    my $self = shift;
    my $initial_skip = defined($self->{skip}) ? $self->{skip} : $skip;

    my $code = qq!
package $self->{namespace};
use strict;
use vars qw(\$skip \$AUTOLOAD $self->{localvars} );
\@$self->{namespace}\::ISA = ();
\$skip = '$initial_skip';

inc/Parse/RecDescent.pm  view on Meta::CPAN

    {
        foreach ( @{$_[0]->{errors}} ) { _error(@$_); }
    }

    if (ref $_[1] eq 'SCALAR') { ${$_[1]} = $text }

    $ERRORS = 0;
    return $retval;
}

sub _parserepeat($$$$$$$$$)    # RETURNS A REF TO AN ARRAY OF MATCHES
{
    my ($parser, $text, $prod, $min, $max, $_noactions, $expectation, $argcode, $_itempos) = @_;
    my @tokens = ();

    my $itemposfirst;
    my $reps;
    for ($reps=0; $reps<$max;)
    {
        $expectation->at($text);
        my $_savetext = $text;

inc/Parse/RecDescent.pm  view on Meta::CPAN

sub _write_TRACECONTEXT {
    my ($tracelevel, $tracerulename, $tracecontext) = @_;
    return if $tracecontext !~ /\S/;
    $tracecontext =~ s/\s*\Z//;
    local $^A = q{};
    my $bar = '|';
    formline($TRACECONTEXT_FORMAT, $tracelevel, $tracerulename, $bar, $tracecontext, $tracecontext);
    print {*STDERR} $^A;
}

sub _verbosity($)
{
       defined $::RD_TRACE
    or defined $::RD_HINT    and  $::RD_HINT   and $_[0] =~ /ERRORS|WARN|HINT/
    or defined $::RD_WARN    and  $::RD_WARN   and $_[0] =~ /ERRORS|WARN/
    or defined $::RD_ERRORS  and  $::RD_ERRORS and $_[0] =~ /ERRORS/
}

sub _error($;$)
{
    $ERRORS++;
    return 0 if ! _verbosity("ERRORS");
    my $errortext   = $_[0];
    my $errorprefix = "ERROR" .  ($_[1] ? " (line $_[1])" : "");
    $errortext =~ s/\s+/ /g;
    print {*STDERR} "\n" if _verbosity("WARN");
    _write_ERROR($errorprefix, $errortext);
    return 1;
}

sub _warn($$;$)
{
    return 0 unless _verbosity("WARN") && ($::RD_HINT || $_[0] >= ($::RD_WARN||1));
    my $errortext   = $_[1];
    my $errorprefix = "Warning" .  ($_[2] ? " (line $_[2])" : "");
    print {*STDERR} "\n" if _verbosity("HINT");
    $errortext =~ s/\s+/ /g;
    _write_ERROR($errorprefix, $errortext);
    return 1;
}

sub _hint($)
{
    return 0 unless $::RD_HINT;
    my $errortext = $_[0];
    my $errorprefix = "Hint" .  ($_[1] ? " (line $_[1])" : "");
    $errortext =~ s/\s+/ /g;
    _write_ERROR($errorprefix, $errortext);
    return 1;
}

sub _tracemax($)
{
    if (defined $::RD_TRACE
        && $::RD_TRACE =~ /\d+/
        && $::RD_TRACE>1
        && $::RD_TRACE+10<length($_[0]))
    {
        my $count = length($_[0]) - $::RD_TRACE;
        return substr($_[0],0,$::RD_TRACE/2)
            . "...<$count>..."
            . substr($_[0],-$::RD_TRACE/2);
    }
    else
    {
        return substr($_[0],0,500);
    }
}

sub _tracefirst($)
{
    if (defined $::RD_TRACE
        && $::RD_TRACE =~ /\d+/
        && $::RD_TRACE>1
        && $::RD_TRACE+10<length($_[0]))
    {
        my $count = length($_[0]) - $::RD_TRACE;
        return substr($_[0],0,$::RD_TRACE) . "...<+$count>";
    }
    else
    {
        return substr($_[0],0,500);
    }
}

my $lastcontext = '';
my $lastrulename = '';
my $lastlevel = '';

sub _trace($;$$$)
{
    my $tracemsg      = $_[0];
    my $tracecontext  = $_[1]||$lastcontext;
    my $tracerulename = $_[2]||$lastrulename;
    my $tracelevel    = $_[3]||$lastlevel;
    if ($tracerulename) { $lastrulename = $tracerulename }
    if ($tracelevel)    { $lastlevel = $tracelevel }

    $tracecontext =~ s/\n/\\n/g;
    $tracecontext =~ s/\s+/ /g;

inc/Parse/RecDescent.pm  view on Meta::CPAN

        $prefix = "...";
        if ($self->{lookahead} < 0)
        {
            $prefix .= '!';
            $matched = not $matched;
        }
    }
    $prefix . ($matched ? $t[0] : $t[1]) . $postfix;
}

sub _parseunneg($$$$$)
{
    _parse($_[0],$_[1],$_[3],$_[4]);
    if ($_[2]<0)
    {
        _error("Can't negate \"$_[4]\".",$_[3]);
        _hint("You can't negate $_[0]. Remove the \"...!\" before
               \"$_[4]\".");
        return 0;
    }
    return 1;
}

sub _parse($$$$)
{
    my $what = $_[3];
       $what =~ s/^\s+//;
    if ($_[1])
    {
        _warn(3,"Found $_[0] ($what) after an unconditional <error>",$_[2])
        and
        _hint("An unconditional <error> always causes the
               production containing it to immediately fail.
               \u$_[0] that follows an <error>

inc/Parse/RecDescent.pm  view on Meta::CPAN

               <error?> instead?");
    }

    return if ! _verbosity("TRACE");
    my $errortext = "Treating \"$what\" as $_[0]";
    my $errorprefix = "Parse::RecDescent";
    $errortext =~ s/\s+/ /g;
    _write_ERROR($errorprefix, $errortext);
}

sub _linecount($) {
    scalar substr($_[0], pos $_[0]||0) =~ tr/\n//
}


package main;

use vars qw ( $RD_ERRORS $RD_WARN $RD_HINT $RD_TRACE $RD_CHECK );
$::RD_CHECK = 1;
$::RD_ERRORS = 1;
$::RD_WARN = 3;