use strict;
use warnings;
use Parse::RecDescent qw( );
my $grammar = <<'__END_OF_GRAMMAR__';
{
use strict;
use warnings;
}
parse : <rulevar: local %vars>
parse : expr /^\Z/ { [ $item[1], [ sort keys %vars ] ] }
# Just an alias
expr : or
# vvv lowest precedence
# or : or '+' and
# | or '^' and
# | and
or : and or_[ $item[1] ]
or_ : '+' <commit> and or_[ [ 'or', $arg[0], $item[3] ] ]
| '^' <commit> and or_[ [ 'or', $arg[0], $item[3] ] ]
| { $arg[0] }
# and : and '*' not1
# | not1
and : not1 and_[ $item[1] ]
and_ : '*' <commit> not1 and_[ [ 'and', $arg[0], $item[3] ] ]
| { $arg[0] }
# not : '!' not
# | not "'"
# | term
not1 : '!' <commit> not1 { [ 'not', $item[3] ] }
| not2
not2 : term not2_[ $item[1] ]
not2_ : "'" <commit> not2_[ [ 'not', $arg[0] ] ]
| { $arg[0] }
# ^^^ highest precedence
term : '(' <commit> expr ')' { $item[3] }
| /\w+/ { $vars{$item[1]} = 0; [ 'var', $item[1] ] }
__END_OF_GRAMMAR__
Parse::RecDescent->Precompile($grammar, 'Parser')
or die("Bad grammar\n");
Then you can generate the truth tables from the parse tree.
table_truth.pl
use strict;
use warnings;
use Algorithm::Loops qw( NestedLoops );
use Data::Dumper qw( Dumper );
use Parser qw( );
{
our %symtab;
my %eval = (
var => sub { $symtab{$_[1]} },
not => sub { ( ~ eval_node($_[1]) ) & 1 },
and => sub { eval_node($_[1]) & eval_node($_[2]) },
or => sub { eval_node($_[1]) | eval_node($_[2]) },
xor => sub { eval_node($_[1]) ^ eval_node($_[2]) },
);
sub eval_node {
my ($node) = @_;
$eval{$node->[0]}->(@$node)
}
sub eval_expr {
my ($tree, $vars, $vals) = @_;
local %symtab;
@symtab{ @$vars } = @$vals;
eval_node($tree)
}
}
my $parser = Parser->new();
foreach my $expr (
"a*b*!(c)",
"a'+b'+c'",
"!(A*B)",
) {
my $results = $parser->parse($expr)
or die("Bad expression $expr\n");
my ($tree, $vars) = @$results;
print(join("\t", @$vars), "\t$expr\n");
my $i = NestedLoops([ ([0,1])x@$vars ]);
while (my @vals = $i->()) {
my $result = eval_expr($tree, $vars, \@vals);
print(join("\t", @vals), "\t$result\n");
}
print("\n");
}
Output
>make_parser.pl
>truth_table.pl
a b c a*b*!(c)
0 0 0 0
0 0 1 0
0 1 0 0
0 1 1 0
1 0 0 0
1 0 1 0
1 1 0 1
1 1 1 0
a b c a'+b'+c'
0 0 0 1
0 0 1 1
0 1 0 1
0 1 1 1
1 0 0 1
1 0 1 1
1 1 0 1
1 1 1 0
A B !(A*B)
0 0 1
0 1 1
1 0 1
1 1 0
table_truth.pl could actually produce Perl code which you could eval instead of "executing" the tree itself, but executing the tree is quite simple.
Update: I had the precedence reversed. |