BasicAmbiguity.pl

#!/usr/bin/env perl
use Marpa::R2;
use warnings;
use strict;

my $basic_math_grammar =
  Marpa::R2::Scanless::G->new({
    action_object  => 'BasicMath',
    default_action => '::first',
    source => \(<<'END_OF_RULES'),
:start ::= Factor

# closures are needed for all G1 rules
# for which we will call closures in the traverser,
# Otherwise $glade->rh_values() can be used in the traverser
# to perform the default action
Factor ::=
  Variable
  | Number
  | Factor Mulop Factor action => infix
  | Function Factor action => prefix
 
Function ~ 'sin'
Mulop ~ [*/] 
Variable ~ [\w]
Number ~ [\d]+
:discard ~ whitespace
whitespace ~ [\s]+
 
END_OF_RULES
});
 
sub BasicMath::new {return {};}
sub BasicMath::infix {
  my (undef,$arg1,$operator,$arg2) = @_;
  return "$arg1 $operator $arg2";
}
sub BasicMath::prefix {
  my (undef,$operator,$arg1) = @_;
  return "$operator($arg1)";
}

my $recognizer = Marpa::R2::Scanless::R->new({
    grammar => $basic_math_grammar
});
my $formula = 'sin x / y';
$recognizer->read( \$formula );
print STDERR "Ambiguous math input using value():\n";
while (my $value_ref = $recognizer->value) {
  print STDERR $$value_ref,"\n"; }

# reset the recognizer; this allows switching between ASF/value() modes
$recognizer->series_restart();

#
# ASF and traverser code adapted from Jeffrey Kegler's Marpa::R2 test suite
# https://metacpan.org/source/JKEGL/Marpa-R2-2.079_011/t/sl_panda.t
#

# create ASF
my $asf = Marpa::R2::ASF->new( { slr => $recognizer } );

# traverse
print STDERR "Ambiguous math input using rule closures in ASF:\n", 
    join "\n", @{ $asf->traverse( {}, \&traverser ) }, 
        "\n";

sub 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 = $basic_math_grammar->symbol_name($symbol_id);

    # A token is a single choice, and we know what to return
    if ( not defined $rule_id ) {
        return [ $glade->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 @values = $glade->rh_values();
        my @results = ( [] );
        for my $rh_ix ( 0 .. @values - 1 ) {
            my @new_results = ();
            for my $old_result (@results) {
                my $child_value = $values[$rh_ix];
                for my $new_value ( @{ $child_value } ) {
                    push @new_results, [ @{$old_result}, $new_value ];
                }
            }
            @results = @new_results;
        } ## end for my $rh_ix ( 0 .. $length - 1 )

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

        # Get the closure        
        my $closure = $recognizer->rule_closure($glade->rule_id());

        # If the closure is not defined, imitate default action of the grammar
        # which is now ::first and return the first value
        # TODO: get the rule's default action from the recognizer/grammar
        # and do it using rh_values()
        if (not defined $closure){
            my $first = $glade->rh_value(0);
            $closure = sub { $first->[0] }; # values are wrapped
        }
        
        # Now we have a list of choices, as a list of lists.  Each sub list
        # is a list of parse results, which we need to join into a semantic 
        # result by collapsing one level of lists and applying rule closures 
        # that will leave us with a list of the rules' semantic values
        push @return_value,
            map { 
                $closure->( {}, @{ $_ } )
            }
            @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 Penn-tagged elements for this glade
    return \@return_value;
} ## end sub full_traverser