AI-Prolog
view release on metacpan or search on metacpan
lib/AI/Prolog.pm view on Meta::CPAN
use aliased 'AI::Prolog::Term';
use aliased 'AI::Prolog::Engine';
use Text::Quote;
use Regexp::Common;
# they don't want pretty printed strings if they're using this interface
Engine->formatted(0);
# Until (and unless) we figure out the weird bug that prevents some values
# binding in the external interface, we need to stick with this as the default
Engine->raw_results(1);
sub new {
my ( $class, $program ) = @_;
my $self = bless {
_prog => Parser->consult($program),
_query => undef,
_engine => undef,
} => $class;
lock_keys %$self;
lib/AI/Prolog/Article.pod view on Meta::CPAN
male(tim)
Now let's assume we have a rule that states that someone is a father if they
are a parent and they are male.
father(Person) :-
parent(Person, _),
male(Person).
In the above rule, the underscore is called an "anonymous vairable" and means
"I don't care what this value is." Prolog may still bind the variable
internally (though this behavior is not guaranteed), but its value will not be
taken into account when trying to determine if terms unify.
Taking the first term in the rule, the logic engine might try to unify this
with the first fact in the knowledge base, C<parent(sally, tom)>. C<Person>
unifies with I<sally>. The underscore, C<_>, unifies with I<tom> but since
we stated this unification is unimportant, we can ignore that.
We now have a fact which unifies with the first term in the rule, so we push
this information onto a stack. Since there are still additional facts we can
lib/AI/Prolog/Engine.pm view on Meta::CPAN
_run_called => undef,
_cp => undef,
_retract_clause => undef,
_trace => 0, # whether or not tracing is done
_halt => 0, # will stop the aiprolog shell
_perlpackage => undef,
_step_flag => undef,
} => $class;
lock_keys %$self;
# to add a new primitive, use the binding operator (:=) to assign a unique
# index to the primitive and add the corresponding definition to
# @PRIMITIVES.
eval {
$self->_adding_builtins(1);
$self->{_db} = Parser->consult( <<' END_PROG', $prog );
ne(X, Y) :- not(eq(X,Y)).
if(X,Y,Z) :- once(wprologtest(X,R)) , wprologcase(R,Y,Z).
wprologtest(X,yes) :- call(X). wprologtest(X,no).
wprologcase(yes,X,Y) :- call(X).
wprologcase(no,X,Y) :- call(Y).
lib/AI/Prolog/Engine.pm view on Meta::CPAN
}
}
sub backtrack {
my $self = shift;
_print(" <<== Backtrack: \n") if $self->{_trace};
while ( @{ $self->{_stack} } ) {
my $o = pop @{ $self->{_stack} };
if ( UNIVERSAL::isa( $o, Term ) ) {
$o->unbind;
}
elsif ( UNIVERSAL::isa( $o, ChoicePoint ) ) {
$self->{_goal} = $o->{goal};
# XXX This could be very dangerous if we accidentally try
# to assign a term to itself! See ChoicePoint->next_clause
$self->{_goal}->next_clause( $o->{clause} );
return 1;
}
}
lib/AI/Prolog/Engine/Primitives.pm view on Meta::CPAN
my ( $self, $term, $c ) = @_;
my $rhs = $term->getarg(0)->deref;
my $lhs = $term->getarg(1)->value;
if ( $rhs->is_bound ) {
my $value = $rhs->value;
if ( not looks_like_number($value) ) {
return FAIL;
}
return $value == $lhs;
}
$rhs->bind( Number->new($lhs) );
push @{ $self->{_stack} } => $rhs;
return CONTINUE;
};
$PRIMITIVES[16] = sub { # gt/2
my ( $self, $term ) = @_;
return ( $term->getarg(0)->value > $term->getarg(1)->value )
? CONTINUE
: FAIL;
};
lib/AI/Prolog/KnowledgeBase.pm view on Meta::CPAN
elsif ( !$c->next_clause ) {
delete $self->{ht}{$predicate};
}
else {
$self->{ht}{$predicate} = $c->next_clause;
}
return 1;
}
for ( my $i = @{$stack} - $top; $i > 0; $i-- ) {
my $t = pop @{$stack};
$t->unbind;
}
$cc = $c;
$c = $c->next_clause;
}
return;
}
sub retractall {
my ( $self, $term, $arity ) = @_;
my $predicate = $term->predicate;
lib/AI/Prolog/Term.pm view on Meta::CPAN
if ( $self->{trace} ) {
print "$msg\n";
}
}
sub dup {
my $self = shift;
$self->new( $self->{functor}, $self->{arity} );
}
# bind a variable to a term
sub bind {
my ( $self, $term ) = @_;
return if $self eq $term;
unless ( $self->{bound} ) {
$self->{bound} = 1;
$self->{deref} = 1;
$self->{ref} = $term;
}
else {
croak( "AI::Prolog::Term->bind("
. $self->to_string
. "). Cannot bind to nonvar!" );
}
}
# unbinds a term -- i.e., resets it to a variable
sub unbind {
my $self = shift;
$self->{bound} = 0;
$self->{ref} = undef;
# XXX Now possible for a bind to have had no effect so ignore safety test
# XXX if (bound) bound = false;
# XXX else IO.error("Term.unbind","Can't unbind var!");
}
# set specific arguments. A primitive way of constructing terms is to
# create them with Term(s,f) and then build up the arguments. Using the
# parser is much simpler
sub setarg {
my ( $self, $pos, $val ) = @_;
if ( $self->{bound} && !$self->{deref} ) {
$self->{args}[$pos] = $val;
}
lib/AI/Prolog/Term.pm view on Meta::CPAN
}
} # at least one arg not bound ...
if ( $self->{bound} ) {
# added missing occurcheck
if ( $self->occurcheck ) {
if ( $self->occurs( $term->varid ) ) {
return;
}
}
$term->bind($self);
push @{$stack} => $term; # side-effect -- setting stack vars
return 1;
}
# do occurcheck if turned on
return if $self->occurcheck && $term->occurs( $self->varid );
$self->bind($term);
push @{$stack} => $self; # save for backtracking
return 1;
}
# refresh creates new variables. If the variables already exist
# in its arguments then they are used. This is used when parsing
# a clause so that variables throughout the clause are shared.
# Includes a copy operation.
sub refresh {
lib/AI/Prolog/Term.pm view on Meta::CPAN
# @results is the full results, if we ever need it
my @results = $self->_to_data($self);
return AsObject->new( $self->{_results} ), \@results;
}
sub _to_data {
my ( $self, $parent ) = @_;
if ( defined $self->{varname} ) {
# XXX here's where the [HEAD|TAIL] bug is. The engine works fine,
# but we can't bind TAIL to a result object and are forced to
# switch to raw_results.
my $varname = delete $self->{varname};
( $parent->{_results}{$varname} ) = $self->_to_data($parent);
$self->{varname} = $varname;
}
if ( $self->{bound} ) {
my $functor = $self->functor;
my $arity = $self->arity;
return $self->ref->_to_data($parent) if $self->{deref};
return [] if NULL eq $functor && !$arity;
lib/AI/Prolog/Term.pm view on Meta::CPAN
my $query = Term->new("steals(Somebody, Something).");
=head1 DESCRIPTION
See L<AI::Prolog|AI::Prolog> for more information. If you must know more,
there are plenty of comments sprinkled through the code.
=head1 BUGS
A query using C<[HEAD|TAIL]> syntax does not bind properly with the C<TAIL>
variable when returning a result object. This bug can be found in the
C<_to_data> method of this class.
=head1 SEE ALSO
W-Prolog: L<http://goanna.cs.rmit.edu.au/~winikoff/wp/>
Michael BartE<225>k's online guide to programming Prolog:
L<http://kti.ms.mff.cuni.cz/~bartak/prolog/index.html>
my $prolog = Prolog->new(<<'END_PROLOG');
value(rubies, 100).
value(paper, 1).
thief(badguy).
steals(PERP, STUFF) :-
value(STUFF, DOLLARS),
gt(DOLLARS, 50).
END_PROLOG
$prolog->query('is(X,7)');
is $prolog->results, 'is(7, 7)', 'is/2 should be able to bind a term to a var';
$prolog->query('is(X,-7)');
is $prolog->results, 'is(-7, -7)', '... and it should handle negative numbers';
$prolog->query('is(X,.7)');
is $prolog->results, 'is(.7, .7)', '... and number which begin with decimal points';
$prolog->query('is(X,-.7)');
is $prolog->results, 'is(-.7, -.7)', '... and negative numbers with decimal points';
( run in 2.498 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )