Skip to content

@jeffreykegler /interpreter2.pl
Last active

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
The Gang of 4's second Interpreter Pattern example, rewritten to use Marpa::R2.
#!perl
# Copyright 2013 Jeffrey Kegler
# This file is part of Marpa::R2. Marpa::R2 is free software: you can
# redistribute it and/or modify it under the terms of the GNU Lesser
# General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# Marpa::R2 is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser
# General Public License along with Marpa::R2. If not, see
# http://www.gnu.org/licenses/.
# Based on the 2nd Gang of Four Interpeter example
use 5.010;
use strict;
use warnings;
use English qw( -no_match_vars );
use Data::Dumper;
use GetOpt::Long;
use autodie;
use Marpa::R2 2.047_012;
sub usage {
die <<"END_OF_USAGE_MESSAGE";
$PROGRAM_NAME
$PROGRAM_NAME --verbose
Runs a demo.
By default, prints the only the results of AST evaluation.
With --verbose, dumps each AST.
END_OF_USAGE_MESSAGE
} ## end sub usage
my $verbose_flag = 0;
my $getopt_result = Getopt::Long::GetOptions( 'verbose!' => \$verbose_flag, );
usage() if not $getopt_result;
# Note Go4 ignores precedence
my $rules = <<'END_OF_GRAMMAR';
:default ::= action => ::array
:start ::= <boolean expression>
<boolean expression> ::=
<variable> bless => variable
| '1' bless => constant
| '0' bless => constant
| ('(') <boolean expression> (')') action => ::first bless => ::undef
|| ('not') <boolean expression> bless => not
|| <boolean expression> ('and') <boolean expression> bless => and
|| <boolean expression> ('or') <boolean expression> bless => or
<variable> ~ [[:alpha:]] <zero or more word characters>
<zero or more word characters> ~ [\w]*
:discard ~ whitespace
whitespace ~ [\s]+
END_OF_GRAMMAR
my $grammar = Marpa::R2::Scanless::G->new(
{ bless_package => 'Boolean_Expression',
source => \$rules,
}
);
sub bnf_to_ast {
my ($bnf) = @_;
my $recce = Marpa::R2::Scanless::R->new( { grammar => $grammar } );
$recce->read( \$bnf );
my $value_ref = $recce->value();
if ( not defined $value_ref ) {
die "No parse for $bnf";
}
return ${$value_ref};
} ## end sub bnf_to_ast
my $demo_context = Context->new();
$demo_context->assign( x => 0 );
$demo_context->assign( y => 1 );
$demo_context->assign( z => 1 );
say $demo_context->show();
my $bnf = q{true and x or y and not x};
my $ast1 = bnf_to_ast($bnf);
say qq{Boolean 1 is "$bnf"};
say 'Value is ', $ast1->evaluate($demo_context) ? 'true' : 'false';
say Data::Dumper::Dumper($ast1) if $verbose_flag;
$bnf = 'not z';
my $ast2 = bnf_to_ast($bnf);
say qq{Boolean 2 is "$bnf"};
say 'Value is ', $ast2->evaluate($demo_context) ? 'true' : 'false';
say Data::Dumper->Dump( [$ast2], ['ast2'] ) if $verbose_flag;
my $ast3 = $ast1->replace( 'y', $ast2 );
say q{Boolean 3 is Boolean 1, with "y" replaced by Boolean 2};
say 'Value is ', $ast3->evaluate($demo_context) ? 'true' : 'false';
say Data::Dumper->Dump( [$ast3], ['ast3'] ) if $verbose_flag;
exit 0;
package Context;
sub new {
my ($class) = @_;
return bless {}, $class;
}
sub assign {
my ( $self, $name, $value ) = @_;
return $self->{$name} = $value;
}
sub lookup {
my ( $self, $name ) = @_;
my $value = $self->{$name};
die qq{Attempt to read undefined boolean variable named "$name"}
if not defined $value;
return $value;
} ## end sub lookup
sub show {
my ($self) = @_;
return join q{ }, map { join q{=}, $_, $self->{$_} } keys %{$self};
}
package Boolean_Expression::constant;
sub evaluate {
my ( $self, $context ) = @_;
my ($value) = @{$self};
return $value;
}
sub copy {
my ($self) = @_;
my ($value) = @{$self};
return bless [$value], ref $self;
}
sub replace {
my ($self) = @_;
return $self->copy();
}
package Boolean_Expression::variable;
sub evaluate {
my ( $self, $context ) = @_;
my ($name) = @{$self};
return 1 if $name eq 'true';
return 0
if $name eq 'false';
my $value = $context->lookup($name);
return $value;
} ## end sub evaluate
sub copy {
my ($self) = @_;
my ($name) = @{$self};
return bless [$name], ref $self;
}
sub replace {
my ( $self, $name_to_replace, $expression ) = @_;
my ($my_name) = @{$self};
return $expression->copy() if $my_name eq $name_to_replace;
return $self->copy();
} ## end sub replace
package Boolean_Expression::not;
sub evaluate {
my ( $self, $context ) = @_;
my ($exp1) = @{$self};
return !$exp1->evaluate($context);
}
sub copy {
my ($self) = @_;
return bless [ map { $_->copy() } @{$self} ], ref $self;
}
sub replace {
my ( $self, $name, $expression ) = @_;
return bless [ map { $_->replace( $name, $expression ) } @{$self} ],
ref $self;
}
package Boolean_Expression::and;
sub evaluate {
my ( $self, $context ) = @_;
my ( $exp1, $exp2 ) = @{$self};
return $exp1->evaluate($context) && $exp2->evaluate($context);
}
sub copy {
my ($self) = @_;
return bless [ map { $_->copy() } @{$self} ], ref $self;
}
sub replace {
my ( $self, $name, $expression ) = @_;
return bless [ map { $_->replace( $name, $expression ) } @{$self} ],
ref $self;
}
package Boolean_Expression::or;
sub evaluate {
my ( $self, $context ) = @_;
my ( $exp1, $exp2 ) = @{$self};
return $exp1->evaluate($context) || $exp2->evaluate($context);
}
sub copy {
my ($self) = @_;
return bless [ map { $_->copy() } @{$self} ], ref $self;
}
sub replace {
my ( $self, $name, $expression ) = @_;
return bless [ map { $_->replace( $name, $expression ) } @{$self} ],
ref $self;
}
# vim: expandtab shiftwidth=4:
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.