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");

##</code><code>##

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");
}

##</code><code>##

>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