AI-Prolog
view release on metacpan or search on metacpan
writeln/1
Added ** operator (pow/1) to math preprocessor. Leaving it out
earlier was an oversight.
0.71 Sat June 25, 2005
Removed _failgoal in Engine.pm. We now backtrack if we need
new results.
Added several new regression tests.
Fixed bug where code was not warning on unknown predicates.
(Doug Wilson)
Fixed bug where tracing fails when it tries to print a non-
existent "next_clause". (Doug Wilson)
retract/1 now works correctly. (Doug Wilson)
Fixed unification bug that crept in in .62.
Added data/sleepy.pro, a game that wasn't working because of
the retract/1 bug.
0.7 Mon June 20, 2005 (Happy Birthday to me)
Parsing errors now attempt to report the line number of the
error.
Added new predicates:
Eliminated studlyCaps methods.
Added trace. and notrace.
Added a TODO test for a failing regression test.
0.62 Fri Feb 25, 2005
Added code to avoid bug in some Perl's where "undef" looks
like a number.
Major performance improvement. Now runs about 40% faster.
Added
listing.
println(X).
is(X,Y).
plus(X,Y).
minus(X,Y).
mult(X,Y).
div(X,Y).
mod(X,Y).
ge(X,Y).
gt(X,Y).
le(X,Y).
lt(X,Y).
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
use ExtUtils::MakeMaker qw/WriteMakefile prompt/;
my ( @program, @extra_modules );
print <<"END_NOTE";
The 'aiprolog' shell is optional. If you choose to install it, Term::ReadLine
and Term::ReadKey will be added to your list of prerequisites.
END_NOTE
if (prompt( "Do you wish to install the 'aiprolog' shell?", "y" ) =~ /^[Yy]/ )
{
@program = ( EXE_FILES => ["bin/aiprolog"] );
@extra_modules = (
bin/aiprolog view on Meta::CPAN
my $file = shift;
my $program = '';
if ($file) {
open FH, "< $file" or die "Could not open ($file) for reading: $!";
$program = do { local $/; <FH> };
}
my $prolog = Prolog->new($program);
my $version = Prolog->VERSION;
print $OUT <<"END_WELCOME";
Welcome to AI::Prolog v $version
Copyright (c) 2005-2006, Curtis "Ovid" Poe.
AI::Prolog comes with ABSOLUTELY NO WARRANTY. This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
Type 'help.' for for a list of built-ins or 'help("\$builtin").' for help on a
specific built-in.
END_WELCOME
my $COMMAND = qr/^%\s*/;
my $RESULTS = 0;
my $MORE = 1;
while ($prolog->continue) {
my $query = $term->readline("?- ");
chomp $query;
next unless $query;
$term->addhistory($query);
print $OUT "\n";
if ( $query =~ /^\s*\?/ ) {
help();
next;
}
elsif ( $query =~ $COMMAND ) {
last if $query =~ /$COMMAND?(?:halt|quit|exit|stop)/i;
if ($query =~ /$COMMAND(?:help)/i) {
help();
}
bin/aiprolog view on Meta::CPAN
while ($MORE && user_wants_more()) {
show_results($prolog);
}
}
sub show_results {
return unless $RESULTS;
my ($prolog) = @_;
my $results = $prolog->results;
$results ||= ''; # otherwise it's an arrayref
print $OUT $results, " ";
unless ($results) {
print $OUT "No\n";
$RESULTS = 0;
}
}
sub user_wants_more {
return unless $RESULTS;
ReadMode 'cbreak';
my $key = ReadKey(0);
ReadMode 'normal';
if (';' eq $key) {
print $OUT ";\n\n";
return 1;
}
print $OUT "\n\nYes\n" if $RESULTS;
return;
}
my $offset;
sub help {
$offset ||= tell DATA;
seek DATA, $offset, 0;
pod2usage({
-verbose => 2,
-input => \*DATA,
data/sleepy.pro view on Meta::CPAN
/* This defines my current location. */
i_am_at(bedroom).
i_am_holding(nothing).
/* These facts describe how the rooms are connected. */
path(bedroom, n, den) :- lit(bedroom).
path(bedroom, n, den) :-
print('You trip over something in the dark.'), nl,
!, fail.
path(den, s, bedroom).
path(bedroom, d, bed).
path(bed, u, bedroom).
% These facts tell where the various objects in the game
% are located.
data/sleepy.pro view on Meta::CPAN
alive(fly).
lit(bedroom).
lit(den).
visible_object('light switch').
/* These rules describe how to pick up an object. */
take(fly) :-
print('It is too fast for you!'), nl,
!, fail.
take('light switch') :-
take(switch).
take(switch) :-
print('It is firmly embedded in the wall!'), nl,
!, fail.
take(X) :-
i_am_holding(X),
print('You are already holding it!'),
nl.
take(X) :-
i_am_at(Place),
at(X, Place),
retract(at(X, Place)),
assert(i_am_holding(X)),
print('OK.'),
nl.
take(_) :-
print('I do not see it here.'),
nl.
/* These rules describe how to put down an object. */
drop(X) :-
i_am_holding(X),
i_am_at(Place),
retract(i_am_holding(X)),
assert(at(X, Place)),
print('OK.'),
nl.
drop(_) :-
print('You are not holding it!'),
nl.
/* These rules define the six direction letters as calls to go/1. */
n :- go(n).
s :- go(s).
e :- go(e).
data/sleepy.pro view on Meta::CPAN
/* This rule tells how to move in a given direction. */
go(Direction) :-
i_am_at(Here),
path(Here, Direction, There),
retract(i_am_at(Here)),
assert(i_am_at(There)),
look.
go(_) :-
print('You can not go that way.'), nl.
/* This rule tells how to look about you. */
look :-
i_am_at(Place),
describe(Place),
nl,
notice_objects_at(Place),
nl.
/* These rules set up a loop to mention all the objects in your vicinity. */
notice_objects_at(Place) :-
lit(Place),
at(X, Place),
visible_object(X),
print('There is a '), print(X), print(' here.'), nl,
fail.
notice_objects_at(_).
/* These rules are specific to this particular game. */
use(flyswatter) :-
swat(fly).
use(bed) :-
i_am_at(bedroom),
d.
use(bed) :-
print('It is in the bedroom!'), nl,
!, fail.
use(switch) :-
i_am_at(Place),
lit(Place),
off.
use(switch) :-
on.
on :-
i_am_at(bed),
print('You can not reach the light switch from here.'), nl,
!, fail.
on :-
i_am_at(Place),
lit(Place),
print('The lights are already on.'), nl.
on :-
i_am_at(Place),
assert(lit(Place)),
print('The room lights come on.'), nl,
optional_buzz_off,
look.
off :-
i_am_at(bed),
print('You can not reach the light switch from here.'), nl,
!, fail.
off :-
i_am_at(Place),
retract(lit(Place)),
optional_buzz_off,
print('It is now dark in here.'), nl.
off :-
print('The lights are already off.'), nl.
sleep :-
not(i_am_at(bed)),
print('You find it hard to sleep standing up.'), nl,
!, fail.
sleep :-
lit(bedroom),
print('You can not get to sleep with the light on.'), nl,
!, fail.
sleep :-
lit(den),
print('The light from the den is keeping you awake.'), nl,
!, fail.
sleep :-
or(i_am_holding(flyswatter), at(flyswatter, bed)),
print('What? Sleep with a dirty old flyswatter?'), nl,
!, fail.
sleep :-
alive(fly),
print('As soon as you start to doze off, a fly lands'), nl,
print('on your face and wakes you up again.'), nl,
make_visible(fly),
make_visible(flyswatter),
!, fail.
sleep :-
print('Ahhh...you (yawn) made...it...zzzzzzzz.'), nl, nl,
finish.
swat(fly) :-
swat.
swat :-
i_am_at(Place),
not(lit(Place)),
print('You flail aimlessly in the dark!'), nl.
swat :-
not(i_am_holding(flyswatter)),
print('You are not holding the flyswatter.'), nl,
!, fail.
swat :-
not(alive(fly)),
print('He is dead, Jim.'), nl.
swat :-
i_am_at(Place),
not(at(fly, Place)),
print('You swish the flyswatter through the air.'), nl.
/* Have flyswatter, room is lit, fly is here and alive. */
swat :-
buzz_off,
print('The fly escapes into the other room.'), nl.
swat :-
print('Success! You killed that pesky fly!'), nl,
retract(alive(fly)).
swat :- /* For debugging... */
print('You must have forgotten a case!', nl).
make_visible(X) :-
visible_object(X).
make_visible(X) :-
assert(visible_object(X)).
buzz_off :-
at(fly, bedroom),
lit(den),
data/sleepy.pro view on Meta::CPAN
optional_buzz_off.
/* Under UNIX, the "halt." command quits Prolog but does not
remove the output window. On a PC, however, the window
disappears before the final output can be seen. Hence this
routine requests the user to perform the final "halt." */
finish :-
nl,
print('The game is over. Please enter the "halt." command.'),
nl.
/* This rule just prints out game instructions. */
instructions :-
nl,
print('Enter commands using standard Prolog syntax.'), nl,
print('Available commands are:'), nl,
print('start. -- to start the game.'), nl,
print('n. s. e. w. u. d. -- to go in that direction.'), nl,
print('take(Object). -- to pick up an object.'), nl,
print('drop(Object). -- to put down an object.'), nl,
print('use(Object). -- to manipulate an object.'), nl,
print('look. -- to look around you again.'), nl,
print('on. off. -- to control the room lights.'), nl,
print('sleep. -- to try to go to sleep.'), nl,
print('instructions. -- to see this message again.'), nl,
print('halt. -- to end the game and quit.'), nl,
nl.
/* This rule prints out instructions and tells where you are. */
start :-
instructions,
look.
/* These rules describe the various rooms. Depending on
circumstances, a room may have more than one description. */
describe(bedroom) :-
lit(bedroom),
print('You are in a bedroom with a large, comfortable bed.'), nl,
print('It has been a long, tiresome day, and you would like'), nl,
print('nothing better than to go to sleep.'), nl.
describe(bedroom) :-
print('You are in your bedroom. It is nice and dark.'), nl.
describe(bed) :-
print('You are in bed, and it feels great!'), nl.
describe(den) :-
lit(den),
print('You are in your den. There is a lot of stuff here,'), nl,
print('but you are too sleepy to care about most of it.'), nl.
describe(den) :-
print('You are in your den. It is dark.'), nl.
/* This is a special form, to call predicates during load time. */
% :- retractall(i_am_holding(_)), start.
data/spider.pro view on Meta::CPAN
path(spider, d, cave).
path(cave, u, spider).
path(cave, w, cave_entrance).
path(cave_entrance, e, cave).
path(cave_entrance, s, meadow).
path(meadow, n, cave_entrance) :- at(flashlight, in_hand).
path(meadow, n, cave_entrance) :-
print('Go into that dark cave without a light? Are you crazy?'), nl,
fail.
path(meadow, s, building).
path(building, n, meadow).
path(building, w, cage).
path(cage, e, building).
path(closet, w, building).
path(building, e, closet) :- at(key, in_hand).
path(building, e, closet) :-
print('The door appears to be locked.'), nl,
fail.
% These facts tell where the various objects in the game are located.
at(ruby, spider).
at(key, cave_entrance).
at(flashlight, building).
at(sword, closet).
% This fact specifies that the spider is alive.
alive(spider).
% These rules describe how to pick up an object.
take(X) :-
at(X, in_hand),
print('You are already holding it!'),
nl.
take(X) :-
i_am_at(Place),
at(X, Place),
retract(at(X, Place)),
assert(at(X, in_hand)),
print('OK.'),
nl.
take(_) :-
print('I do not see it here.'),
nl.
% These rules describe how to put down an object.
drop(X) :-
at(X, in_hand),
i_am_at(Place),
retract(at(X, in_hand)),
assert(at(X, Place)),
print('OK.'),
nl.
drop(_) :-
print('You are not holding it!'),
nl.
% These rules define the six direction letters as calls to go.
n :- go(n).
s :- go(s).
e :- go(e).
data/spider.pro view on Meta::CPAN
% This rule tells how to move in a given direction.
go(Direction) :-
i_am_at(Here),
path(Here, Direction, There),
retract(i_am_at(Here)),
assert(i_am_at(There)),
look.
go(_) :-
print('You cannot go that way.').
% This rule tells how to look about you.
look :-
i_am_at(Place),
describe(Place),
nl,
notice_objects_at(Place),
nl.
% These rules set up a loop to mention all the objects in your vicinity.
notice_objects_at(Place) :-
at(X, Place),
print('There is a '), print(X), print(' here.'), nl,
fail.
notice_objects_at(_).
% These rules tell how to handle killing the lion and the spider.
kill :-
i_am_at(cage),
print('Oh, bad idea! You have just been eaten by a lion.'), nl,
die.
kill :-
i_am_at(cave),
print('This is not working. The spider leg is about as tough'), nl,
print('as a telephone pole, too.'), nl.
kill :-
i_am_at(spider),
at(sword, in_hand),
retract(alive(spider)),
print('You hack repeatedly at the back of the spider. Slimy ichor'), nl,
print('gushes out of the back of the spider, and gets all over you.'), nl,
print('I think you have killed it, despite the continued twitching.'),
nl.
kill :-
i_am_at(spider),
print('Beating on the back of the spider with your fists has no'), nl,
print('effect. This is probably just as well.'), nl.
kill :-
print('I see nothing inimical here.'), nl.
% This rule tells how to die.
die :-
finish.
finish :-
nl,
print('Game over.'),
nl.
% This rule just prints out game instructions.
help :-
instructions.
instructions :-
nl,
print('Enter commands using standard Prolog syntax.'), nl,
print('Available commands are:'), nl,
print('start. -- to start the game.'), nl,
print('n. s. e. w. u. d. -- to go in that direction.'), nl,
print('take(Object). -- to pick up an object.'), nl,
print('drop(Object). -- to put down an object.'), nl,
print('kill. -- to attack an enemy.'), nl,
print('look. -- to look around you again.'), nl,
print('instructions. -- to see this message again.'), nl,
print('halt. -- to end the game and quit.'), nl,
nl.
% This rule prints out instructions and tells where you are.
start :-
instructions,
look.
% These rules describe the various rooms. Depending on
% circumstances, a room may have more than one description.
describe(meadow) :-
at(ruby, in_hand),
print('Congratulations!! You have recovered the ruby'), nl,
print('and won the game.'), nl,
finish.
describe(meadow) :-
print('You are in a meadow. To the north is the dark mouth'), nl,
print('of a cave; to the south is a small building. Your'), nl,
print('assignment, should you decide to accept it, is to'), nl,
print('recover the famed Bar-Abzad ruby and return it to'), nl,
print('this meadow.'), nl.
describe(building) :-
print('You are in a small building. The exit is to the north.'), nl,
print('There is a barred door to the west, but it seems to be'), nl,
print('unlocked. There is a smaller door to the east.'), nl.
describe(cage) :-
print('You are in a den of the lion! The lion has a lean and'), nl,
print('hungry look. You better get out of here!'), nl.
describe(closet) :-
print('This is nothing but an old storage closet.'), nl.
describe(cave_entrance) :-
print('You are in the mouth of a dank cave. The exit is to'), nl,
print('the south; there is a large, dark, round passage to'), nl,
print('the east.'), nl.
describe(cave) :-
alive(spider),
at(ruby, in_hand),
print('The spider sees you with the ruby and attacks!!!'), nl,
print(' ...it is over in seconds....'), nl,
die.
describe(cave) :-
alive(spider),
print('There is a giant spider here! One hairy leg, about the'), nl,
print('size of a telephone pole, is directly in front of you!'), nl,
print('I would advise you to leave promptly and quietly....'), nl.
describe(cave) :-
print('Yecch! There is a giant spider here, twitching.'), nl.
describe(spider) :-
alive(spider),
print('You are on top of a giant spider, standing in a rough'), nl,
print('mat of coarse hair. The smell is awful.'), nl.
describe(spider) :-
print('Oh, gross! You are on top of a giant dead spider!'), nl.
examples/append.pl view on Meta::CPAN
use Data::Dumper;
$Data::Dumper::Indent = 0;
$Data::Dumper::Terse = 1;
use AI::Prolog 0.64;
my $prolog = AI::Prolog->new(<<"END_PROLOG");
append([], X, X).
append([W|X], Y, [W|Z]) :- append(X, Y, Z).
END_PROLOG
print "Appending two lists 'append([a],[b,c,d],Z).'\n";
$prolog->query('append([a],[b,c,d],Z).');
while (my $result = $prolog->results) {
print Dumper($result),"\n";
}
print "\nWhich lists appends to a known list to form another known list?\n'append(X,[b,c,d],[a,b,c,d]).'\n";
$prolog->query('append(X,[b,c,d],[a,b,c,d]).');
while (my $result = $prolog->results) {
print Dumper($result),"\n";
}
print "\nWhich lists can be appended to form a given list?\n'append(X, Y, [foo, bar, 7, baz]).'\n";
my $list = $prolog->list(qw/foo bar 7 baz/);
$prolog->query("append(X,Y,[$list]).");
while (my $result = $prolog->results) {
print Dumper($result),"\n";
}
examples/benchmark.pl view on Meta::CPAN
use warnings;
use lib ('../lib/', 'lib/');
use Benchmark;
use AI::Prolog;
my $prolog = AI::Prolog->new(benchmark());
my $t0 = new Benchmark;
for (1 .. 10) {
$prolog->query('nrev30.');
while (my $result = $prolog->results) {
print $_,' ',@$result,$/;
}
}
my $t1 = new Benchmark;
my $td = timediff($t1, $t0);
print "the code took:",timestr($td),"\n";
sub benchmark {
return <<" END_BENCHMARK";
append([],X,X).
append([X|Xs],Y,[X|Z]) :-
append(Xs,Y,Z).
nrev([],[]).
nrev([X|Xs],Zs) :-
nrev(Xs,Ys),
append(Ys,[X],Zs).
examples/cut.pl view on Meta::CPAN
use aliased 'AI::Prolog::Engine';
my $prolog = Prolog->new(<<'END_PROLOG');
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
Engine->formatted(1);
$prolog->query('append(X,Y,[a,b,c,d]).');
print "Without a cut:\n";
while (my $result = $prolog->results) {
print $result;
}
$prolog = Prolog->new(<<'END_PROLOG');
append([], X, X) :- !. % note the cut operator
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
print "\nWith a cut:\n";
$prolog->query('append(X,Y,[a,b,c,d]).');
while (my $result = $prolog->results) {
print $result;
}
examples/data_structures.pl view on Meta::CPAN
# note that the following line sets an experimental interface option
AI::Prolog->raw_results(0);
my $database = <<'END_PROLOG';
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
my $logic = AI::Prolog->new($database);
$logic->query('append(LIST1,LIST2,[a,b,c,d]).');
while (my $result = $logic->results) {
print Dumper($result->LIST1);
print Dumper($result->LIST2);
}
AI::Prolog::Engine->raw_results(1);
$logic->query('append([X|Y],Z,[a,b,c,d]).');
while (my $result = $logic->results) {
print Dumper($result);
}
# [HEAD|TAIL] syntax is buggy in queries with result object
#AI::Prolog::Engine->raw_results(0);
#$logic->query('append([X|Y],Z,[a,b,c,d]).');
#while (my $result = $logic->results) {
# print Dumper($result->X);
# print Dumper($result->Y);
# print Dumper($result->Z);
#}
AI::Prolog::Engine->raw_results(0);
$logic = AI::Prolog->new(thief_prog());
$logic->query('steals(badguy, GOODS, VICTIM).');
while (my $result = $logic->results) {
printf "badguy steals %s from %s\n"
=> $result->GOODS, $result->VICTIM;
}
AI::Prolog::Engine->raw_results(1);
$logic->query('steals(badguy, GOODS, VICTIM).');
while (my $result = $logic->results) {
print Dumper($result);
}
sub thief_prog {
return <<' END_PROG';
steals(PERP, STUFF, VICTIM) :-
thief(PERP),
valuable(STUFF),
owns(VICTIM,STUFF),
not(knows(PERP,VICTIM)).
thief(badguy).
examples/hanoi.pl view on Meta::CPAN
move(0, _, _, _) :- !.
move(N,A,B,C) :-
M is N - 1,
move(M,A,C,B),
inform(A,B),
move(M,C,B,A).
inform(X,Y) :-
print("Move a disc from the "),
print(X),
print(" pole to the "),
print(Y),
println(" pole").
END_PROLOG
$prolog->do('hanoi(4)');
examples/if_else.pl view on Meta::CPAN
use AI::Prolog;
use Data::Dumper;
$Data::Dumper::Terse = 1;
my $prolog = AI::Prolog->new(<<'END_PROLOG');
thief(badguy).
steals(PERP, X) :-
if(thief(PERP), eq(X,rubies), eq(X,nothing)).
END_PROLOG
$prolog->query("steals(badguy,X).");
print Dumper $prolog->results;
$prolog->query("steals(ovid, X).");
print Dumper $prolog->results;
examples/member.pl view on Meta::CPAN
END_PROLOG
# note: the other stuff in this example is part of a schedule
# demo that I'll be writing after a few more predicates
# are added
AI::Prolog::Engine->formatted(1);
$prolog->query('classroom(X).');
while (my $result = $prolog->results) {
print $result;
}
$prolog->query('teacher(sally).');
while (my $result = $prolog->results) {
print $result;
}
examples/monkey.pl view on Meta::CPAN
state(P1, P1, onfloor, H),
state(P2, P2, onfloor, H)).
perform(walk(P1,P2),
state(P1, BP, onfloor, H),
state(P2, BP, onfloor, H)).
getfood(state(_,_,_,has)).
getfood(S1) :- perform(Act, S1, S2),
nl, print('In '), print(S1), print(' try '), print(Act), nl,
getfood(S2).
END_PROLOG
$prolog->query("getfood(state(atdoor,atwindow,onfloor,hasnot)).");
$prolog->results; # note that everything is done internally.
# there's no need to process the results
examples/path.pl view on Meta::CPAN
my $query = shift || 2;
my $prolog = AI::Prolog->new(path_prog());
$prolog->query('solve( Dest, L).') if $query == 1;
$prolog->query('solve( p(8,8), L).') if $query == 2;
$prolog->query('solve( p(2,2), L).') if $query == 3;
my $t0 = new Benchmark;
#$prolog->trace(1);
my $results = $prolog->results;
print Dumper($results);
my $t1 = new Benchmark;
my $td = timediff($t1, $t0);
print "the code took:",timestr($td),"\n";
sub path_prog {
return <<' END_PROG';
solve(Dest,L) :-
solve(p(1,1), Dest, L).
solve(S, Dest, Sol) :-
path(S, Dest, [S], Path),
invert(Path, Sol).
path( P, P, L, L).
examples/schedule.pl view on Meta::CPAN
#!/usr/bin/perl
# http://xbean.cs.ccu.edu.tw/~dan/PL/PLTests/PLFinal2002.htm
# Write a Prolog program to schedule classes for a department of NG University.
# There are 6 class periods, 6-8pm and 8-10pm on Monday, Wednesday, and Friday
# evenings. There are classrooms A, B, and C, and teachers Jim, Sally, Susan,
# and George. There are classes algebra, geometry, calculus, and analysis, each
# of which has to be taught 2 class periods per week. Jim can only come on
# Mondays. Sally and Susan want to work together. George can only teach the
# 6-8pm periods. Just write the program to print all possible schedules that meet
# these constraints; don?t try to solve the scheduling problem.
use strict;
use warnings;
use lib ('../lib/', 'lib/');
use aliased 'AI::Prolog';
my $prolog = Prolog->new(<<'END_PROLOG');
member(X,[X|Xs]).
examples/schedule.pl view on Meta::CPAN
!, fail.
different([course(_,Time,Room)|T]) :-
member(course(_,Time,Room),T), !, fail.
different([_|T]) :- different(T).
END_PROLOG
use Data::Dumper;
$Data::Dumper::Indent = 0;
AI::Prolog::Engine->raw_results(1);
$prolog->query('scheduler(X)');
print Dumper $prolog->results; # there are more results. We only need the one
examples/trace.pl view on Meta::CPAN
#!/usr/local/bin/perl -l
use strict;
use warnings;
use lib ('../lib/', 'lib/');
use aliased 'AI::Prolog';
AI::Prolog->raw_results(0); # experimental
my $logic = Prolog->new(thief_prog());
print "Without trace ...\n";
$logic->query('steals("Bad guy", STUFF, VICTIM)');
while (my $results = $logic->results) {
printf "Bad guy steals %s from %s\n",
$results->STUFF, $results->VICTIM;
}
print <<"END_MESSAGE";
The following will be a long trace of Prolog tries to satisfy the
above goal.
Hit Enter to begin.
END_MESSAGE
<STDIN>;
$logic->do('trace.');
$logic->query('steals("Bad guy", STUFF, VICTIM)');
while (my $results = $logic->results) {
printf "Bad guy steals %s from %s\n",
$results->STUFF, $results->VICTIM;
}
print <<"END_MESSAGE";
And we'll do it one more time, but this time calling notrace before
the query.
Hit Enter to begin.
END_MESSAGE
<STDIN>;
$logic->do('notrace.');
$logic->query('steals("Bad guy", STUFF, VICTIM)');
while (my $results = $logic->results) {
printf "Bad guy steals %s from %s\n",
$results->STUFF, $results->VICTIM;
}
sub thief_prog {
return <<' END_PROG';
steals(PERP, STUFF, VICTIM) :-
thief(PERP),
valuable(STUFF),
owns(VICTIM,STUFF),
not(knows(PERP,VICTIM)).
lib/AI/Prolog.pm view on Meta::CPAN
use Hash::Util 'lock_keys';
use Exporter::Tidy shortcuts => [qw/Parser Term Engine/];
use aliased 'AI::Prolog::Parser';
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),
lib/AI/Prolog.pm view on Meta::CPAN
my $database = <<'END_PROLOG';
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
my $prolog = AI::Prolog->new($database);
my $list = $prolog->list(qw/a b c d/);
$prolog->query("append(X,Y,[$list]).");
while (my $result = $prolog->results) {
print Dumper $result;
}
=head1 ABSTRACT
AI::Prolog is merely a convenient wrapper for a pure Perl Prolog compiler.
Regrettably, at the current time, this requires you to know Prolog. That will
change in the future.
=head1 EXECUTIVE SUMMARY
lib/AI/Prolog.pm view on Meta::CPAN
To create a query for the database, use C<query>.
$prolog->query("steals(badguy,X).");
=head2 Running a query
Call the C<results> method and inspect the C<results> object:
while (my $result = $prolog->results) {
# $result = [ 'steals', 'badguy', $x ]
print "badguy steals $result->[2]\n";
}
=head1 BUILTINS
See L<AI::Prolog::Builtins|AI::Prolog::Builtins> for the built in predicates.
=head1 CLASS METHODS
=head2 C<new($program)>
lib/AI/Prolog.pm view on Meta::CPAN
This method returns C<$self>.
=head2 C<results>
After a query has been issued, this method will return results satisfying the
query. When no more results are available, this method returns C<undef>.
while (my $result = $prolog->results) {
# [ 'grandfather', $ancestor, 'julie' ]
print "$result->[1] is a grandfather of julie.\n";
}
If C<raw_results> is false, the return value will be a "result" object with
methods corresponding to the variables. This is currently implemented as a
L<Hash::AsObject|Hash::AsObject> so the caveats with that module apply.
Please note that this interface is experimental and may change.
$prolog->query('steals("Bad guy", STUFF, VICTIM)');
while (my $r = $prolog->results) {
print "Bad guy steals %s from %s\n", $r->STUFF, $r->VICTIM;
}
See C<raw_results> for an alternate way of generating output.
=head1 BUGS
See L<AI::Prolog::Builtins|AI::Prolog::Builtins> and
L<AI::Prolog::Engine|AI::Prolog::Engine> for known bugs and limitations. Let
me know if (when) you find them. See the built-ins TODO list before that,
though.
lib/AI/Prolog.pm view on Meta::CPAN
use AI::Prolog;
my $database = AI::Prolog::Parser->consult(<<'END_PROLOG');
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
my $query = AI::Prolog::Term->new("append(X,Y,[a,b,c,d]).");
my $engine = AI::Prolog::Engine->new($query,$database);
while (my $result = $engine->results) {
print "$result\n";
}
=head1 SEE ALSO
L<AI::Prolog::Introduction>
L<AI::Prolog::Builtins>
W-Prolog: L<http://goanna.cs.rmit.edu.au/~winikoff/wp/>
lib/AI/Prolog/Article.pod view on Meta::CPAN
gives(tom, book, alice) ;
gives(alice, ring, bob) ;
gives(tom, book, harry) ;
No
?-
That final "No" is Prolog telling you that there are no more results which
satisfy your goal (query). (If you hit I<Enter> before Prolog prints "No", it
will print "Yes", letting you know that it found results for you. This is
standard behavior in Prolog.)
One thing you might notice is that the last result, C<gives(tom, book, harry)>,
does not match the rule we set up for C<gives/3>. However, we get this result
because we chose to hard-code this fact as the last line of the Prolog program.
=head2 How this works
At this point, it's worth having a bit of a digression to explain how this
works.
lib/AI/Prolog/Article.pod view on Meta::CPAN
Note that the line number for "Unexpected character" is relative to the Prolog
code, not the Perl code.
After the contructor, issue your query:
$prolog->query($some_query);
And do something with the results:
while ( my $results = $prolog->results ) {
print "@$results\n";
}
Results are usually each returned as an array reference with the first argument
being the functor and subsequent arguments being the values. If any value is a
list, it will be represented as an array reference. We'll see more on that
later as we cover lists.
Now let's see the full program:
#!/usr/bin/perl
lib/AI/Prolog/Article.pod view on Meta::CPAN
my $prolog;
# If reading from DATA, we need a CHECK block to ensure that
# DATA is available by the time the constructor is called
CHECK {
$prolog = AI::Prolog->new( do { local $/; <DATA> } );
}
$prolog->query( 'father(WHO).' );
while ( my $results = $prolog->results ) {
print "@$results\n";
}
__DATA__
parent(sally, tom).
parent(bill, tom).
parent(tom, sue).
parent(alice, sue).
parent(sarah, tim).
male(bill).
male(tom).
male(tim).
father(Person) :-
parent(Person, _),
male(Person).
If you run this program, it will quite happily print out "father bill" and
"father tom." In fact, if you really want to see what's going on internally,
after you issue the query you can "trace" the execution:
$prolog->query('father(Who)');
$prolog->trace(1); # after the query, before the results
while ( my $result = $prolog->results ) {
...
Running the program again produces a lot of output, the beginning of which
matches our description of how logic programming works internally:
lib/AI/Prolog/Article.pod view on Meta::CPAN
append([], X, X).
append([W|X], Y, [W|Z]) :- append(X, Y, Z).
END_PROLOG
my $list = $prolog->list( qw/1 2 3 4 5/ );
$prolog->query("append(X,Y,[$list]).");
while ( my $results = $prolog->results ) {
my ( $x, $y, $z ) = @{ $results }[ 1, 2, 3 ];
$" = ', '; # Array separator
print "[@$x], [@$y], [@$z]\n";
}
As you can see, Prolog lists will be returned to Perl as array references.
C<< $results->[0] >> is the name of the predicate, C<append>, and the next three
elements are the successive values generated by Prolog.
=head1 Problems with Prolog
This article wouldn't be complete without listing some of the issues that have
hampered Prolog.
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
Succeeds as a goal if either C<X> or C<Y> succeeds.
=item plus/2
Succeeds if both terms are bound. The value of the term is X + Y.
Use with C<is(X,Y)>.
is(X, plus(N,1)).
=item print/1
Prints the current Term. If the term is an unbound variable, it will print the
an underscore followed by the internal variable number (e.g., "_284").
print(ovid). % prints "ovid"
print("Something"). % prints "Something"
print(Something). % prints whatever variable Something is bound to
=item println/1
Same as C<print(Term)>, but automatically prints a newline at the end.
=item pow/2
Succeeds if both terms are bound. The value of the term is X ** Y
(X raised to the Y power).
Use with C<is(X,Y)>.
=item retract/1
Remove facts from the database. You cannot remove rules. This may change in
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
=item true/0
True goal. Automatically succeeds.
=item var/1
Succeeds if X is an unbound variable. Otherwise, this goal fails.
=item write/1
Prints the current Term. If the term is an unbound variable, it will print the
an underscore followed by the internal variable number (e.g., "_284").
write(ovid). % prints "ovid"
write("Something"). % prints "Something"
write(Something). % prints whatever variable Something is bound to
=item writeln/1
Same as C<write(Term)>, but automatically prints a newline at the end.
=back
=head1 LIMITATIONS
These are known limitations that I am not terribly inclined to fix. See the
TODO list for those I am inclined to fix.
IF -> THEN; ELSE not allowed.
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
Chaining terms with a semicolon for "or" does not work. Use C<or/2> instead.
=head1 TODO
There are many things on this list. The core functionality is there, but I do
want you to be aware of what's coming.
=over 4
=item Improve printing.
There are some bugs with printing and escaping characters. Maybe I'll look
into them :)
=item More builtins.
Currently, we only have a tiny subset of builtins available. More are coming.
=back
=head1 MATH
lib/AI/Prolog/Engine.pm view on Meta::CPAN
% See AI::Prolog::Engine::Builtins to see the code for these
! := 1.
call(X) := 2.
fail := 3.
consult(X) := 4.
assert(X) := 5.
retract(X) := 7.
retract(X) :- retract(X).
listing := 8.
listing(X) := 9.
print(X) := 10.
write(X) := 10.
println(X) := 11.
writeln(X) := 11.
nl := 12.
trace := 13.
notrace := 13.
is(X,Y) := 15.
gt(X,Y) := 16.
lt(X,Y) := 17.
ge(X,Y) := 19.
le(X,Y) := 20.
halt := 22.
lib/AI/Prolog/Engine.pm view on Meta::CPAN
}
sub _stack { shift->{_stack} }
sub _db { shift->{_db} }
sub _goal { shift->{_goal} }
sub _call { shift->{_call} }
sub dump_goal {
my ($self) = @_;
if ( $self->{_goal} ) {
_print( "\n= Goals: " . $self->{_goal}->to_string );
_print(
"\n==> Try: " . $self->{_goal}->next_clause->to_string . "\n" )
if $self->{_goal}->next_clause;
}
else {
_print("\n= Goals: null\n");
}
}
sub results {
my $self = shift;
if ( $self->{_run_called} ) {
return unless $self->backtrack;
}
else {
$self->{_run_called} = 1;
lib/AI/Prolog/Engine.pm view on Meta::CPAN
}
}
else { # unify failed. Must backtrack
return unless $self->backtrack;
}
}
}
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;
}
}
return;
}
sub _print { # convenient testing hook
print @_;
}
sub _warn { # convenient testing hook
warn @_;
}
use constant RETURN => 2;
sub do_primitive { # returns false if fails
my ( $self, $term, $c ) = @_;
my $primitive = AI::Prolog::Engine::Primitives->find( $c->ID )
or die sprintf "Cannot find primitive for %s (ID: %d)\n",
$term->to_string, $c->ID;
return unless my $result = $primitive->( $self, $term, $c );
return 1 if RETURN == $result;
$self->{_goal} = $self->{_goal}->next;
if ( $self->{_goal} ) {
$self->{_goal}->resolve( $self->{_db} );
}
return 1;
}
lib/AI/Prolog/Engine.pm view on Meta::CPAN
__END__
=head1 NAME
AI::Prolog::Engine - Run queries against a Prolog database.
=head1 SYNOPSIS
my $engine = AI::Prolog::Engine->new($query, $database).
while (my $results = $engine->results) {
print "$result\n";
}
=head1 DESCRIPTION
C<AI::Prolog::Engine> is a Prolog engine implemented in Perl.
The C<new()> function actually bootstraps some Prolog code onto your program to
give you access to the built in predicates listed in the
L<AI::Prolog::Builtins|AI::Prolog::Builtins> documentation.
lib/AI/Prolog/Engine.pm view on Meta::CPAN
This creates a new Prolog engine. The first argument must be of type
C<AI::Prolog::Term> and the second must be a database created by
C<AI::Prolog::Parser::consult>.
my $database = Parser->consult($some_prolog_program);
my $query = Term->new('steals(badguy, X).');
my $engine = Engine->new($query, $database);
Engine->formatted(1);
while (my $results = $engine->results) {
print $results, $/;
}
The need to have a query at the same time you're instantiating the engine is a
bit of a drawback based upon the original W-Prolog work. I will likely remove
this drawback in the future.
=head2 C<formatted([$boolean])>
The default value of C<formatted> is true. This method, if passed a true
value, will cause C<results> to return a nicely formatted string representing
lib/AI/Prolog/Engine.pm view on Meta::CPAN
B<Note>: if you choose to use the L<AI::Prolog|AI::Prolog> interface instead of
interacting directly with this class, that interface will set C<formatted> to
false. You will have to set it back in your code if you do not wish this
behavior:
use AI::Prolog;
my $logic = AI::Prolog->new($prog_text);
$logic->query($query_text);
AI::Logic::Engine->formatted(1); # if you want formatted to true
while (my $results = $logic->results) {
print "$results\n";
}
=head2 C<raw_results([$boolean])>
The default value of C<raw_results> is false. Setting this property to a true
value automatically sets C<formatted> to false. C<results> will return the raw
data structures generated by questions when this property is true.
Engine->raw_results(1); # turn on raw results
Engine->raw_results(0); # turn off raw results (default)
lib/AI/Prolog/Engine.pm view on Meta::CPAN
=head1 INSTANCE METHODS
=head2 C<results()>
This method will return the results from the last run query, one result at a
time. It will return false when there are no more results. If C<formatted> is
true, it will return a string representation of those results:
while (my $results = $engine->results) {
print "$results\n";
}
If C<formatted> is false, C<$results> will be an object with methods matching
the variables in the query. Call those methods to access the variables:
AI::Prolog::Engine->formatted(0);
$engine->query('steals(badguy, STUFF, VICTIM).');
while (my $r = $engine->results) {
printf "badguy steals %s from %s\n", $r->STUFF, $r->VICTIM;
}
If necessary, you can get access to the full, raw results by setting
C<raw_results> to true. In this mode, the results are returned as an array
reference with the functor as the first element and an additional element for
each term. Lists are represented as array references.
AI::Prolog::Engine->raw_results(1);
$engine->query('steals(badguy, STUFF, VICTIM).');
while (my $r = $engine->results) {
lib/AI/Prolog/Engine.pm view on Meta::CPAN
=head2 C<query($query)>
If you already have an engine object instantiated, call the C<query()> method
for subsequent queries. Internally, when calling C<new()>, the engine
bootstraps a set of Prolog predicates to provide the built ins. However, this
process is slow. Subsequent queries to the same engine with the C<query()>
method can double the speed of your program.
my $engine = Engine->new($query, $database);
while (my $results = $engine->results) {
print $results, $/;
}
$query = Term->new("steals(ovid, X).");
$engine->query($query);
while (my $results = $engine->results) {
print $results, $/;
}
=head1 BUGS
None known.
=head1 AUTHOR
Curtis "Ovid" Poe, E<lt>moc tod oohay ta eop_divo_sitrucE<gt>
lib/AI/Prolog/Engine/Primitives.pm view on Meta::CPAN
return CONTINUE;
};
$PRIMITIVES[9] = sub { # listing/1
my ( $self, $term, $c ) = @_;
my $predicate = $term->getarg(0)->getfunctor;
$self->{_db}->list($predicate);
return CONTINUE;
};
$PRIMITIVES[10] = sub { # print/1
my ( $self, $term, $c ) = @_;
AI::Prolog::Engine::_print( $term->getarg(0)->to_string );
return CONTINUE;
};
$PRIMITIVES[11] = sub { # println/1
my ( $self, $term, $c ) = @_;
AI::Prolog::Engine::_print( $term->getarg(0)->to_string . "\n" );
return CONTINUE;
};
$PRIMITIVES[12] = sub { AI::Prolog::Engine::_print("\n"); CONTINUE }; # nl
$PRIMITIVES[13] = sub { # trace. notrace.
my ( $self, $term ) = @_;
$self->{_trace} = $term->getfunctor eq 'trace';
AI::Prolog::Engine::_print(
'Trace ' . ( $self->{_trace} ? 'ON' : 'OFF' ) );
return CONTINUE;
};
$PRIMITIVES[15] = sub { # is/2
my ( $self, $term, $c ) = @_;
my $rhs = $term->getarg(0)->deref;
my $lhs = $term->getarg(1)->value;
if ( $rhs->is_bound ) {
my $value = $rhs->value;
lib/AI/Prolog/Engine/Primitives.pm view on Meta::CPAN
my $length = length $LONGEST_PREDICATE;
my $columns = 5;
my $format = join ' ' => ("%-${length}s") x $columns;
while (@predicates) {
my @row;
for ( 1 .. $columns ) {
push @row => @predicates
? shift @predicates
: '';
}
$HELP_OUTPUT .= sprintf $format => @row;
$HELP_OUTPUT .= "\n";
}
$HELP_OUTPUT .= "\n";
}
AI::Prolog::Engine::_print($HELP_OUTPUT);
CONTINUE;
};
$PRIMITIVES[32] = sub { # help/1
my ( $self, $term, $c ) = @_;
my $predicate = $term->getarg(0)->to_string;
_load_builtins();
if ( my $description = $DESCRIPTION_FOR{$predicate} ) {
AI::Prolog::Engine::_print($description);
}
else {
AI::Prolog::Engine::_print("No help available for ($predicate)\n\n");
$PRIMITIVES[31]->();
}
CONTINUE;
};
my $gensym_int = 0;
$PRIMITIVES[33] = sub { # gemsym/1
my ( $self, $term, $c ) = @_;
my $t2 = Term->new( 'v' . $gensym_int++, 0 );
return $t2->unify( $term->getarg(0), $self->{_stack} )
lib/AI/Prolog/Introduction.pod view on Meta::CPAN
Translating all of this into C<AI::Prolog> looks like this:
use AI::Prolog;
use Data::Dumper;
my $prolog = AI::Prolog->new(append_prog());
$prolog->raw_results(0) # Disable raw results
$prolog->query("append(X,Y,[a,b,c,d])");
while (my $result = $prolog->results) {
print Dumper($result->X); # array references
print Dumper($result->Y);
}
sub append_prog {
return <<' END_PROLOG';
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
}
=head1 SEE ALSO
lib/AI/Prolog/KnowledgeBase.pm view on Meta::CPAN
my $key = ref $term ? $term->to_string : $term;
return $self->{ht}{$key};
}
sub set {
my ( $self, $term, $value ) = @_;
my $key = ref $term ? $term->to_string : $term;
$self->{ht}{$key} = $value->clean_up;
}
sub _print { print @_ }
sub dump {
my ( $self, $full ) = @_;
my $i = 1;
while ( my ( $key, $value ) = each %{ $self->{ht} } ) {
next if !$full && ( $self->{primitives}{$key} || $value->is_builtin );
if ( $value->isa(Clause) ) {
_print( $i++ . ". $key: \n" );
do {
_print( " " . $value->term->to_string );
if ( $value->next ) {
_print( " :- " . $value->next->to_string );
}
_print(".\n");
$value = $value->next_clause;
} while ($value);
}
else {
_print( $i++ . ". $key = $value\n" );
}
}
_print("\n");
}
sub list {
my ( $self, $predicate ) = @_;
print "\n$predicate: \n";
my $head = $self->{ht}{$predicate}
or warn "Cannot list unknown predicate ($predicate)";
while ($head) {
print " " . $head->term->to_string;
if ( $head->next ) {
print " :- " . $head->next->to_string;
}
print ".\n";
$head = $head->next_clause;
}
}
1;
__END__
=head1 NAME
lib/AI/Prolog/Parser.pm view on Meta::CPAN
sub advance_linenum {
my $self = shift;
$LINENUM++;
}
# Move a character forward
sub advance {
my $self = shift;
# print $self->current; # XXX
$self->{_posn}++ unless $self->{_posn} >= length $self->{_str};
$self->advance_linenum if $self->current =~ /[\r\n]/;
}
# all three get methods must be called before advance
# recognize a name (sequence of alphanumerics)
# XXX the java methods do not directly translate, so
# we need to revisit this if it breaks
# XXX Update: There was a subtle bug. I think
# I've nailed it, though. The string index was off by one
lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN
== eq
\= ne
}
);
sub process {
my ( $class, $prolog ) = @_;
while ( $prolog =~ $expression ) {
my ( $old_expression, $lhs, $comp, $rhs ) = ( $1, $2, $3, $4 );
my $new_rhs = $class->_parse( $class->_lex($rhs) );
my $new_expression = sprintf
"%s(%s, %s)" => $convert{$comp},
$lhs, $new_rhs;
$prolog =~ s/\Q$old_expression\E/$new_expression/g;
}
return $prolog;
}
sub _lex {
my ( $class, $rhs ) = @_;
my $lexer = _lexer($rhs);
lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN
sub _parse_group {
my ( $class, $tokens ) = @_;
foreach my $op_re ( qr{(?:\*\*|[*/])}, qr{[+-]}, qr/\%/ ) {
for my $i ( 0 .. $#$tokens ) {
my $token = $tokens->[$i];
if ( ref $token && "@$token" =~ /OP ($op_re)/ ) {
my $curr_op = $1;
my $prev = _prev_token( $tokens, $i );
my $next = _next_token( $tokens, $i );
$tokens->[$i] = sprintf
"%s(%s, %s)" => $convert{$curr_op},
_as_string( $tokens->[$prev] ),
_as_string( $tokens->[$next] );
undef $tokens->[$prev];
undef $tokens->[$next];
}
}
@$tokens = grep $_ => @$tokens;
}
lib/AI/Prolog/Term.pm view on Meta::CPAN
# which resulted in lower performance.
my $OCCURCHECK = 0;
sub occurcheck {
my ( $class, $value ) = @_;
$OCCURCHECK = $value if defined $value;
return $OCCURCHECK;
}
# controls printing of lists as [a,b]
# instead of cons(a, cons(b, null))
sub prettyprint {1}
my $CUT = Cut->new(0);
sub CUT {$CUT}
sub new {
my $proto = shift;
my $class = CORE::ref $proto || $proto; # yes, I know what I'm doing
return $class->_new_var unless @_;
if ( 2 == @_ ) { # more common (performance)
return _new_from_functor_and_arity( $class, @_ )
lib/AI/Prolog/Term.pm view on Meta::CPAN
}
sub _new_from_string {
my ( $class, $string ) = @_;
my $parsed = Parser->new($string)->_term($class);
}
sub _new_var {
my $class = shift;
#print "*** _new_var @{[$VARNUM+1]}";
my $self = bless {
functor => undef,
arity => 0,
args => [],
# if bound is false, $self is a reference to a free variable
bound => 0,
varid => $VARNUM++,
# if bound and deref are both true, $self is a reference to a ref
lib/AI/Prolog/Term.pm view on Meta::CPAN
#source => "_new_var",
} => $class;
lock_keys %$self;
return $self;
}
sub _new_with_id {
my ( $class, $id ) = @_;
#print "*** _new_with_id: $id";
my $self = bless {
functor => undef,
arity => 0,
args => [],
# if bound is false, $self is a reference to a free variable
bound => 0,
varid => $id,
# if bound and deref are both true, $self is a reference to a ref
lib/AI/Prolog/Term.pm view on Meta::CPAN
_results => undef,
#source => "_new_with_id: $id",
} => $class;
lock_keys %$self;
return $self;
}
sub _new_from_functor_and_arity {
my ( $class, $functor, $arity ) = @_;
my $print_functor = defined $functor ? $functor : 'null';
confess "undefined arity" unless defined $arity;
#print "*** _new_from_functor_and_arity: ($print_functor) ($arity)";
my $self = bless {
functor => $functor,
arity => $arity,
args => [],
# if bound is false, $self is a reference to a free variable
bound => 1,
varid => 0, # XXX ??
# if bound and deref are both true, $self is a reference to a ref
deref => 0,
ref => undef,
varname => undef,
ID => undef,
_results => undef,
#source => "_new_from_functor_and_arity: ($print_functor) ($arity)",
} => $class;
lock_keys %$self;
return $self;
}
sub varnum {$VARNUM} # class method
sub functor { shift->{functor} }
sub arity { shift->{arity} }
sub args { shift->{args} }
sub varid { shift->{varid} }
sub ref { shift->{ref} }
sub predicate { sprintf "%s/%d" => $_[0]->getfunctor, $_[0]->getarity }
sub deref {
my $self = shift;
while ( $self->{bound} && $self->{deref} ) {
$self = $self->{ref};
}
return $self;
}
sub bound {
lib/AI/Prolog/Term.pm view on Meta::CPAN
$self = $self->{ref};
}
return $self->{bound};
}
sub is_bound { shift->bound }
sub traceln {
my ( $self, $msg ) = @_;
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 {
lib/AI/Prolog/Term.pm view on Meta::CPAN
else {
return $self->varid == $var;
}
}
# used internally for debugging
sub _dumpit {
local $^W;
my $self = shift;
my $indent = shift || '';
print( $indent . "source: ", $self->{source} );
print( $indent . "bound: ", ( $self->{bound} ? 'true' : 'false' ) );
print( $indent . "functor: ", ( $self->{functor} || 'null' ) );
if ( !$self->{ref} ) {
print( $indent . "ref: null" );
}
else {
print( "\n$indent" . "ref:" );
$self->{ref}->_dumpit( $indent . ' ' );
}
print( $indent . "arity: ", $self->{arity} );
if ( defined $self->{args}[0] ) {
print( $indent. "args:" );
foreach ( @{ $self->{args} } ) {
$_->_dumpit( $indent . " " );
}
}
else {
print( $indent. "args: null" );
}
#print($indent . "args: ", scalar @{$self->{args}}) if defined $self->{args}[0];
print( $indent . "deref: ", ( $self->{deref} ? 'true' : 'false' ) );
print( $indent . "varid: ", $self->{varid}, "\n" );
}
# Unification is the basic primitive operation in logic programming.
# $stack: the stack is used to store the address of variables which
# are bound by the unification. This is needed when backtracking.
sub unify {
my ( $self, $term, $stack ) = @_;
#_dumpit($self);
lib/AI/Prolog/Term.pm view on Meta::CPAN
require Data::Dumper;
my $self = shift;
return $self->_to_string(@_);
}
sub _to_string {
my ( $self, $extended ) = @_;
if ( $self->{bound} ) {
my $functor = $self->functor;
my $arity = $self->arity;
my $prettyprint = $self->prettyprint;
return $self->ref->_to_string($extended) if $self->{deref};
return "[]" if NULL eq $functor && !$arity && $prettyprint;
my $string;
if ( "cons" eq $functor && 2 == $arity && $prettyprint ) {
$string = "[" . $self->{args}[0]->_to_string;
my $term = $self->{args}[1];
while ( "cons" eq $term->getfunctor && 2 == $term->getarity ) {
$string .= "," . $term->getarg(0)->_to_string;
$term = $term->getarg(1);
}
$string .=
( NULL eq $term->getfunctor && !$term->getarity )
lib/AI/Prolog/TermList/Clause.pm view on Meta::CPAN
my $class = shift;
return $class->SUPER::new(@_);
}
sub to_string {
my $self = shift;
my ( $term, $next ) = ( $self->term, $self->next );
foreach ( $term, $next ) {
$_ = $_ ? $_->to_string : "null";
}
return sprintf "%s :- %s" => $term, $next;
}
sub is_builtin {
my $self = shift;
if (@_) {
$self->{is_builtin} = shift;
return $self;
}
return $self->{is_builtin};
}
t/50engine.t view on Meta::CPAN
listing/0
listing/1
lt/2
ne/2
nl/0
not/1
notrace/0
once/1
or/2
perlcall2/2
print/1
println/1
retract/1
trace/0
true/0
var/1
wprologcase/3
wprologtest/2
write/1
writeln/1
};
t/70builtins.t view on Meta::CPAN
'if(X,Y,Z) should call Y if X is satisfied';
ok ! $prolog->results, '... and it should only provide correct results';
$prolog->query("steals(ovid,X).");
is $prolog->results, 'steals(ovid, nothing)',
'... and it should call Z if X cannot be satisfied';
ok ! $prolog->results, '... and it should only provide correct results';
my $faux_engine = Test::MockModule->new(Engine);
my @stdout;
$faux_engine->mock(_print => sub { push @stdout => @_ });
$prolog->query("nl.");
$prolog->results;
is_deeply \@stdout, ["\n"], "nl should print a newline";
$prolog->query("not(thief(ovid)).");
is $prolog->results, 'not(thief(ovid))',
'not() should succeed if query cannot be proven';
$prolog->query("not(thief(badguy)).");
ok ! $prolog->results, '... and it should fail if the query can be proven';
$prolog->query("once(valuable(X)).");
is $prolog->results, 'once(valuable(gold))',
t/70builtins.t view on Meta::CPAN
'... regardless of the order they are in';
$prolog->query("or(thief(thug),thief(badguy)).");
is $prolog->results, 'or(thief(thug), thief(badguy))',
'... and it should succeed if both of its goals can succeed';
$prolog->query("or(thief(kudra),thief(ovid)).");
ok ! $prolog->results, '... but it should fail if none of its goals can succeed';
@stdout = ();
$prolog->query("print(badguy).");
$prolog->results;
is_deeply \@stdout, ["badguy"], "print/1 should print what we give it.";
@stdout = ();
$prolog->query("println(badguy).");
$prolog->results;
is_deeply \@stdout, ["badguy\n"],
"println/1 should print what we give it, but with a newline at the end.";
@stdout = ();
$prolog->query("if(steals(ovid,X),print(X),print(false)).");
$prolog->results;
is_deeply \@stdout, ["nothing"], '... even if it is printing a variable';
$prolog->do("assert(loves(ovid,perl)).");
$prolog->query("loves(ovid,X)");
is $prolog->results, "loves(ovid, perl)", 'assert(X) should let us add new facts to the db';
$prolog->do("assert(loves(bob,stuff))");
$prolog->query('loves(bob,Y)');
is $prolog->results, 'loves(bob, stuff)',
'... and we should be able to add more than one fact';
$prolog->query("loves(ovid,X)");
t/70builtins.t view on Meta::CPAN
$prolog->query('test_var(42, Y)');
is $prolog->results, 'test_var(42, not_var)',
'... and var(42) should evaluate to not true';
$prolog->query('test_var(ovid, Y)');
is $prolog->results, 'test_var(ovid, not_var)',
'... and var(ovid) should evaluate to not true';
{
my $faux_kb = Test::MockModule->new(KnowledgeBase);
my @stdout;
$faux_kb->mock(_print => sub { push @stdout => @_ });
$prolog->query('listing.');
$prolog->results;
my $results = join ''=> @stdout;
my $count = ($results =~ s/(\d+\.\s+\w+\/\d+:)//g);
ok $count, 'listing should display a listing of the database';
}
t/80preprocessor_math.t view on Meta::CPAN
my @not_complex_rhs = (
'x',
'_Y',
'3)',
);
foreach my $not_complex_rhs (@not_complex_rhs) {
ok ! $CLASS->_complex_rhs($not_complex_rhs), "$not_complex_rhs should not match : complex rhs";
}
#print $CLASS->expression;
my @complex_group_term = (
'( X )',
'( Y_ )',
'( 3 )',
'( .3 )',
'( 3.0 )',
'( (3) )',
'(( A%2) )',
'( (A % 2 ) )',
'( (17.2 * A % 2 ) )',
( run in 0.918 second using v1.01-cache-2.11-cpan-de7293f3b23 )