Example of scanless grammar for a calculator, with embedded actions, using MarpaX::Import, a scanless interface built on top of the Marpa::R2 reconizer. The lexer actions have to be in separated explicit namespace for the moment, could be supported embedded also if there is a neeed for it... The main code of the calculator is just compiling the …

MarpaX::Import::Example::Embedded_Actions_And_Lexer_Actions.pl

#!env perl

package My_Lex_Actions;
use strict;
use diagnostics;
use Log::Any qw/$log/;

sub new {
    my $class = shift;

    my $self  = {};
    bless($self, $class);

    return $self;
}

sub Pre {
    my ($self, $string, $line, $tokensp, $pos, $posline, $linenb, $expected, $matchesp, $longest_match, $token_name) = @_;
    $log->infof('pre lex callback fired for token %s', $tokensp->{$token_name}->{string});
    return 1;
}

sub Post {
    my ($self, $string, $line, $tokensp, $pos, $posline, $linenb, $expected, $matchesp, $longest_match, $token_name, $rc) = @_;
    $log->infof('post lex callback fired for token %s', $tokensp->{$token_name}->{string});
    return 1;
}

sub Action {
    my ($self, $string, $line, $pos, $posline, $linenb) = @_;
    $log->infof('event lex callback fired at this position: \"%s\"<<HERE', substr($line, $[, $posline - $[));
}

package main;
use strict;
use diagnostics;
use MarpaX::Import;
use Data::Dumper;
use POSIX;
use FindBin qw/$Bin/;
use Log::Log4perl qw /:easy/;
use Log::Any::Adapter;

our $log4perl = <<LOG4PERL;
log4perl.rootLogger              = TRACE, Screen
log4perl.appender.Screen         = Log::Log4perl::Appender::Screen
log4perl.appender.Screen.stderr  = 0
log4perl.appender.Screen.layout  = PatternLayout
log4perl.appender.Screen.layout.ConversionPattern = %-5p %m{chomp}%n
LOG4PERL

Log::Log4perl::init(\$log4perl);
Log::Any::Adapter->set('Log4perl');

############################
# main
############################
my $data = do { local $/; <DATA> };
my $any = MarpaX::Import->new();
my $grammar = $any->grammar($data, { startrules => [qw/expression/], lexactions => 'My_Lex_Actions'});
print Dumper($any->recognize($grammar, "1 + ((6 * 200) - 20) / 6"));
exit(EXIT_SUCCESS);

###########################
# Grammar
###########################
__DATA__
:default ::= action => ::array

group       ::= '(' expression ')'                       action => { shift; return $_[1]; }
factor      ::= qr/[\-\+]?[[:space:]]*[0-9]+\.?[0-9]*/   action => { shift; return $_[0]+0; }
	     | group                                     action => { shift; return $_[0]+0; }

pow         ::= factor ( '**'                            pre => Pre
                                                         post => Post
                              factor )*                  action => { shift;
								     my $rc = shift;
								     while (@_) {
									 shift;
									 $rc **= shift;
								     }
								     return $rc;
                                                                   }

term        ::= pow ( '*'                            pre => Pre
                                                     post => Post
                              pow | '/' pow )*       action => { shift;
								     my $rc = shift;
								     while (@_) {
									 if (shift eq '*') {
									     $rc *= shift;
									 } else {
									     $rc /= shift;
									 }
								     }
								     return $rc;
                                                                   }

expression  ::= term ( '+'  .Action term | '-' term )*    action => { shift;
								     my $rc = shift;
								     while (@_) {
									 if (shift eq '+') {
									     $rc += shift;
									 } else {
									     $rc -= shift;
									 }
								     }
								     return $rc;
                                                                   }

The output is:

INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
INFO event lex callback fired at this position: "1 + "<<HERE
INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
INFO pre lex callback fired for token *
INFO post lex callback fired for token *
INFO pre lex callback fired for token **
INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
INFO pre lex callback fired for token *
INFO pre lex callback fired for token **
$VAR1 = '197.666666666667';

Example of error reporting when the input is wrong, e.g. "1 + + ((6 * 200) - 20) / 6"))"

ERROR [ 1: 5] 1 + +
ERROR [ 1: 5] ----^
ERROR [ 1: 5] Failed to complete earleme at line 1, column 5
ERROR [ 1: 5] Expected GENERATED_TOKEN_000003: orig=qr/[-+]?[[:space:]][0-9]+.?[0-9]/, re=qr/(?^lms:\G(?:[-+]?[[:space:]][0-9]+.?[0-9]))/, string=, code=sub { "DUMMY" }
ERROR [ 1: 5] Expected GENERATED_TOKEN_000009: orig=qr/[[:space:]]+/, re=qr/(?^l:\G(?:[[:space:]]+))/, string=, code=sub { "DUMMY" }
ERROR [ 1: 5] Expected GENERATED_TOKEN_000001: orig='(', re=, string=(, code=sub { "DUMMY" }
ERROR No parsing