view release on metacpan or  search on metacpan

lib/Grammar/Marpa.pm  view on Meta::CPAN

package Grammar::Marpa;

use strict;
use warnings;
use 5.018;
use utf8;
use overload ('qr' => 'regexify', fallback => 0);

use Marpa::R2;

our $VERSION = '2.004';

sub regexify {
    my ($grammar) = @_;
    use re 'eval';
    return qr/(?{Grammar::Marpa::parse($grammar, "$_")})/;
}

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my $ebnf = ref($_[0]) eq 'HASH' ? undef : shift(@_);
    my $pkg;
    my %args;
    if (ref ($_[-1]) eq 'HASH') {
        %args = %{pop(@_)};
        $pkg = shift(@_) // (caller)[0];
    }
    elsif (@_ % 2) {
        $pkg = shift;
        %args = @_;
    }
    else {
        $pkg = (caller)[0];
        %args = @_;
    }
    my %Gargs;
    $Gargs{ bless_package } = delete $args{ bless_package } if $args{ bless_package };
    $Gargs{ trace_file_handle } = $args{ trace_file_handle } if $args{ trace_file_handle };
    $ebnf //= delete $args{ source };
    $ebnf = $$ebnf if ref($ebnf);
    my $G = Marpa::R2::Scanless::G->new({ source => \$ebnf, %Gargs });
    return bless [ $G, $pkg, \%args ] => $class;
}

sub parse {
    my ($grammar, $string) = @_;
    my $R = Marpa::R2::Scanless::R->new({ grammar => $grammar->[ 0 ], semantics_package => $grammar->[ 1 ], %{$grammar->[ 2 ]} });
    $R->read(\$string);
    my $V = $R->value or return;
    return $$V;
}

package Grammar;

sub Marpa {
    return Grammar::Marpa->new(@_);
}

1;

__END__

=head1 NAME

Grammar::Marpa - Regexp-overloading wrapper around Marpa::R2::Scanless

=head1 VERSION

Version 2.004

=head1 SYNOPSIS

    use Grammar::Marpa;

    my $dsl = <<'END_OF_DSL';
    :default ::= action => ::first
    :start ::= Expression
    Expression ::= Term
    Term ::= Factor
           | Term '+' Term action => do_add
    Factor ::= Number
             | Factor '*' Factor action => do_multiply
    Number ~ digits
    digits ~ [\d]+
    :discard ~ whitespace
    whitespace ~ [\s]+
    END_OF_DSL

    sub M::do_add {
        my (undef, $t1, undef, $t2) = @_;
        return $t1 + $t2;
    }

    sub M::do_multiply {
        my (undef, $t1, undef, $t2) = @_;
        return $t1 * $t2;
    }

    my $g = Grammar::Marpa->new({ source => $dsl, semantics_package => 'M');

    '1 + 2 * 3' =~ $g;