view release on metacpan or  search on metacpan

share/P6STD/RE_ast.pmc  view on Meta::CPAN

        my $self = shift;
        my ($node, $prefix, $continue) = splice @$self;
        bless $self, 'NFA::Node';
        $node->construct($self, $prefix, $continue);
    }
}

{
    package NFA::Node;
    sub reify { }
}

{
    package NFA::seq;
    sub new {
        my ($left, $right) = @_;
        my $literal = $left->{literal};
        my $litlen  = $left->{litlen};
        if ($literal) {
            $literal &&= $right->{literal};
            $litlen  +=  ($right->{litlen} // 0);
        }
        bless { left => $left, right => $right, literal => $literal,
            litlen => $litlen, fates => ($left->{fates} || $right->{fates}) },
            'NFA::seq';
    }

    sub construct {
        my ($self, $node, $pre_fates, $continue) = @_;

        $self->{left}->construct($node, $pre_fates, sub {
                my $mid_fates = shift;
                NFA::Lazy->new($self->{right}, $mid_fates, $continue);
            });
    }
}

#############################################################
# longest token set generator
#############################################################

#    $::DEBUG |= -1;
sub qm { my $s = shift;
    $s = $s->[0] if ref $s eq 'ARRAY';	# only count first token of circumfix or postcircumfix
    my $r = '';
    for (split(//,$s)) {
	if ($_ eq " ") { $r .= '\x20' }
	elsif ($_ eq "\t") { $r .= '\t' }
	elsif ($_ eq "\n") { $r .= '\n' }
	elsif ($_ =~ m/^\w$/) { $r .= $_ }
	elsif ($_ eq '<' | $_ eq '>') { $r .= $_ }
	else { $r .= '\\' . $_ }
    }
    $r;
}

sub here {
    return unless $::DEBUG & DEBUG::longest_token_pattern_generation;
    my $arg = shift;
    my $lvl = 0;
    while (caller($lvl)) { $lvl++ }
    my ($package, $file, $line, $subname, $hasargs) = caller(0);

    my $name = $package;   # . '::' . substr($subname,1);
    if (defined $arg) { 
	$name .= " " . $arg;
    }
    ::deb("\t", ':' x $lvl, ' ', $name, " [", $file, ":", $line, "]") if $::DEBUG & DEBUG::longest_token_pattern_generation;
}

{ package nfa;

# Rules: Don't call $cont more than once with the same fate.  Don't instantiate
# a node more than once with the same fate.
sub node {
    my $id = @::NFANODES;
    #::deb("creating direct node $id") if $::DEBUG & DEBUG::longest_token_pattern_generation;
    push @::NFANODES, [ $id, @_ ];
    $id;
}

sub gnode {
    my $id = @::NFANODES;
    #::deb("creating node $id via " . ref($_[0])) if $::DEBUG & DEBUG::longest_token_pattern_generation;
    push @::NFANODES, [ $id ];
    $_[0]->construct($::NFANODES[$id], $_[1], $_[2]);
    $id;
}

sub rgnode { my ($ob, $n, $f, $c) = @_;
    #::deb("forwarding node " . $n->[0] . " to " . ref($ob)) if $::DEBUG & DEBUG::longest_token_pattern_generation;
    $ob->construct($n, $f, $c);
}

sub nfa::null::construct { my ($self, $node, $fate, $cont) = @_;
    push @$node, $cont ? (undef, undef, $cont->($fate)) : ($fate);
}

sub nfa::imp::construct { my ($self, $node, $fate, $cont) = @_;
    push @$node, $fate;
}

our $NULL = bless({ m => [], nr => 0, l => 1, ll => 0 }, 'nfa::null');
our $IMP  = bless({ m => [], nr => 1, l => 0, ll => 0 }, 'nfa::imp');

# When a non-LTM alternation or quantifier is applied to a subregex, it becomes
# impossible to control where subsequent tokens match, so we can't copy fates.
sub nfa::horizon::construct { my ($self, $node, $fate, $cont) = @_;
    my @fate = @$fate;
    $fate[0] = 1;
    nfa::rgnode($self->{i}, $node, \@fate, $cont);
}
sub horizon { my ($inner) = @_;
    bless({ m => $inner->{m}, nr => $inner->{nr}, l => $inner->{l},
            ll => $inner->{ll}, i => $inner }, 'nfa::horizon');
}

sub method { my ($mp, $inner) = @_;
    bless({ %$inner, m => [ @{ $inner->{m} }, $mp ] }, ref($inner));
}

sub noreturn { $_[0]{nr} }