#!/usr/bin/perl
$ENV{DEBUG} ||= $^P;

my %parse = ('All % are %'       => sub { C(@_[0,1]) || 
                                          C(Not($_[1]), Not($_[0])) },
             'Some % are %'      => \&T,
             'All % are not %'   => sub { C($_[0], Not($_[1])) ||
                                          C($_[1], Not($_[0])) },
             'Some % are not %'  => sub { T($_[0], Not($_[1])) },
             'No % are %'        => "All % are not %",
             'No % are not %'    => "All % are %",
             'Are all % %?'      => \&q_C,
             'Are all % not %?'  => sub { q_C($_[0], Not($_[1])) },
             'Are any % %?'      => \&q_T,
             'Are any % not %?'  => sub { q_T($_[0], Not($_[1])) },
             'Are some % %?'     => "Are any % %?",
             'Are some % not %?' => "Are any % not %?",
             'Are no % %?'       => "Are all % not %?",
             'Are no % not %?'   => "Are all % %?",
             'Are there any %?'  => \&q_E,
             'Describe %'        => \&describe,
            );

while (<>) {
  my ($expected) = /#\s*(.*)/;
  s/\s*#.*$//;
  next unless /\S/;
  last if /STOP/;
  print unless -t ARGV;
  chomp;
  my $result = parse($_);
  print "\t", $result || "OK", ".\n";
  if ($ENV{DEBUG} && defined $expected) {
    if (lc $expected eq lc $result) {
      print "  # ok\n";
    } else {
      print "  # not ok - expected '$expected'\n";
    }
  }
}

my (%contains, %intersects, %nonempty);

# Assert that $A is a subset of $B
sub C {
  my ($A, $B) = @_;
  if (search_up($A, $B)) {
    return "That would imply that $A and $B are the same thing; ignoring";
  } elsif (search_up($B, $A)) {
    return "I know";
  }
  $contains{$A}{$B} = 1;
  nonempty($B, 1) if nonempty($A); # B is nonempty if A is
  return;
}

sub supersets {
  keys %{$contains{$_[0]}};
}

# Assert that the intersection of $A and $B is nonempty
sub T {
  my ($A, $B) = @_;

  # A and B intersect each other
  $intersects{$A}{$B} = 1;
  $intersects{$B}{$A} = 1;

  # A, B, and their supersets are nonempty
  search_up(sub {nonempty($_, 1), 0}, $_) for $A, $B;

  return;
}

sub intersections {
  keys %{$intersects{$_[0]}};
}

# Ask if $A is a subset of $B
sub q_C {
  my ($A, $B) = @_;
  search_up($B, $A) ? "Yes" :
  search_up(Not($B), intersections($A)) ? "No" :
  search_up(Not($B), $A) ? (nonempty($A) ? "No" : "Only if there are no $A at all" )
                         : "I don't know"
  ; 
}

# Ask if the intersection of $A and $B is nonempty
sub q_T {
  my ($A, $B) = @_;
  search_up(Not($B), $A) ? "No"  :
  search_up($B, intersections($A)) ? "Yes" :
  search_up($A, intersections($B)) ? "Yes" :
  search_up($B, $A) ? (nonempty($A) ? "Yes" : "Yes, unless there are no $A" ) :
  search_up($A, $B) ? (nonempty($B) ? "Yes" : "Yes, unless there are no $B" )
                    : "I don't know";
}

sub search_up { _search_up({}, @_) }

sub _search_up {
  my $seen = shift;
  my $target = shift;
  my $predicate = ref $target ? $target : sub { $_ eq $target };
  for (@_) {
    next if $seen->{$_}++;
    my $result = 
      $predicate->($_) ? $_
                    : _search_up($seen, $target, supersets($_));
    return $result if $result;
  }
  return;
}

# Ask if $A is known to be nonempty / assert that $A is nonempty
sub nonempty {
  my ($A, $assert) = @_;
  if (defined $assert) { $nonempty{$A} = $assert }
  $nonempty{$A};
}

sub q_E { nonempty($_[0]) ? "Yes" : 
          search_up(Not($_[0]), $_[0]) ? "No" : "I don't know" }

sub Not { 
  my $s = shift;
  $s =~ s/^!// ? $s : "!$s";
}

sub describe { "Unimplemented" }

sub parse {
  local $_ = shift;
  for my $pat (keys %parse) {
    (my $regex = $pat) =~ s/%/([\\w -]+)/g;
    my @nouns = /$regex/i;
    s/\s+things$// for @nouns;
    if (@nouns) {
#      print "  >> nouns: (", join(")(", @nouns), ")\n" if $ENV{DEBUG};
      my $result = $parse{$pat};
      $result = $parse{$result} until ref $result;
      return $result->(@nouns);
    }
  }
  return "I don't understand";
}

__DATA__
