package AI::Perlog2;
use strict;
use Carp;
#use Devel::StealthDebug;

our $order_do_matter = 1;

sub new {
        my $class = shift;
        my $self  = {
                _predicates    => {},
        };
        bless $self, $class;
}

sub add_fact {
        my ($self,$predicate,@args) = @_;
        my $predicate_id;
        
        if ( exists $self->{_predicates}{ $predicate } ) {
                $predicate_id = $self->{_predicates}{$predicate}{id};
        } else {
                $self->{_predicates}{$predicate}{id}=$predicate_id 
                        = $self->{_next_vertex}++;

                {       

                        no strict 'refs';
                        my $package = ref $self;
                        *{"$package::$predicate"} = 
                        sub {
                                my $self = shift;
                                unshift @_ => $predicate;
                                $self->_predicate( @_ );
                        };
                }
        }

        $self->{_collection}{$predicate_id}{join '+',sort @args} = \@args;
        
        return 1;
}
sub _predicate {
        my $self      = shift;
        my $predicate = shift;
        my @args      = @_;

        my %result;

        if ( $args[0] eq '?') {         # Ugly way to handle 
                shift @args;                    # position independant predicate
                $order_do_matter = 0;   #
        }

        carp "Predicate $predicate not found in database" 
                if ! exists $self->{_predicates}{ $predicate };
        
        my $key = join '+',sort @args;

        my $predicate_id = $self->{_predicates}{$predicate}{id};

        if ($self->{_collection}{$predicate_id}{$key}) {
                return ( "$predicate($key)"=> ["ok"] )                          # Match 
!
        } elsif ( grep {/^\$.+$/} @args ) {  
                #
                # Instead using all the predicates relating to the id
                #  (whe could use piped grep with the given args on the
                #  keys %{$self->{_collection}{$predicate_id}} to restrict
                #  to a small set of data to process and speed up things...)
                #

        
                # There's some var in the args
                # Let's try unification 
               if ($order_do_matter) {
                        for my $key (keys %{$self->{_collection}{$predicate_id}}) {
                                my @stored = @{$self->{_collection}{$predicate_id}{$key}
};
                                my %tempresults;
                                my $ko = 0;
                                for my $i (0..$#stored) {
                                        next    if (($args[$i] eq '_') or ($args[$i] eq 
$stored[$i]));
                                        if ($args[$i] =~ /^\$.+$/) {
                                                $tempresults{$args[$i]} = $stored[$i];
                                        } else { 
                                                $ko = 1;
                                        }
                                }
                                for my $tempkey (keys %tempresults) {
                                        push @{$result{$tempkey}}, $tempresults{$tempkey
}       unless $ko;
                                }
                        }
                        return %result;
                } else {
                        for my $key (keys %{$self->{_collection}{$predicate_id}}) {
                                my @stored = @{$self->{_collection}{$predicate_id}{$key}
};
                                my %stored;
                                
                                for my $item (@stored) {
                                        $stored{$item} = 1;
                                }
                                
                                my (%tempresults, $ko, %args);
                        
                                for my $i (grep {!/^\$.+$/} @args) {
                                        next if $i eq '_';
                                        if ($stored{$i}) {
                                                delete $stored{$i};
                                                next;
                                        } else { 
                                                %stored = ();
                                                last;
                                        }
                                }
                        
                                my $set = join'+', grep {/^\$.+$/} @args;
                                if (%stored) {
                                        push @{$result{$set}}, join'+', keys %stored;   
                                }
                        }
                }

                return %result;
        } else {        
                return undef;                                           # No match
        }
}


#
# "implementation independant" fact loader
#
sub load_from_file {
        my $self = shift;
        my $file = shift;
        open INFILE,"<$file"    or die "Can't open $file ($!)";
        while (my $method = <INFILE>) {
                chomp $method;
                eval "\$self->$method";
                die "Load error : $@ line $. ($method)"  if $@;
        }
        close INFILE;
}

sub display {
        if (!$#_) {         
            print "       No match\n";
            return;
        }

        my %x = @_;

        my @var = keys %x;
        my $first = shift @var;
        my $pos;

        for my $sol (@{$x{$first}}) {
                print "       possible  $first = ",$sol;
                for my $var (@var) {
                        print " , $var = ", ${$x{$var}}[$pos];
                }
                print $/;
                $pos++;
        }
}

1;