#!/usr/bin/perl

# http://perlmonks.org/?node_id=1188650
# Parsing Boolean expressions

use strict;
use warnings;
use Data::Dump 'pp';

my @tests = grep /\S/, split /\n/, <<END;
Y = A + (B*C)
Y = A + (B' + (C*D)')
Y = A*(B*(C'+D)')

Y = A             # wire
Y = (A')'         # double negation
Y = A'            # NOT gate
Y = (A + B)'      # NOR gate
Y = (A * B)'      # NAND gate
Y = (A' + B')'    # AND gate by De Morgan
Y = (A' * B')'    # OR gate by De Morgan
END

for ( @tests )    # for each test case
  {
  print "\nparsing: $_\n";
  for my $input (glob join '', map "$_:\{0,1\}", # for each combination
    sort s/.*=|#.*//gr =~ /\w+/g)                # of input values
    {
    my %dictionary = $input =~ /(\w+):(0|1)/g;
    Parsing::Boolean::Expressions::parse( $_, \%dictionary );
    pp \%dictionary;
    }
  }

package Parsing::Boolean::Expressions; ########################

my $vars; # variable dictionary hash ref

sub err { die s/\G/<* @_ *>/r, "\n" }
sub closeparen { /\G\)/gc ? shift : err "missing )" }

sub expr
  {
  my $p = shift; # precedence
  /\G(?:\s+|#.*)+/gc; # skip whitespace

  my $answer =
    /\G(\w+)\s*/gc ? do { my $name = $1;
      /\G=/gc ? $vars->{$name} = expr(0) : $vars->{$name} } :
    /\G\(/gc ? closeparen expr(0) :
    err "syntax error";
  
  /\G(?:\s+|#.*)+/gc, # skip whitespace
    $p <= 3 && /\G'/gc  ? $answer ^= 1 :       # highest precedence
    $p <= 2 && /\G\*/gc ? $answer &= expr(3) :
    $p <= 1 && /\G\+/gc ? $answer |= expr(2) : # lowest precedence
    return $answer while 1;
  }

sub parse # takes expression string and ref to dictionary hash
  {
  (local $_, $vars) = @_;
  expr(0);
  /\G\z/gc or err "incomplete parse";
  }

# end of package Parsing::Boolean::Expressions