ast full travserser template

ast-full-traverser.out

Ambiguous parse: 5 alternatives.
# Alternative 1:
['Expr',['Expr',['Expr',['Expr',['Number','2']],'**',['Expr',['Number','7']]],'-',['Expr',['Number','3']]],'**',['Expr',['Number','10']]]
# Alternative 2:
['Expr',['Expr',['Expr',['Number','2']],'**',['Expr',['Expr',['Number','7']],'-',['Expr',['Number','3']]]],'**',['Expr',['Number','10']]]
# Alternative 3:
['Expr',['Expr',['Number','2']],'**',['Expr',['Expr',['Expr',['Number','7']],'-',['Expr',['Number','3']]],'**',['Expr',['Number','10']]]]
# Alternative 4:
['Expr',['Expr',['Number','2']],'**',['Expr',['Expr',['Number','7']],'-',['Expr',['Expr',['Number','3']],'**',['Expr',['Number','10']]]]]
# Alternative 5:
['Expr',['Expr',['Expr',['Number','2']],'**',['Expr',['Number','7']]],'-',['Expr',['Expr',['Number','3']],'**',['Expr',['Number','10']]]]

# trees from ASF traversing
[ Expr,[ Expr,[ Expr,[ Expr,[ Number 2 ] ]  [ ** ] [ Expr,[ Number 7 ] ]  ]  [ - ] [ Expr,[ Number 3 ] ]  ]  [ ** ] [ Expr,[ Number 10 ] ]  ] 
[ Expr,[ Expr,[ Expr,[ Number 2 ] ]  [ ** ] [ Expr,[ Expr,[ Number 7 ] ]  [ - ] [ Expr,[ Number 3 ] ]  ]  ]  [ ** ] [ Expr,[ Number 10 ] ]  ] 
[ Expr,[ Expr,[ Expr,[ Number 2 ] ]  [ ** ] [ Expr,[ Number 7 ] ]  ]  [ - ] [ Expr,[ Expr,[ Number 3 ] ]  [ ** ] [ Expr,[ Number 10 ] ]  ]  ] 
[ Expr,[ Expr,[ Number 2 ] ]  [ ** ] [ Expr,[ Expr,[ Expr,[ Number 7 ] ]  [ - ] [ Expr,[ Number 3 ] ]  ]  [ ** ] [ Expr,[ Number 10 ] ]  ]  ] 
[ Expr,[ Expr,[ Number 2 ] ]  [ ** ] [ Expr,[ Expr,[ Number 7 ] ]  [ - ] [ Expr,[ Expr,[ Number 3 ] ]  [ ** ] [ Expr,[ Number 10 ] ]  ]  ]  ] 

ast-full-traverser.pl

use 5.010;
use strict;
use warnings;

use Data::Dumper;
$Data::Dumper::Indent = 0;
$Data::Dumper::Terse = 1;
$Data::Dumper::Deepcopy = 1;

use Carp::Always; # force stack trace

use Marpa::R2 2.090; # for parse()

my $g = Marpa::R2::Scanless::G->new( {
    source => \(<<'END_OF_SOURCE'),

:default ::= action => [ name, value]
lexeme default = action => [ name, value ] latm => 1

    Expr ::=
          Number
       | Expr '**' Expr
       | Expr '-' Expr

    Number ~ [\d]+

:discard ~ whitespace
whitespace ~ [\s]+

END_OF_SOURCE
} );

my $input = <<EOI;
2**7-3**10
EOI

my $r = Marpa::R2::Scanless::R->new( {
    max_parses => 100,
    grammar => $g,
    too_many_earley_items => 500,
#        trace_terminals => 1
} );
eval { $r->read(\$input) } || warn "Parse failure: $@ Progress report is:\n" . $r->show_progress;

my $ast = $r->value;

unless (defined $ast){
    die "No parse";
}

if ( $r->ambiguity_metric() > 1 ){
    # gather parses
    my @asts;
    my $v = $ast;
    do {
        push @asts, ${ $v };
    } until ( not $v = $r->value() );
    say "Ambiguous parse: ", $#asts + 1, " alternatives.";
    for my $i (0..$#asts){
        say "# Alternative ", $i+1, ":\n", Dumper $asts[$i];
    }

    $r->series_restart();
    my $asf = Marpa::R2::ASF->new( { slr => $r } );
    my $full_result = $asf->traverse( {}, \&full_traverser );
    say "\n# trees from ASF traversing\n", join "\n", sort @$full_result;
}
else{
    say Dumper $ast;
}

sub full_traverser {

    # This routine converts the glade into a list of elements.  It is called recursively.
    my ($glade, $scratch)     = @_;
    my $rule_id     = $glade->rule_id();
    my $symbol_id   = $glade->symbol_id();
    my $symbol_name = $g->symbol_name($symbol_id);

    # A token is a single choice, and we know enough to return it
    if ( not defined $rule_id ) {
        my $literal = $glade->literal();
        return [$symbol_name eq 'Number' ? "[ $symbol_name $literal ]" : "[ $literal ]" ];
    } ## end if ( not defined $rule_id )

    # Our result will be a list of choices
    my @return_value = ();

    CHOICE: while (1) {

        # The results at each position are a list of choices, so
        # to produce a new result list, we need to take a Cartesian
        # product of all the choices
        my @results = $glade->all_choices();

        # Special case for the start rule
        if ( $symbol_name eq '[:start]' ) {
            return [ map { join q{}, @{$_} } @results ];
        }

        # Now we have a list of choices, as a list of lists.  Each sub list
        # is a list of elements, which we need to join into
        # a single element.  The result will be to collapse
        # one level of lists, and leave us with a list of
        # elements
        # the ast node is built here (as textual representation for now)
        my $join_ws = q{ };
        push @return_value,
            map { '[ ' . $symbol_name . q{,} . ( join $join_ws, @{$_} ) . ' ] ' }
            @results;

        # Look at the next alternative in this glade, or end the
        # loop if there is none
        last CHOICE if not defined $glade->next();

    } ## end CHOICE: while (1)

    # Return the list of elements for this glade
    return \@return_value;
} ## end sub full_traverser