AI-Prolog
view release on metacpan or search on metacpan
Revision history for Perl extension AI::Prolog.
0.740 2008-11-12
t/60aiprolog.t fixed number of planned tests (RT#41154).
Fixed dependencies in some tests.
Fixed HEAD|TAIL results bug. Added test (RT#64942).
(Should raw_results(0) be default? or keep backward compat?).
0.740 2008-11-12
t/60aiprolog.t loads modules in the right order now
0.739 2007-05-04
Explicitly import Carp. This fixes a bug exposed by
warnings.pm. Thanks to Andreas Koenig for sending in the failing test.
0.738 2007-05-01
Several test modules are now optional by virtue of a patch by
educated_foo.
0.737 2007-03-21
Removed the Build.PL because CPAN.pm does the wrong thing here
and there's no additional functionality provided by
Module::Build that's being used.
Declared a pre-existing requirement for Hash::Util.
0.736 2007-03-20
Removed the pre-req for ExtUtils::MakeMaker 6.30 because this
doesn't appear to be needed and doesn't have a way to boostrap
that requirement into place anyway.
Also, just upgrade from a "developer" version to prod because
none of this is really all that production quality anyway. Or
rather... this is just as worthy anyway.
0.735_01 2006-07-31
Added perlcall2/2.
TODO: need ground/1 to constrain the 2nd arg to perlcall2/2.
Added Scalar::Util to the pre-reqs. It was already required.
Used Hash::Util::lock_keys to lock down object internals access.
First release by JJORE.
0.734 2006-04-05
Added minimum requirement of ExtUtils::MakeMaker 6.30 due to bug report
filed on RT. Thanks to zby for the catch.
Added a copy of the Perl Review article on logic programming. Thanks to
brian d for and the Perl Review for allowing me to republish this
article.
0.733 2005-10-08
Added POD tests (sort of)
Added strict to AI::Prolog
Converted to Module::Build
0.732 Sat August 6, 2005
Added lib/AI/Prolog/Cookbook.pm to the MANIFEST (whoops)
0.73 Sat August 6, 2005
Added AI::Prolog::Cookbook as an introduction to common problems
encountered when working with Prolog.
TermList->to_string now causes listings to look very similar to
SWI-Prolog. Much easier to read.
Term->to_string now identifies variables by letter, not /_\d+/.
Completed decoupling of AI::Prolog::Parser from the engine.
0.72 Sun July 31, 2005
Move builtins to their own class, AI::Prolog::Engine::Builtins
Non-existent predicates now issue a warning even if trace is off.
Added new predicates:
halt/0 -- currently a no-op outside of the aiprolog shell
help/0 -- list all builtin predicates for which help is available
help/1 -- list help for builtin predicate
write/1
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:
consult/1
listing/1
ne/2
Updated the license information display for aiprolog shell.
Modified listing/0 to not show builtins.
Added math preprocessor. This transforms proper Prolog math
into internal predicates the parser recognizes:
X is N + 1. % is(X, plus(N, 1)).
Pushed all parsing back to the Parser class. No more parsing
in TermList and Term :)
Added anonymous variables: foo(bar, _, baz). I don't have
any efficiency gains from this (yet) because they're just
variables with hidden names, but they work.
Added Test::Exception to the PREREQ_PM (thanks to rjray for
pointing that out).
Updated the docs and examples.
0.65 Wed May 11, 2005
Added Term::ReadLine support to aiprolog shell.
Added Term::ReadKey support to aiprolog shell.
Minor doc corrections.
0.64 Mon May 09, 2005
Change default behavior to AI::Prolog->raw_results(1).
Added quote() method to allow Perl variables to be quoted
and used at Prolog terms.
Added list() method to allow a Perl list to be turned into
a Prolog list.
0.63 Wed May 04, 2005
Allow parser to properly handle positive and negative numbers
and decimal points.
Added pow(X,Y).
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).
Added towers of hanoi and a scheduler to the examples/.
0.61 Mon Feb 21, 2005
Added var(X).
Disabled tracing in the aiprolog shell (whoops!)
0.6 Sun Feb 20, 2005
Added tests for the cut, number, and clause classes.
Added stub tests for step and primitive classes.
Ensured that all classes at least had stub documentation and added
POD tests.
Updated the TODO list in AI::Prolog.
0.5 Sun Feb 13, 2005
Put the database into its own class.
Pulled engine backtracking out into its own method.
Reduced the scope of many of the Engine::_run variables to ensure data
wasn't leaking.
Added simple "aiprolog" shell.
Added cut operator, retract(X), and assert(X).
Added more examples and simple adventure game to both demonstrate the shell
and how Prolog works.
Completely reworked the engine internals to allow new predicates to be
easily added.
* XXX Also screwed up the numbering scheme. Grumble XXX *
0.04 Sun Jan 30, 2005
Added support for quoting terms.
Added Engine->formatted method which allows results to be returned as
either strings or as data structures. The latter is more useful.
When using AI::Prolog, the results() method now returns a "results"
object.
The AI::Prolog interface has been cleaned up and use of the supporting
modules is now officially discouraged.
Massive documentation update.
0.03 Sun Jan 23, 2005
Added tests for built-in predicates.
Added query() function to AI::Logic::Engine to allow successive queries
without a new bootstrap.
0.02 Sun Jan 23, 2005
First public release of AI::Prolog.
0.01 Thu Jan 20 20:47:49 PST 2005
original version; created by make_project 0.1
--- #YAML:1.0
name: AI-Prolog
version: 0.741
abstract: Perl extension for logic programming.
author:
- Curtis "Ovid" Poe
license: unknown
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
ExtUtils::MakeMaker: 0
requires:
aliased: 0.11
Clone: 0.15
Exporter::Tidy: 0.06
Hash::AsObject: 0.05
Hash::Util: 0
Pod::Usage: 1.12
Regexp::Common: 2.119
Scalar::Util: 0
Term::ReadKey: 2.21
Term::ReadLine: 1.01
Text::Balanced: 1.95
Text::Quote: 0.03
no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Makefile.PL view on Meta::CPAN
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 = (
'Term::ReadLine' => 1.01,
'Term::ReadKey' => 2.21,
);
}
WriteMakefile(
'NAME' => 'AI::Prolog',
'VERSION_FROM' => 'lib/AI/Prolog.pm',
@program,
'PREREQ_PM' => {
'aliased' => 0.11,
'Clone' => 0.15,
'Exporter::Tidy' => 0.06,
'Hash::AsObject' => 0.05,
'Pod::Usage' => 1.12,
'Regexp::Common' => 2.119,
'Text::Balanced' => 1.95,
'Text::Quote' => 0.03,
'Scalar::Util' => 0,
'Hash::Util' => 0,
@extra_modules
},
( $] >= 5.005
? ( ABSTRACT_FROM => 'lib/AI/Prolog.pm',
AUTHOR => 'Curtis "Ovid" Poe'
)
: ()
),
);
AI::Prolog version 0.02
=====================
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
This module requires these other modules and libraries:
aliased
Clone
Exporter::Tidy
Test::Differences
Test::MockModule
COPYRIGHT AND LICENCE
Copyright (C) 2005 Curtis "Ovid" Poe
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
bin/aiprolog view on Meta::CPAN
#!/usr/local/bin/perl
eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
if 0; # not running under some shell
use warnings;
use strict;
use Term::ReadLine;
use Term::ReadKey;
use Pod::Usage 1.12;
use aliased 'AI::Prolog';
AI::Prolog::Engine->formatted(1);
# '$Id: aiprolog,v 1.7 2005/08/06 23:28:40 ovid Exp $';
my $term = Term::ReadLine->new('AI::Prolog');
my $OUT = $term->OUT || \*STDOUT;
use Carp;
$SIG{__DIE__} = \&Carp::confess;
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.
bin/aiprolog view on Meta::CPAN
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();
}
elsif ($query =~ /${COMMAND}more/i) {
$MORE = 1;
}
elsif ($query =~ /${COMMAND}no\s*more/i) {
$MORE = 0;
}
next;
}
eval {$prolog->query($query)};
if ($@) {
warn $@;
next;
}
$RESULTS = 1;
show_results($prolog);
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,
-exitval => 'NOEXIT',
});
}
__DATA__
=head1 NAME
aiprolog -- A simple Prolog shell using AI::Prolog.
=head1 SYNOPSIS
usage: aiprolog <optional prolog program name>
=head1 DESCRIPTION
C<aiprolog> is a simple prolog shell using L<AI::Prolog> as the backend.
See the documentation for more detail on the Prolog features that L<AI::Prolog>
currently accepts.
=head2 Commands
Commands specific to aiprolog shell:
"% more" -- enables prompting for more results (default)
"% no more" -- disables prompting for more results
"% nomore" -- same as "no more"
"% halt" -- stops the shell
"% help" -- display this message
Note that the percent sign must preceed the command. The percent sign
indicates a Prolog comment. Without that, aiprolog will think you're trying to
execute a prolog command.
aiprolog-specific commands are case-insensitive.
=head2 Typical session
Save the following to a file named "append.pro":
append([],X,X).
append([W|X], Y, [W|Z]) :- append(X,Y,Z).
Then load it into the C<aiprolog> shell by typing this at a shell:
aiprolog path/to/append.pro
Alternatively, once in the shell, you can load the program with:
consult('path/to/append.prog').
In the shell, you should be greeted by a query prompt "?-". At this prompt,
you can issue queries against the program. Try entering the following query:
append(X,Y,[1,2,3,4]).
The shell should respond with this:
append([],[1,2,3,4],[1,2,3,4]) ;
It should then appear to hang. It's waiting for you to type a character. If
you type a semi-colon, it will attempt to resatisfy the query. If you keep
doing that until there are no more valid results left, you'll see this:
?- append(X,Y,[1,2,3,4]).
append([],[1,2,3,4],[1,2,3,4]) ;
append([1],[2,3,4],[1,2,3,4]) ;
append([1,2],[3,4],[1,2,3,4]) ;
append([1,2,3],[4],[1,2,3,4]) ;
append([1,2,3,4],[],[1,2,3,4]) ;
No
?-
The "No" is just Prolog's way of telling you there are no more results which
satisfy your query. If you stop trying to satisfy results before all solutions
have been found, you might see something like this:
?- append(X,Y,[1,2,3,4]).
append([],[1,2,3,4],[1,2,3,4]) ;
append([1],[2,3,4],[1,2,3,4]) ;
append([1,2],[3,4],[1,2,3,4])
Yes
?-
The "Yes" simply says that Prolog found results for you.
=head2 The game
If you are hoping to use this to play the bundled "Spider" game, I recommend
the following:
aiprolog location/of/spider.pro
?- % no more
That disables the pause where the shell waits for you to hit a ';' to get more
results or hit enter to continue. It gets very annoying while playing the
game, though it's useful when you really want to program.
Then issue the "start" command (defined in "spider.pro").
?- start.
=cut
data/sleepy.pro view on Meta::CPAN
/* "Sleepy" -- a sample adventure game, by David Matuszek. */
% http://www.csc.vill.edu/~dmatusze/resources/prolog/sleepy.html
/* In standard Prolog, all predicates are "dynamic": they
can be changed during execution. SWI-Prolog requires such
predicates to be specially marked. */
% :- dynamic at/2, i_am_at/1, i_am_holding/1, alive/1,
% lit/1, visible_object/1.
/* This routine is purely for debugging purposes. */
%dump :- listing(at), listing(i_am_at), listing(i_am_holding),
% listing(alive), listing(lit), listing(visible_object).
/* 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.
at(flyswatter, den).
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).
w :- go(w).
u :- go(u).
d :- go(d).
/* 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),
retract(at(fly, bedroom)),
assert(at(fly, den)).
buzz_off :-
at(fly, den),
lit(bedroom),
retract(at(fly, den)),
assert(at(fly, bedroom)).
optional_buzz_off :-
buzz_off.
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).
w :- go(w).
u :- go(u).
d :- go(d).
% 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 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 strict;
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).
nrev30 :-
nrev([1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0],X).
END_BENCHMARK
}
examples/cut.pl view on Meta::CPAN
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).
valuable(gold).
valuable(rubies).
owns(merlyn,gold).
owns(ovid,rubies).
owns("Some rich person", gold).
knows(badguy,merlyn).
END_PROG
}
examples/hanoi.pl view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use lib ('../lib/', 'lib/');
use aliased 'AI::Prolog';
my $prolog = Prolog->new(<<'END_PROLOG');
hanoi(N) :-
move(N, left, center, right).
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
#!/usr/local/bin/perl -l
use strict;
use lib qw(../lib/ lib/);
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
# see http://www.compapp.dcu.ie/~alex/LOGIC/monkey.html
# This is the classic Monkey/Banana problem
use strict;
use warnings;
use lib ('../lib/', 'lib');
use AI::Prolog;
my $prolog = AI::Prolog->new(<<'END_PROLOG');
perform(grasp,
state(middle, middle, onbox, hasnot),
state(middle, middle, onbox, has)).
perform(climb,
state(MP, BP, onfloor, H),
state(MP, BP, onbox, H)).
perform(push(P1,P2),
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 $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).
path( Node, Goal, Path, Sol) :-
arc( Node, Node2), not( wall(Node2) ),
not( member( Node2, Path)),
path( Node2, Goal, [Node2 | Path], Sol).
arc( p(X,Y), p(X1,Y) ) :- suc(X,X1).
arc( p(X,Y), p(X1,Y) ) :- suc(X1,X).
arc( p(X,Y), p(X,Y1) ) :- suc(Y,Y1).
arc( p(X,Y), p(X,Y1) ) :- suc(Y1,Y).
wall( p(3,2) ).
wall( p(3,3) ).
wall( p(3,4) ).
wall( p(5,3) ).
suc(1,2).
suc(2,3).
suc(3,4).
suc(4,5).
suc(5,6).
suc(6,7).
suc(7,8).
invert(IN, OUT) :- invert1(IN,[],OUT).
invert1([], L,L).
invert1( [A | Tail], L,Res) :-
invert1( Tail, [A | L], Res).
member(X, [X|Y]).
member(X, [A|B]) :- member(X,B).
END_PROG
}
examples/schedule.pl view on Meta::CPAN
use aliased 'AI::Prolog';
my $prolog = Prolog->new(<<'END_PROLOG');
member(X,[X|Xs]).
member(X,[_|Ys]) :- member(X,Ys).
scheduler(L) :- makeList(L,4), different(L).
makeList([],0):- !.
makeList([course(Teacher,Time,Room)|Rest], N) :-
teacher(Teacher),
classtime(Time),
classroom(Room),
is(M,minus(N,1)),
makeList(Rest,M).
teacher(jim).
teacher(sally).
classtime(afternoon).
classtime(evening).
classroom(X) :- member(X, [room1,room2]).
different([_]).
different([course(Teacher,Time,_)|Rest]) :-
member(course(Teacher,Time,_),Rest),
!, 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
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)).
thief("Bad guy").
valuable(gold).
valuable(rubies).
owns(merlyn,gold).
owns(ovid,rubies).
owns(kudra, gold).
knows(badguy,merlyn).
END_PROG
}
lib/AI/Prolog.pm view on Meta::CPAN
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;
return $self;
}
sub do {
my ( $self, $query ) = @_;
$self->query($query);
1 while $self->results;
$self;
}
sub query {
my ( $self, $query ) = @_;
# make that final period optional
$query .= '.' unless $query =~ /\.$/;
$self->{_query} = Term->new($query);
unless ( defined $self->{_engine} ) {
# prime the pump
$self->{_engine} = Engine->new( @{$self}{qw/_query _prog/} );
}
$self->{_engine}->query( $self->{_query} );
return $self;
}
sub results {
my $self = shift;
unless ( defined $self->{_query} ) {
croak "You can't fetch results because you have not set a query";
}
$self->{_engine}->results;
}
sub trace {
my $self = shift;
if (@_) {
$self->{_engine}->trace(shift);
return $self;
}
return $self->{_engine}->trace;
}
sub raw_results {
my $class = shift;
if (@_) {
Engine->raw_results(shift);
return $class;
}
return Engine->raw_results;
}
my $QUOTER;
sub quote {
my ( $proto, $string ) = @_;
$QUOTER = Text::Quote->new unless $QUOTER;
return $QUOTER->quote_simple($string);
}
sub list {
my $proto = shift;
return
join ", " => map { /^$RE{num}{real}$/ ? $_ : $proto->quote($_) } @_;
}
sub continue {
my $self = shift;
return 1 unless $self->{_engine}; # we haven't started yet!
!$self->{_engine}->halt;
}
1;
__END__
=head1 NAME
AI::Prolog - Perl extension for logic programming.
=head1 SYNOPSIS
use AI::Prolog;
use Data::Dumper;
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
In Perl, we traditionally tell the language how to find a solution. In logic
programming, we describe what a solution would look like and let the language
find it for us.
=head1 QUICKSTART
For those who like to just dive right in, this distribution contains a Prolog
shell called C<aiprolog> and two short adventure games, C<spider.pro> and
C<sleepy.pro>. If you have installed the C<aiprolog> shell, you can run
either game with the command:
aiprolog data/spider.pro
aiprolog data/sleepy.pro
When the C<aiprolog> shell starts, you can type C<start.> to see how to play
the game. Typing C<halt.> and hitting return twice will allow you to exit.
See the C<bin/> and C<data/> directories in the distribution.
Additionally, you can read L<AI::Prolog::Article> for a better description of
how to use C<AI::Prolog>. This document is an article originally published in
The Perl Review (L<http://www.theperlreview.com/>) and which they have
graciously allowed me to redistribute.
lib/AI/Prolog.pm view on Meta::CPAN
Prolog" (L<http://www.perl.com/pub/a/2005/12/15/perl_prolog.html>) for more
more examples.
=head1 DESCRIPTION
C<AI::Prolog> is a pure Perl predicate logic engine. In predicate logic,
instead of telling the computer how to do something, you tell the computer what
something is and let it figure out how to do it. Conceptually this is similar
to regular expressions.
my @matches = $string =~ /XX(YY?)ZZ/g
If the string contains data that will satisfy the pattern, C<@matches> will
contain a bunch of "YY" and "Y"s. Note that you're not telling the program how
to find those matches. Instead, you supply it with a pattern and it goes off
and does its thing.
To learn more about Prolog, see Roman BartE<225>k's "Guide to Prolog
Programming" at L<http://kti.ms.mff.cuni.cz/~bartak/prolog/index.html>.
Amongst other things, his course uses the Java applet that C<AI::Prolog> was
ported from, so his examples will generally work with this module.
lib/AI/Prolog.pm view on Meta::CPAN
=back
For quick examples of how that works, see the C<examples/> directory with this
distribution. Feel free to contribute more.
=head2 Creating a logic program
This module is actually remarkable easy to use. To create a Prolog program,
you simply pass the Prolog code as a string to the constructor:
my $prolog = AI::Prolog->new(<<'END_PROLOG');
steals(PERP, STUFF) :-
thief(PERP),
valuable(STUFF),
owns(VICTIM,STUFF),
not(knows(PERP,VICTIM)).
thief(badguy).
valuable(gold).
valuable(rubies).
owns(merlyn,gold).
owns(ovid,rubies).
knows(badguy,merlyn).
END_PROLOG
Side note: in Prolog, programs are often referred to as databases.
=head2 Creating a query
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)>
This is the constructor. It takes a string representing a Prolog program:
my $prolog = AI::Prolog->new($program_text);
See L<AI::Prolog::Builtins|AI::Prolog::Builtins> and the C<examples/> directory
included with this distribution for more details on the program text.
Returns an C<AI::Prolog> object.
=head2 C<trace([$boolean])>
One can "trace" the program execution by setting this property to a true value
before fetching engine results:
AI::Prolog->trace(1);
while (my $result = $engine->results) {
# do something with results
}
This sends trace information to C<STDOUT> and allows you to see how the engine
is trying to satify your goals. Naturally, this slows things down quite a bit.
Calling C<trace> without an argument returns the current C<trace> value.
=head2 C<raw_results([$boolean])>
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->raw_results(1);
$prolog->query('steals(badguy, STUFF, VICTIM)');
while (my $r = $prolog->results) {
# do stuff with $r in the form:
# ['steals', 'badguy', $STUFF, $VICTIM]
}
Calling C<raw_results> without an argument returns the current C<raw_results>
value.
This is the default behavior.
=head2 C<quote($string)>.
This method quotes a Perl string to allow C<AI::Prolog> to treat it as a proper
Prolog term (and not worry about it accidentally being treated as a variable if
it begins with an upper-case letter).
my $perl6 = AI::Prolog->quote('Perl 6'); # returns 'Perl 6' (with quotes)
$prolog->query(qq'can_program("ovid",$perl6).');
At the present time, quoted strings may use single or double quotes as strings.
This is somewhat different from standard Prolog which treats a double-quoted
string as a list of characters.
Maybe called on an instance (the behavior is unchanged).
=head2 C<list(@list)>.
Turns a Perl list into a Prolog list and makes it suitable for embedding into
a program. This will quote individual variables, unless it thinks they are
a number. If you wish numbers to be quoted with this method, you will need to
quote them manually.
This method does not add the list brackets.
my $list = AI::Prolog->list(qw/foo Bar 7 baz/);
# returns: 'foo', 'Bar', 7, 'baz'
$prolog->query(qq/append(X,Y,[$list])./);
May be called on an instance (the behavior is unchanged).
=head1 INSTANCE METHODS
=head2 C<do($query_string)>
This method is useful when you wish to combine the C<query()> and C<results()>
methods but don't care about the results returned. Most often used with the
C<assert(X)> and C<retract(X)> predicates.
$prolog->do('assert(loves(ovid,perl)).');
This is a shorthand for:
$prolog->query('assert(loves(ovid,perl)).');
1 while $prolog->results;
This is important because the C<query()> method merely builds the query. Not
until the C<results()> method is called is the command actually executed.
=head2 C<query($query_string)>
After instantiating an C<AI::Prolog> object, use this method to query it.
Queries currently take the form of a valid prolog query but the final period
is optional:
$prolog->query('grandfather(Ancestor, julie).');
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.
=head1 TODO
=over 4
=item * Why does this take so long to run?
perl examples/path.pl 3
On my Mac that takes over an hour to complete.
=item * Support for more builtins.
=item * Performance improvements.
I have a number of ideas for this, but it's pretty low-priority until things
are stabilized.
lib/AI/Prolog.pm view on Meta::CPAN
=head1 EXPORT
None by default. However, for convenience, you can choose ":all" functions to
be exported. That will provide you with C<Term>, C<Parser>, and C<Engine>
classes. This is not recommended and most support and documentation will now
target the C<AI::Prolog> interface.
If you choose not to export the functions, you may use the fully qualified
package names instead:
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/>
X-Prolog: L<http://www.iro.umontreal.ca/~vaucher/XProlog/>
lib/AI/Prolog/Article.pod view on Meta::CPAN
=head1 Logic Programming in Perl
=head2 Introduction
A programmer who hasn't been exposed to all four of the imperative,
functional, objective, and logical programming styles has one or more
conceptual blindspots. It's like knowing how to boil but not fry.
Programming is not a skill one develops in five easy lessons.
-- Tom Christiansen
By now, many Perl programmers know that the language offers support for
imperative, objective, and functional programming. However, logic programming
seems to be a lost art. This article attempts to shed a little light on the
subject. It's not that Prolog can do things that Perl cannot or vice versa.
Instead, Prolog does some things more naturally than Perl -- and vice versa.
In fact, while I introduce you to Prolog, I won't be teaching a bunch of nifty
tricks to make your Perl more powerful. I can't say what needs you may have
and, in any event, the tools that allow logic programming in Perl are generally
alpha quality, thus making them unsuitable for production environments.
lib/AI/Prolog/Article.pod view on Meta::CPAN
=head3 Facts
Facts in Prolog are stored in what is called the I<database> or I<knowledge
base>. This isn't a PostgreSQL or SQLite database, but a plain-text file. In
fact, you would call it a program and I'd be hard-pressed to argue with you, so
I won't. In fact, I'll often refer to these as Prolog "programs" just to avoid
confusion.
Facts look like this:
gives(tom, book, sally).
B<Note:> While the order of the arguments is technically not relevant, there
is a convention to more or less read the arguments left to right. The above
fact can be read as "tom gives the book to sally." Of course, it is sometimes
read as "sally gives the book to tom", but whichever order you adopt, you must
keep it consistent.
A fact consists of a I<functor> (also known as the I<head>) and 0 or more
arguments, followed by a period. Allowed names for functors generally follow
allowed named for subroutines in Perl.
The number of arguments to the functor are known as the I<arity>. The functor,
followed by a slash and the arity ("gives/3" in this example) is called the
I<predicate>. A predicate can have as many clauses as you like.
gives(tom, book, sally).
gives(tom, book, martin).
gives('George Bush', grief, liberals).
gives('Bill Clinton', grief, conservatives).
Note that those are not function calls. Those are merely facts stating the
relationship of the arguments to one another. Additionally, "tom" and "book"
are each repeated. In Prolog, those each refer to the same entity.
Of course, facts can have a varying number of arguments, even for the same
functor. The following are all legal:
parent(bob, tim). % parent/2
parent(sue, alex, william). % parent/3
male(sue). % male/1
female(sue). % female/1
frobnitz. % frobnitz/0
You can name a predicate just about anything that makes sense, but note that
some predicates are built-in and their names are reserved. The document
C<AI::Prolog::Builtins> has a list of the predicates that C<AI::Prolog>
directly supports. If you're in the C<aiprolog> shell (explained later), you
can type C<help.> to get a list of built-in predicates and
C<help('functor/arity')> (e.g., C<help('consult/1')>) to get description of how
a particular built-in predicate works.
And that pretty much covers most of what you need to know about facts.
=head3 Rules
Rules, like facts, are stored in the program. Rules describe how we can infer
new facts, even though we haven't explicitly stated them.
gives(tom, book, SOMEONE) :-
person(SOMEONE),
likes(tom, SOMEONE).
This rule states that "Tom will give a book to anyone who Tom likes." Note that
we are not telling Prolog how to figure out to whom Tom will give books.
Instead, we have merely defined the conditions under which Tom is willing to
part with his material possessions.
To understand rules, read the neck operator, C<:->, as "if" and commas outside
of argument lists as "and." Further, arguments beginning with upper-case
letters are I<variables>, such as C<SOMEONE> in the rule above. Note that only
the first letter needs to be capitalized; C<Someone> would also be a variable,
as would C<SomeOne> or C<SOmeoNe>.
Of course, we could simply enumerate the relationships:
gives(tom, book, alice).
gives(tom, book, bob).
gives(tom, book, martin).
gives(tom, book, charlie).
gives(tom, book, ovid).
However, this quickly become unweildy as the number of people in our program
grows.
=head3 Queries
Now that we have a rough understanding of facts and rules, we need to know how
to get answers from them. Queries are typically entered in the "interactive
environment." This would be analogous to the query window in a database GUI.
With C<AI::Prolog>, a shell named C<aiprolog> is included for demonstration
purposes though we'll mainly focus on calling Prolog from within a Perl
program.
?- gives(tom, book, SOMEONE).
This looks just like a fact, but with some minor differences. The C<?-> at the
beginning of the query is a query prompt seen in interactive environments.
You'll also note that C<SOMEONE> is capitalized, making it a variable (only the
first letter needs to capitalized.) Thus, this query is asking who Tom will
gives books to.
?- gives(WHO, book, SOMEONE).
This query looks like the previous one, but since the first argument is
capitalized, we're asking "who will give books to whom?".
?- gives(WHO, WHAT, WHOM).
Finally, because all arguments are variables, we're asking for everyone who
will give anything to anybody.
Note that no code changes are necessary for any of this. Because Prolog facts
and rules define relationships between things, Prolog can automatically infer
additional relationships if they are logically supported by the program.
Let's take a closer look at this, first focusing on the C<aiprolog> shell.
Assuming you've installed C<AI::Prolog> and said "yes" to installing the
C<aiprolog> shell, enter the following text in a file and save it as
I<gives.pro>. Note that lines beginning with a percent sign (C<%>) are
single-line comments.
% who are people?
person(bob).
person(sally).
person(tom).
person(alice).
% who likes whom?
likes(tom, bob).
likes(tom, alice).
likes(alice, bob).
% who has what
has(tom, book).
has(alice, ring).
has(bob, luck).
% who will give what to whom?
gives(WHO, WHAT, WHOM) :-
has(WHO, WHAT),
person(WHOM),
likes(WHO, WHOM).
gives(tom,book,harry).
When starting the shell, you can read in a file by supplying as a name on the
command line:
$ aiprolog gives.pro
Alternately, you can I<consult> the file from the shell:
$ aiprolog
Welcome to AI::Prolog v 0.732
Copyright (c) 2005, 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 '?' for help.
?- consult('gives.pro').
The second notation allows you to consult multiple files and add all of them to
the knowledge base.
After issuing the C<consult/1> command, the shell will appear to hang. Hit
I<Enter> to continue. We'll explain this behavior in a moment.
Now that you've loaded the program into the shell, issue the following query:
?- gives(X,Y,Z).
The shell should respond:
gives(tom, book, bob)
It will appear to hang. It wants to know if you wish for more results or if
you are going to continue. Typing a semicolon (;) tells Prolog that you want
it to I<resatisfy> the goal. In other words, you're asking Prolog if there are
more solutions. If you keep hitting the semicolon, you should see something
similar to the following:
?- gives(X,Y,Z).
gives(tom, book, bob) ;
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.
lib/AI/Prolog/Article.pod view on Meta::CPAN
In a regular expression, if a partial match is made, the regex engine remembers
where the end of that match occurred and tries to match more of the string. If
it fails, it backtracks to the last place a successful match was made and sees
if there are alternative matches it can try. If that fails, it keeps
backtracking to the last successful match and repeats that process until it
either finds a match or fails completely.
Unification, described in a fit of wild hand-waving, attempts to take two
logical terms and "unify" them. Imagine you have the following two lists:
( 1, 2, undef, undef, 5 )
( 1, 2, 3, 4, undef )
Imagine that undef means "unknown". We can unify those two lists because every
element that is known corresponds in the two lists. This leaves us with a list
of the integers one through five.
( 1, 2, 3, 4, 5 )
However, what happens if the last element of the first list is unknown?
( 1, 2, undef, undef, undef )
( 1, 2, 3, 4, undef )
We can still unify the two lists. In this case, we get the same five element
list, but the last item is unknown.
( 1, 2, 3, 4, undef )
If corresponding terms of the two lists are both bound (has a value) but not
equal, the lists will not unify:
( 1, 23, undef, undef, undef )
( 1, 2, 3, 4, undef )
Logic programming works by pushing these lists onto a stack and walking through
the stack and seeing if you can unify everything (sort of). But how to unify
from one item to the next? We assign names to the unknown values and see if
we can unify them. When we get to the next item in the stack, we check to see
if any named variables have been unified. If so, the engine will try to unify
them along with the other known variables.
That's a bad explanation, so here's how it works in Prolog. Imagine the
following knowledge base:
parent(sally, tom)
parent(bill, tom)
parent(tom, sue)
parent(alice, sue)
parent(sarah, tim)
male(bill)
male(tom)
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.
lib/AI/Prolog/Article.pod view on Meta::CPAN
And that's how logic programming works. Simple, eh? (Well, individual items can
be lists or other rules, but you get the idea).
=head2 Executing Prolog in Perl
Getting back to Perl, how would we implement that in a Perl program?
The basic process for using C<AI::Prolog> looks something like this:
use AI::Prolog;
my $prolog = AI::Prolog->new($prolog_code);
Create a new C<AI::Prolog> object, passing Prolog code as the argument. If you
prefer, you can wrap the constructor in a C<BEGIN> block:
my $prolog;
BEGIN {
$prolog = AI::Prolog->new(<<' END_PROLOG');
% some Prolog code goes here
END_PROLOG
}
This is not strictly necessary, but if your Prolog code has a syntax error, it
will be a compile-time error, not a run-time error, and you'll get an error
message similar to:
Unexpected character: (Expecting: ')'. Got (.)) at line number 12.
BEGIN failed--compilation aborted at test.pl line 7.
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
use strict;
use warnings;
use AI::Prolog;
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:
= Goals:
father(A)
==> Try: father(A) :-
parent(A, B),
male(A)
= Goals:
parent(A, C),
male(A)
==> Try: parent(sally, tom) :- null
= Goals:
male(sally)
==> Try: male(bill) :- null
<<== Backtrack:
= Goals:
male(sally)
==> Try: male(tom) :- null
<<== Backtrack:
= Goals:
male(sally)
==> Try: male(tim) :- null
<<== Backtrack:
[etc.]
Now if you really want to have fun with it, notice how you can rearrange the
clauses in the program at will and Prolog will return the same results (though
the order will likely change). This is because when one programs in a purely
declarative style, the order of the statements no longer matters. Subtle bugs
caused by switching two lines of code usually go away.
=head2 Prolog versus Perl
Now that you have a beginning understanding of what Prolog can do and how it
works internally, let's take a look at some of the implications of this. By
now, you know that the following can be read as "Ovid loves Perl":
loves(ovid, perl).
Assuming you've consulted a file with that fact in it, querying to find out
what I love is simple:
?- loves(ovid, WHAT).
In Perl, it's also pretty simple:
%loves = ( ovid => 'perl' );
$what = $loves{ovid};
But how do we find out who loves Perl? In Prolog:
loves(WHO, perl).
In Perl, however, we have two options, neither of them particularly good. We
can scan the C<%loves> hash for entries whose value is Perl, but this is
C<O(n)> when we want to stick with our simple C<O(1)> check. Thus, a more
common solution is to reverse the hash:
%who_loves = reverse %loves;
$who = $who_loves{perl};
(C<AI::Prolog>, being written in Perl, is slow. So the C<O(n)> versus
C<O(1)> argument doesn't hold. Versions written in C are far more practical in
this regard.)
But this fails, too. The first problem is that we have duplicated data. If we
have to add additional data to the C<%loves> hash, we'll have to remember to
synchronize the hashes. The second problem is that Perl is just a little too
popular:
loves(ovid, perl).
loves(alice, perl).
loves(bob, perl).
loves(charlie, perl).
If we simply reverse the hash for those entries, we lose three of those names.
So we have to play with this some more.
while ( my ($person, $thing) = each %loves ) {
push @{ $who_loves{$thing} }, $person;
}
Oh, wait. This fails too. You see, I'm fickle.
loves(ovid, perl).
loves(ovid, prolog).
loves(ovid, 'Perl 6').
(The quotes around "Perl 6" tell Prolog that this is a single value and that
it's a constant, not a variable.)
How do I find out everything Ovid loves? In Prolog, the query doesn't change:
loves(ovid, WHAT).
In Perl, our original hash wasn't enough.
my %loves = (
ovid => [ qw/perl prolog Perl6/ ],
alice => [ 'perl' ],
bob => [ 'perl' ],
charlie => [ 'perl' ],
);
my %who_loves;
while ( my ($person, $things) = each %loves ) {
foreach my $thing ( @$things ) {
push @{ $who_loves{$thing} }, $person;
}
}
Now that's starting to get really ugly. To represent and search that data in
Prolog is trivial. Now do you really want to have fun?
gives(tom, book, sally).
How would you represent that in Perl? There could be multiple gift-givers,
each gift-giver could give multiple things. There can be multiple recipients.
Representing this cleanly in Perl would not be easy. In fact, when handling
relational data, Perl has several weaknesses in relation to Prolog.
=over 4
=item * Data must often be duplicated to handle bi-directional relations.
lib/AI/Prolog/Article.pod view on Meta::CPAN
At this point, there's a good chance that you're thinking that you would just
stuff this into a relational database. Of course, this assumes you need
relational data and want to go to the trouble of setting up a database and
querying it from Perl. This is a good solution if you only need simple
relations. In fact, Prolog is often used with relational databases as the two
are closely related. SQL is a I<special purpose> declarative language whereas
Prolog is a I<general purpose> declarative language.
Firing up SQLite, let's create two tables and insert data into them.
sqlite> CREATE TABLE parent_2 (parent VARCHAR(32), child VARCHAR(32));
sqlite> CREATE TABLE male_1 (person VARCHAR(32));
sqlite> INSERT INTO parent_2 VALUES ('sally', 'tom');
sqlite> INSERT INTO parent_2 VALUES ('bill', 'tom');
sqlite> INSERT INTO parent_2 VALUES ('tom', 'sue');
sqlite> INSERT INTO parent_2 VALUES ('alice', 'sue');
sqlite> INSERT INTO parent_2 VALUES ('sarah', 'tim');
sqlite> INSERT INTO male_1 VALUES ('bill');
sqlite> INSERT INTO male_1 VALUES ('tom');
sqlite> INSERT INTO male_1 VALUES ('tim');
We can then find out who the fathers are with the following query.
SELECT parent
FROM parent_2, male_1
WHERE parent_2.parent = male_1.person;
This is very similar to Prolog but we are forced to explicitly state the
relationship. Many Prolog queries are conceptually similar to SQL queries but
the relationships are listed directly in the program rather than in the query.
When working with a relational database, we can get around this limitation with
a view:
CREATE VIEW father AS
SELECT parent
FROM parent_2, male_1
WHERE parent_2.parent = male_1.person;
And finding out who the fathers are is trivial:
SELECT * FROM father;
Further, databases, unlike many Prolog implementations, support indexing,
hashing, and reordering of goals to reduce backtracking. Given all of that,
why on earth would someone choose Prolog over SQL?
As stated earlier, Prolog is a general purpose programming language. Imagine
if you had to write all of your programs in SQL. Could you do it? You could
with Prolog. Further, there's one huge reason why one might choose Prolog:
recursion. Some SQL implementations have non-standard support for recursion,
but usually recursive procedures are simulated by multiple calls from the
lib/AI/Prolog/Article.pod view on Meta::CPAN
In Prolog, lists are not data structures. They're actually implemented in
terms of something referred to as the "dot functor" (./2). For our purposes,
we'll ignore this and pretend they're really data types. In fact, there's
going to be a lot of handwaving here so forgive me if you already know Prolog.
If you know LISP or Scheme, the following will be very familiar.
A list in Prolog is usually represented by a series of terms enclosed in square
brackets:
owns(alice, [bookcase, cats, dogs]).
A list consists of a head and a tail. The tail, in turn, is another list with
a head and tail, continuing recursively until the tail is an empty list. This
can be represented as follows:
[ HEAD | TAIL ]
Note that the head and tail are separated by the pipe operator.
Now if Alice owns things, how do we find out if she owns cats? First, we need
to define a predicate that succeeds if a given term is an element of a given
list.
member(X, [ X | _ ]).
member(X, [ _ | TAIL ]) :-
member(X, TAIL).
The first clause in this predicate states that C<X> is a member of a list if
it's the head of a list. The second clause states that C<X> is a member of a
list if it's a member of the tail of the list. Here's how this works out:
?- member(3, [1,2,3,4]).
Prolog checks the first clause and sees that 3 is not the head of the list:
C<member(3, [1|2,3,4])>. It then checks to see if it's a member of the tail of
the list: C<member(3, [2|3,4])>. Again this fails so Prolog tries again and
we succeed: C<member(3, [3|4])>.
So how do we see if Alice has cats?
has(PERSON, THING) :-
owns(PERSON, STUFF),
member(THING, STUFF).
And the query C<has(alice, cats)> will now succeed. However, as mentioned
previously, Prolog predicates can often be reused to deduce information that
you and I could deduce. Thus, we can find out who owns cats (C<has(WHO,
cats)>), everything Alice has (C<has(alice, WHAT)>), or everything that
everyone has (C<has(WHO, WHAT>).
Why does that work? Well, going back to the C<member/2> predicate, we can find
out if a term is an element of a list:
member(ovid, SOMELIST).
Or we can find all members of a list:
member(X, SOMELIST). % assumes SOMELIST is bound to a list
Now that might seem kind of nifty, but appending lists in Prolog is truly
sublime. Many consider understanding the power of the C<append/3> predicate
the true gateway to appreciating logic programming. So, without further ado:
append([], X, X).
append([HEAD|X], Y, [HEAD|Z]) :-
append(X, Y, Z).
You'll probably want to put that in a file named I<append.pro> and in the
shell C<consult('append.pro')> to follow along with some of the examples
you're about to see.
Explaining how that works would take a bit of time, so I recommend you work it
out on your own. Instead, I'll focus on its implications.
It looks like a lot of work to define how to append two lists. Perl is much
simpler:
my @Z = (@X, @Y);
In fact, that hides quite a bit of complexity for us. Anyone who has had to
concatenate two arrays in C can appreciate the simplicity of the Perl approach.
So what would the complexity of the C<append/3> predicate gain us? Naturally,
we can use this to append two lists. (The following output is similar to what
one would see in regular Prolog systems. It's been reproduced here for
clarity.)
?- append([1,2,3], [4,5], Z).
Z = [1,2,3,4,5]
Of course, by now you should know that we can reuse this. We can use it to
figure out which list to append to C<X> to create C<Z>.
?- append([1,2,3], Y, [1,2,3,4,5]).
Y = [4,5]
We can also use this to figure out all combinations of two lists can be
appended together to create C<Z>.
?- append(X, Y, [1,2,3,4,5]).
X = [], Y = [1,2,3,4,5]
X = [1], Y = [1,2,3,4]
X = [1,2], Y = [1,2,3]
X = [1,2,3], Y = [1,2]
X = [1,2,3,4], Y = [1]
X = [1,2,3,4,5], Y = []
And the Perl equivalent:
use AI::Prolog;
my $prolog = AI::Prolog->new(<<"END_PROLOG");
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/Article.pod view on Meta::CPAN
The "cut" operator is what is known as an "extra-logical" predicate. This,
along with I/O and predicates that assert and retract facts in the database
are a subject of much controversy. They cause issues because they frequently
cannot be backtracked over and the order of the clauses sometimes becomes
important when using them. They can be very useful and simplify many problems,
but they are more imperative in nature than logical and can introduce subtle
bugs.
Math is also handled poorly in Prolog. Consider the following program:
convert(Celsius, Fahrenheit) :-
Celsius is (Fahrenheit - 32) * 5 / 9.
You can then issue the query C<convert(Celsuis, 32)> and it will dutifully
report that the celsius value is zero. However, C<convert(0, 32)> fails. This
is because Prolog is not able to solve the right hand side of the equation
unless C<Fahrenheit> has a value at the time that Prolog starts examining the
equation. One simplistic way of getting around this limitation is with multiple
predicates and testing which argument is an unbound variable:
convert(Celsius, Fahrenheit) :-
var(Celsius),
not(var(Fahrenheit)),
Celsius is (Fahrenheit - 32) * 5 / 9.
convert(Celsius, Fahrenheit) :-
var(Fahrenheit),
not(var(Celsius)),
Fahrenheit is (Celsius * (9/5)) + 32.
This has a variety of problems, not the least of which is that it offers no
advantages over imperative programming.
ISO-Prolog does not define it, but many Prolog implementations support
constraints and these, though beyond the scope of this article, can get around
this and other issues. They can allow "logical" math and ensure that
"impossible" search branches are never explored. This can help to alleviate
many of the aforementioned concerns.
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
=head1 NAME
AI::Prolog::Builtins - Builtin predicates that AI::Prolog supports
=head1 REVISION
$Id: Builtins.pod,v 1.9 2005/08/06 23:28:40 ovid Exp $
=head2 Comments
Comments begin with a C<%> and terminate at the end of the line or begin with
C</*> and terminate with C<*/>.
=head2 Variables
As in Prolog, all variables begin with an upper-case letter and are not quoted.
In the following example, C<STUFF> is a variable.
steals(badguy, STUFF, "Some rich person").
=head2 Constants
Constants begin with lower-case letters. If you need a constant that begins
with an upper-case letter or contains spaces or other non-alphanumeric
characters, enclose the constant in single or double quotes The quotes will
not be included in the constant.
In the following example, C<badguy> and C<Some rich person> are both constants:
steals(badguy, STUFF, "Some rich person").
=head2 Miscellaneous
This will not work:
p(X) :- X. /* does not work */
Use this instead:
p(X) :- call(X).
=head1 BUILTINS
=over 4
=item !/0
The "cut" operator. This is used when you wish to tell Prolog that you only
need to satisfy a goal once. For example, if you wish to deny someone the
right to rent videos if they have overdue videos, you might use the cut
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
have more than one overdue video doesn't matter.
See the C<cut.pl> program in the C<examples/> directory that comes with this
distribution.
=item assert/1
Add new facts to the database. Only facts can be added, not rules. This may
change in the future. See C<retract(X)>.
assert(loves(ovid,perl)).
=item call/1
Invokes C<X> as a goal.
=item consult/1
Supplied the name of a file containing Prolog code, this will consult the
Prolog code in the file and add its contents to the current knowledgebase.
Will warn if the file cannot be opened.
=item div/2
Succeeds if both terms are bound. The value of the term is X / Y.
Use with C<is(X,Y)>.
is(X, div(N,3)).
This is the internal form of the infix operator:
N / 3.
=item eq/2
Succeeds if C<X> and C<Y> are equal.
This is the internal form of the infix operator:
X == Y.
=item fail/0
This goal always fails. Useful when you've reached a condition you
know should not succeed.
kill(Hero, Beast) :-
not(has_weapon(Hero)), fail.
=item ge/2
Succeeds if both terms are bound and X >= Y.
This is the internal form of the infix operator:
X >= Y.
=item gt/2
Succeeds if both terms are bound and X > Y.
This is the internal form of the infix operator:
X > Y.
=item halt/1
In the C<aiprolog> shell, exist shell. Currently has no other effect.
=item if/3
If C<X> succeeds as a goal, try C<Y> as a goal. Otherwise, try C<Z>.
thief(badguy).
steals(PERP, X) :-
if(thief(PERP), eq(X,rubies), eq(X,nothing)).
=item is/2
If X is unbound and Y is bound to a number, the goal succeeds and X becomes
bound to the value of Y. Otherwise, succeeds if both terms are bound, numbers,
and equal.
All other conditions result in failure.
This is the internal form of the infix operator:
X is Y.
=item le/2
Succeeds if both terms are bound and X <= Y.
This is the internal form of the infix operator:
X <= Y.
=item listing/0
Dumps a listing of all user-defined predicates and how they are defined.
=item listing/1
Dumps a listing of the requested predicate. C<X> must a variable or string
instantiated in I<functor/arity>) form. Note that, unlike most Prolog's, this
means that the followig will not work:
listing(foo/2).
Use this instead:
listing('foo/2').
=item lt/2
Succeeds if both terms are bound and X < Y.
This is the internal form of the infix operator:
X < Y.
=item minus/2
Succeeds if both terms are bound. The value of the term is X - Y.
Use with C<is(X,Y)>.
is(X, minus(N,1)).
This is the internal form of the infix operator:
N - 1.
=item mod/2
Succeeds if both terms are bound. The value of the term is X % Y. (modulus)
Use with C<is(X,Y)>.
is(X, mod(N,3)).
This is the internal form of the infix operator:
N % 3.
=item mult/2
Succeeds if both terms are bound. The value of the term is X * Y.
Use with C<is(X,Y)>.
is(X, mult(N,3)).
This is the internal form of the infix operator:
N * 3.
=item ne/2
Succeeds if C<X> and C<Y> cannot be proven to be equal.
This is the internal form of the infix operator:
X \= Y.
=item nl/0
Prints a newline.
=item not/1
Succeeds if C<X> cannot be proven. This is not negation as we're used to
seeing it in procedural languages.
=item notrace/0
Turns off tracing of Prolog's attempt to satisfy goals.
=item once/1
Stop solving for C<X> if C<X> succeeds. Defined as:
once(X) :- X, !;
=item or/2
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
the future. See C<assert(X)>.
retract(loves(ovid,java)).
=item trace/0
Turns on tracing of Prolog's attempt to satisfy goals.
=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.
Use C<if(IF, THEN, ELSE)> instead.
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.
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
=head1 MATH
Since version .70, math is fully available in C<AI::Prolog>. Note that math is
implemented via the
L<AI::Prolog::Parser::PreProcessor::Math|AI::Prolog::Parser::PreProcessor::Math>
module. This module rewrites Prolog math to an internal, predicate-based form
with the L<AI::Prolog::Parser|AI::Prolog::Parser> can parse. This may cause
confusion when debugging.
X is 5 + 7.
% internally converted to
% is(X, plus(5, 7)).
The math predicates are officially deprecated and I<cannot> be used in the same
expression with regular Prolog math.
Number may be integers, floats, doubles, etc. A number that starts with a
minus sign (-) is considered negative. No number may end in a decimal point as
the period is interpreted as the end of a clause. The following is therefore a
syntax error:
X is 5. + 7.
Unfortunately, the parser doesn't yet yell about that. We'll try and figure
out why later.
Omit the period after the number or put a zero after it:
X is 5.0 + 7.
X is 5 + 7.
Because numbers use Perl scalars, you may mix types (ints and floats) and they
will behave as you expect in Perl.
Precedence is C<*> and C</>, left to right, followed by C<+> and C<->, left to
right followed by C<%>, left to right. (I probably should change that.)
Naturally, parentheses may be used for grouping:
X is 3 * 5 + 2. % is(X, plus(mult(3, 5), 2)).
X is 3 * (5 + 2). % is(X, mult(3, plus(5, 2))).
When using math, note that C<is> is similar to Perl's assignment operator, C<=>.
This can be confusing.
X is 3 + 2.
Sets C<X> to the value of C<5>.
If C<X> is already instantiated, this goal succeeds if the value of C<X> is the
value of the result of the right-hand side of the equation. Internally, if X is not
instantiated, it looks like this:
is(5, plus(3,2)).
The C<=> operator tries to unify the left-hand side with the right-hand side:
X = 3 + 2.
If C<X> is already instantiated, this goal succeeds if the value of C<X> is the
same goal as the right-hand side of the equation. Internally, if X is not
instantiated, it looks like this:
eq(plus(3,2), plus(3,2)).
When you first start using Prolog, you probably was C<is> instead of C<=>.
Logical comparisons are straightforward:
3 >= X.
Y > (4 + 3) * X.
X == Y. % a test for equality
X \= Y. % Not equal. See caveats for ne/2
% etc.
=head1 BUGS
None known.
=head1 SEE ALSO
L<AI::Prolog::Introduction>
L<AI::Prolog>
lib/AI/Prolog/ChoicePoint.pm view on Meta::CPAN
package AI::Prolog::ChoicePoint;
$REVISION = '$Id: ChoicePoint.pm,v 1.5 2005/02/20 18:27:55 ovid Exp $';
$VERSION = '0.02';
use strict;
use warnings;
use Hash::Util 'lock_keys';
sub new {
my ( $class, $goal, $clause ) = @_;
my $self = bless {
goal => $goal,
clause => $clause,
} => $class;
lock_keys %$self;
return $self;
}
sub goal { $_[0]->{goal} }
sub clause { $_[0]->{clause} }
sub to_string {
my $self = shift;
return " ||" . $self->clause->to_string . "|| ";
}
1;
__END__
=head1 NAME
AI::Prolog::ChoicePoint - Create a choicepoint object for the Engine.
lib/AI/Prolog/Cookbook.pod view on Meta::CPAN
=head1 NAME
AI::Prolog::Cookbook - Recipes for common Prolog problems
=head1 REVISION
$Id: Cookbook.pod,v 1.1 2005/08/06 23:28:40 ovid Exp $
=head1 DESCRIPTION
Logic programming can take some time to get used to. This document is intended
to provide solutions to common problems encountered in logic programming. Many
of the predicates listed here will depend on other predicates defined here. If
in doubt, see L<AI::Prolog::Builtins|AI::Prolog::Builtins> for which predicates
L<AI::Prolog|AI::Prolog> supports directly.
Like most predicates in Prolog, the following predicates can be reused in ways
to generate answers that a human could logically infer from the data presented.
However, many times those "answers" can result in infinite loops. For example,
in the C<gather/3> predicate listed below, we can gather the items from a list
which match the supplied list of indices.
gather([1,3], [a,b,c,d], Result). % Result is [a,c]
Or we can figure out which indices in a list match the resulting values:
gather(Indices, [a,b,c,d], [a,d]). % Indices is [1,4]
However, if we wish to understand which lists will have the given lists for the
given indices, we have an infinite result set. L<AI::Prolog|AI::Prolog> and
(other Prolog implementations) will return one result and then enter an
infinite loop if you request the goal be resatisfied (i.e., if you ask for
another result). If you see behavior such as this in your programs, you can
issue the C<trace.> command to see how Prolog is internally attempting to
satisfy your goal. C<notrace.> will turn off tracing.
=head1 THE PROBLEMS
=head2 Append two lists.
Usage: C<append(List1, List2, Result).>
append([], X, X). % appending an empty list to X yields X
append([W|X], Y, [W|Z]) :-
append(X, Y, Z).
=head2 Does a list contain a given term?
Usage: C<member(Item, List).>
member(X, [X|_]).
member(X, [_|Tail]) :-
member(X, Tail).
=head2 Pick a list member by index.
Usage: C<member(Index, Item, List).>
member(1, SearchFor, [SearchFor|_]).
member(Index, SearchFor, [_|Tail]) :-
member(Previous, SearchFor, Tail),
Index is Previous + 1.
Please note that assignment in Prolog is via the C<is/2> infix operator. The
above code will fail if you use C<=/2>. This is a common source of bugs for
programmers new to Prolog. The C<=/2> predicate will unify the right hand side
with the left hand side. It will I<not> evaluate the left hand side. Thus:
X = 3 + Y.
% X is now plus(3,Y) (the internal form of the +/2 infix operator.)
If you prefer your list indices start with zero, alter the first clause as
follows:
member(0, SearchFor, [SearchFor|_]).
=head2 Gather elements from a list by indices.
Usage: C<gather(Indices, FromList, Result).>
This definition depends on the C<member/3> predicate defined in this document.
gather([], _, []).
gather([First|Remaining], FromList, [ResultHead|ResultTail]) :-
member(First, ResultHead, FromList),
gather(Remaining, FromList, ResultTail).
Example queries:
gather([2,4], [a,b,c,d,e], Result). % Result = [b,d]
gather(FromIndices, [a,b,c,d,e], [b,d]). % FromIndices = [2,4]
This example is tricky when one realizes that one can reuse predicates. In
this case, it might be tempting to see I<which> lists from which one can
gather certain values from certain indices. The first time you try it, you
may get results as follows:
gather([2,4], WhichList, [x,y]).
This query, when executed in the C<aiprolog> shell will output a response
similar to this:
gather([2,4], [A,x,B,y|C], [b,d]).
When examining this, we see that the first, third, and fifth elements (and
beyond) of the list are variables. Unfortunately, as an infinite number of
lists will satisfy this goal, attempting to fetch the a second result from the
same query will result in an infinite loop.
=head2 Determine the intersection of two lists.
Usage: C<intersection(List1, List2, Intersection).>
This definition depends on the C<member/2> predicate defined in this document.
intersection([H|T], L, [H|U]) :-
member(H,L),
intersection(T,L,U).
intersection([_|T], L, U) :-
intersection(T,L,U).
intersection(_,_,[]).
The C<intersection/3> predicate will compute the intersection of two lists.
You probably only want the first result from this predicate. See C<trace/0>
to understand why it returns more than one intersection.
=head2 Reverse a list.
Usage: C<reverse(List, ReversedList).>
reverse(List, Reverse) :-
reverse_accumulate(List, [], Reverse).
reverse_accumulate([], List, List).
reverse_accumulate([Head|Tail], Accumulate, Reverse) :-
reverse_accumulate(Tail, [Head|Accumulate], Reverse).
Reversing a list is tricky. If this predicate were written in an imperative
manner, it might look something like this:
sub reverse {
my @list = @_;
my @reverse;
while (my $element = shift @list) {
unshift @reverse, $element;
}
return @reverse;
}
This method of reversing a list runs in C<O(n)> time. However, new Prolog
programmers often write what is known as the "naive reverse" which uses the
C<append/3> predicate to reverse a list:
reverse([],[]).
reverse([Head|Tail], Reverse) :-
reverse(Tail, ReverseTail),
append(ReverseTail, [Head], Reverse).
For this, you take the tail of the list, reverse it and append the head of the
list to it. However, this runs in C<O(N^2)>. This runs so slowly that
reversing a 30 element list takes 496 logical inferences. As a result, the
naive reverse is frequently used as a benchmarking tool for logic programs.
If reversing a 30 element list via the naive reverse takes .1 seconds, we can
say that the Prolog implementation is running at about 5000 logical inferences
per second. This is known by the unfortunate acronym of LIPS, the standard
measure of the speed of logic programs. Modern Prolog implementations
frequently measure their performance in MLIPS, or MegaLIPS. By contrast, the
human mind is frequently estimated to run between 1 to 4 LIPS. This
demonstrates that there's much more to cognition than logic.
=head2 Checking if a list is a subset of another list.
Usage: C<subset(Subset, List).>
This definition depends on the C<member/2> predicate defined in this document.
subset([Head|Tail], List) :-
member(Head, List),
subset(Tail, List).
subset([], _). % The empty list is a subset of all lists
=head2 Delete all occurences of a term from a list, giving a new list.
Usage: C<delete(Term, List, Result).>
delete(_,[],[]). % deleting anything from an empty list yields an empty list
delete(Term, [Term|Tail], Result) :-
delete(Term, Tail, Result).
delete(Term, [Head|Tail], [Head|TailResult]) :-
delete(Term, Tail, TailResult).
=head2 Partition a list where list values <= Value.
Usage: C<partition(Value, List, LHS, RHS).>
Note that the term at I<Value> will be included in the I<LHS>.
partition(Value, [Head|Tail], [Head|LHS], RHS) :-
Head <= Value,
partition(Value, Tail, LHS, RHS).
partition(Value, [Head|Tail], LHS, [Head|RHS]) :-
partition(Value, Tail, LHS, RHS).
partition(_,[],[],[]).
=head2 Quicksort.
Usage: C<sort(List, Sorted).>
This definition depends on the C<partition/4> and C<append/3> predicates
defined in this document.
sort([], []).
sort([Head|Tail], Sorted) :-
partition(Head, Tail, LHS, RHS),
sort(LHS, Temp1),
sort(RHS, Temp2),
append(Temp1, [Head|Temp2], Sorted).
Note that (currently), this will only sort numeric values.
=head1 SEE ALSO
L<AI::Prolog>
L<AI::Prolog::Builtins>
L<AI::Prolog::Introduction>
lib/AI/Prolog/Engine.pm view on Meta::CPAN
# The engine is what executes prolog queries.
# Author emeritus: Dr. Michael Winikoff
# Translation to Perl: Curtis "Ovid" Poe
# $prog An initial program - this will be extended
# $term The query to be executed
# This governs whether tracing is done
sub trace {
my $self = shift;
if (@_) {
$self->{_trace} = shift;
return $self;
}
return $self->{_trace};
}
sub halt {
my $self = shift;
if (@_) {
$self->{_halt} = shift;
return $self;
}
return $self->{_halt};
}
my $FORMATTED = 1;
sub formatted {
my $self = shift;
if (@_) {
$FORMATTED = shift;
return $self;
}
return $FORMATTED;
}
my $RAW_RESULTS;
sub raw_results {
my $self = shift;
if (@_) {
$RAW_RESULTS = shift;
if ($RAW_RESULTS) {
$self->formatted(0);
}
return $self;
}
return $RAW_RESULTS;
}
my $BUILTIN = 0;
sub _adding_builtins {
my $self = shift;
if (@_) {
$BUILTIN = shift;
return $self;
}
return $BUILTIN;
}
sub new {
my ( $class, $term, $prog ) = @_;
my $self = bless {
# The stack holds choicepoints and a list of variables
# which need to be un-bound upon backtracking.
_stack => [],
_db => KnowledgeBase->new,
_goal => TermList->new( $term, undef ), # TermList
_call => $term, # Term
_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).
not(X) :- if(X,fail,true).
or(X,Y) :- call(X).
or(X,Y) :- call(Y).
true.
% the following are handled internally. Don't use the
% := operator. Eventually, I'll make this a fatal error.
% 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.
var(X) := 23.
%seq(X) := 30.
help := 31.
help(X) := 32.
gensym(X) := 33.
perlcall2(X,Y) := 34.
eq(X,X).
not(X) :- X, !, fail.
not(X).
%if(X, Yes, _ ) :- seq(X), !, seq(Yes).
%if(X, _ , No) :- seq(No).
%if(X, Yes) :- seq(X), !, seq(Yes).
%if(X, _ ).
%or(X,Y) :- seq(X).
%or(X,Y) :- seq(Y).
once(X) :- X , !.
END_PROG
$self->_adding_builtins(0);
};
if ($@) {
croak("Engine->new failed. Cannot parse default program: $@");
}
$self->{_retract_clause} = $self->{_db}->get("retract/1");
$self->{_goal}->resolve( $self->{_db} );
return $self;
}
sub query {
my ( $self, $query ) = @_;
$self->{_stack} = [];
$self->{_run_called} = undef;
$self->{_goal} = TermList->new($query);
$self->{_call} = $query;
$self->{_goal}->resolve( $self->{_db} );
return $self;
}
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;
}
$self->_run;
}
sub _run {
my ($self) = @_;
my $stackTop = 0;
while (1) {
$stackTop = @{ $self->{_stack} };
if ( $self->{_goal} && $self->{_goal}->isa(Step) ) {
$self->{_goal} = $self->{_goal}->next;
if ( $self->{_goal} ) {
$self->{_goal}->resolve( $self->{_db} );
}
$self->{_step_flag} = 1;
$self->trace(1);
}
$self->dump_goal if $self->{_trace};
$self->step if $self->{_step_flag};
unless ( $self->{_goal} ) {
# we've succeeded. return results
if ( $self->formatted ) {
return $self->_call->to_string;
}
else {
my @results = $self->_call->to_data;
return $self->raw_results
? $results[1]
: $results[0];
}
}
unless ( $self->{_goal} && $self->{_goal}{term} ) {
croak("Engine->run fatal error. goal->term is null!");
}
unless ( $self->{_goal}->{next_clause} ) {
my $predicate = $self->{_goal}{term}->predicate;
_warn("WARNING: undefined predicate ($predicate)\n");
next if $self->backtrack; # if we backtracked, try again
return; # otherwise, we failed
}
my $clause = $self->{_goal}->{next_clause};
if ( my $next_clause = $clause->{next_clause} ) {
push @{ $self->{_stack} } => $self->{_cp}
= ChoicePoint->new( $self->{_goal}, $next_clause, );
}
my $vars = [];
my $curr_term = $clause->{term}->refresh($vars);
if ( $curr_term->unify( $self->{_goal}->term, $self->{_stack} ) ) {
$clause = $clause->{next};
if ( $clause && $clause->isa(Primitive) ) {
if ( !$self->do_primitive( $self->{_goal}->{term}, $clause )
&& !$self->backtrack )
{
return;
}
}
elsif ( !$clause ) { # matching against fact
$self->{_goal} = $self->{_goal}->{next};
if ( $self->{_goal} ) {
$self->{_goal}->resolve( $self->{_db} );
}
}
else { # replace goal by clause body
my ( $p, $p1, $ptail ); # termlists
for ( my $i = 1; $clause; $i++ ) {
# will there only be one CUT?
if ( $clause->{term} eq Term->CUT ) {
$p = TermList->new( Cut->new($stackTop) );
}
else {
$p = TermList->new( $clause->{term}->refresh($vars) );
}
if ( $i == 1 ) {
$p1 = $ptail = $p;
}
else {
$ptail->next($p);
$ptail = $p; # XXX ?
}
$clause = $clause->{next};
}
$ptail->next( $self->{_goal}->{next} );
$self->{_goal} = $p1;
$self->{_goal}->resolve( $self->{_db} );
}
}
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;
}
1;
__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.
This documentation is provided for completeness. You probably want to use
L<AI::Prolog|AI::Prolog>.
=head1 CLASS METHODS
=head2 C<new($query, $database)>
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
the output of the program. This string will loosely correspond with the
expected output of a Prolog program.
If false, all calls to C<result> will return Perl data structures instead of
nicely formatted output.
If called with no arguments, this method returns the current C<formatted>
value.
Engine->formatted(1); # turn on formatting
Engine->formatted(0); # turn off formatting (default)
if (Engine->formatted) {
# test if formatting is enabled
}
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)
if (Engine->raw_results) {
# test if raw results is enabled
}
=head2 C<trace($boolean)>
Set this to a true value to turn on tracing. This will trace through the
engine's goal satisfaction process while it's running. This is very slow.
Engine->trace(1); # turn on tracing
Engine->trace(0); # turn off tracing
=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) {
# do stuff with $r in the form:
# ['steals', 'badguy', $STUFF, $VICTIM]
}
=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>
Reverse the name to email me.
lib/AI/Prolog/Engine/Primitives.pm view on Meta::CPAN
use aliased 'AI::Prolog::Term::Cut';
use aliased 'AI::Prolog::Term::Number';
use aliased 'AI::Prolog::TermList';
use aliased 'AI::Prolog::TermList::Step';
use aliased 'AI::Prolog::ChoicePoint';
my %DESCRIPTION_FOR;
my $LONGEST_PREDICATE = '';
sub _load_builtins {
return if keys %DESCRIPTION_FOR;
require Pod::Simple::Text;
require Pod::Perldoc;
my $perldoc = Pod::Perldoc->new;
my $builtin_pod = 'AI::Prolog::Builtins';
my ($found) = $perldoc->grand_search_init( [$builtin_pod] )
or die "Help failed. Cannot find documentation for $builtin_pod: $!";
open my $fh, '<', $found
or die "Cannot open $found for reading: ($!)";
my @lines = <$fh>;
close $fh or die "Cannot close $found: ($!)";
while (@lines) {
my $line = shift @lines;
my $predicate;
if ( $line =~ /\A=item\s*(\S+)/mx ) {
$predicate = $1;
if ( $predicate =~ m{.*/\d+}mx ) {
my @pod = "=head1 $predicate";
if ( length $predicate > length $LONGEST_PREDICATE ) {
$LONGEST_PREDICATE = $predicate;
}
while ( $line = shift @lines ) {
if ( $line =~ /\A=(?:item|back)/mx ) {
unshift @lines => $line;
last;
}
push @pod => $line;
}
push @pod => '=cut';
# XXX I hate instantiating this here, but there
# appears to be a bug in parsing if I don't :(
my $parser = Pod::Simple::Text->new;
my $output;
$parser->output_string( \$output );
$parser->parse_lines( @pod, undef );
$DESCRIPTION_FOR{$predicate} = $output;
$output = '';
}
}
}
return;
}
sub _remove_choices {
# this implements the cut operator
my ( $self, $varid ) = @_;
my @stack;
my $i = @{ $self->{_stack} };
while ( $i > $varid ) {
my $o = pop @{ $self->{_stack} };
if ( not $o->isa(ChoicePoint) ) {
push @stack => $o;
}
$i--;
}
while (@stack) {
push @{ $self->{_stack} } => pop @stack;
}
return;
}
sub _splice_goal_list {
my ( $self, $term ) = @_;
my ( $t2, $p, $p1, $ptail );
my @vars;
my $i = 0;
$term = $term->getarg(0);
while ( $term && $term->getfunctor ne 'null' ) {
$t2 = $term->getarg(0);
if ( $t2 eq Term->CUT ) {
$p = TermList->new( Cut->new( scalar @{ $self->{_stack} } ) );
}
else {
$p = TermList->new($t2);
}
if ( $i++ == 0 ) {
$p1 = $ptail = $p;
}
else {
$ptail->next($p);
$ptail = $p;
}
$term = $term->getarg(1);
}
$ptail->next( $self->{_goal}->next );
$self->{_goal} = $p1;
$self->{_goal}->resolve( $self->{_db} );
return;
}
use constant CONTINUE => 1;
use constant RETURN => 2;
use constant FAIL => ();
my @PRIMITIVES; # we'll fix this later
$PRIMITIVES[1] = sub { # !/0 (cut)
my ( $self, $term, $c ) = @_;
_remove_choices( $self, $term->varid );
CONTINUE;
};
$PRIMITIVES[2] = sub { # call/1
my ( $self, $term, $c ) = @_;
$self->{_goal} = TermList->new( $term->getarg(0), $self->{_goal}->next );
$self->{_goal}->resolve( $self->{_db} );
RETURN;
};
$PRIMITIVES[3] = sub { # fail/0
FAIL;
};
$PRIMITIVES[4] = sub { # consult/1
my ( $self, $term, $c ) = @_;
my $file = $term->getarg(0)->getfunctor;
if ( open my $fh, '<', $file ) {
# Avoid do { local $/; <$fh> }. This triggers a bug where
# *two* copies of the string are made. Double space is
# required.
my $prolog;
{
local $/;
$prolog = <$fh>;
}
$self->{_db}->consult($prolog);
return CONTINUE;
}
else {
warn "Could not open ($file) for reading: $!";
return FAIL;
}
};
$PRIMITIVES[5] = sub { # assert/1
my ( $self, $term, $c ) = @_;
$self->{_db}->assert( $term->getarg(0) );
return CONTINUE;
};
$PRIMITIVES[7] = sub { # retract/1
my ( $self, $term, $c ) = @_;
if ( not $self->{_db}->retract( $term->getarg(0), $self->{_stack} ) ) {
$self->backtrack;
return FAIL;
}
$self->{_cp}->clause( $self->{_retract_clause} )
; # if $self->{_cp}; # doesn't work
return CONTINUE;
};
$PRIMITIVES[8] = sub { # listing/0
my $self = shift;
$self->{_db}->dump(0);
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;
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;
};
$PRIMITIVES[17] = sub { # lt/2
my ( $self, $term ) = @_;
return ( $term->getarg(0)->value < $term->getarg(1)->value )
? CONTINUE
: FAIL;
};
$PRIMITIVES[19] = sub { # ge/2
my ( $self, $term ) = @_;
return ( $term->getarg(0)->value >= $term->getarg(1)->value )
? CONTINUE
: FAIL;
};
$PRIMITIVES[20] = sub { # le/2
my ( $self, $term ) = @_;
return ( $term->getarg(0)->value <= $term->getarg(1)->value )
? CONTINUE
: FAIL;
};
$PRIMITIVES[22] = sub { # halt/0
my ( $self, $term ) = @_;
$self->halt(1);
CONTINUE;
};
$PRIMITIVES[23] = sub { # var/1
my ( $self, $term, $c ) = @_;
return $term->getarg(0)->bound() ? FAIL : CONTINUE;
};
# plus(X,Y) := 25.
# minux(X,Y) := 26.
# mult(X,Y) := 27.
# div(X,Y) := 28.
# mod(X,Y) := 29.
$PRIMITIVES[30] = sub { # seq/1
my ( $self, $term, $c ) = @_;
$self->_splice_goal_list($term);
CONTINUE;
};
my $HELP_OUTPUT;
$PRIMITIVES[31] = sub { # help/0
_load_builtins();
if ( not $HELP_OUTPUT ) {
$HELP_OUTPUT = "Help is available for the following builtins:\n\n";
my @predicates = sort keys %DESCRIPTION_FOR;
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} )
? CONTINUE
: FAIL;
};
use constant UNDEFINED_SUBROUTINE_ERROR => do {
eval {
no strict 'refs'; ## no critic NoStrict
&{'---'};
};
my $e = $@;
# Undefined subroutine &main::--- called at .../Primitives.pm line 12.
my ($msg) = $e =~ / \A
(.+) # 'Undefined subroutine'
(?<=\s) # ' '
\S* # &main::
---/mx
or die q[Perl's error message changed! Damn! Fix this regex.];
$msg;
};
$PRIMITIVES[34] = sub { # perlcall2/2
my ( $self, $term ) = @_;
# Get a function name...
my $function_term = $term->getarg(0);
if ( not $function_term->is_bound ) {
return FAIL;
}
my $function_name = $function_term->to_string;
# Lookup a fully qualified function name...
my $function_ref;
if ( $function_name =~ /[:\']/mx ) {
$function_ref = $function_name;
}
elsif ( defined( my $package = $self->{_perlpackage} ) ) {
$function_name = "$package\::$function_name";
}
# Search the call stack...
if ( not defined $function_ref ) {
my $cx = 1;
my %packages;
CX:
while ( my $package = caller $cx ) {
# Don't retry packages...
next if exists $packages{$package};
$packages{$package} = undef;
# AUTOLOAD using packages are expected to provide a
# ->can() that works. I don't know if that's a widely
# known expectation but it's what I'm going to go
# with. Hash::AsObject gets this wrong.
if (do {
no strict 'refs'; ## no critic NoStrict
defined &{"$package\::$function_name"};
}
or $package->can($function_name)
)
{
$function_ref = "$package\::$function_name";
last CX;
}
}
continue {
++$cx;
}
}
# We got nuthin! Damn! I'll try for the first AUTOLOAD.
if ( not defined $function_ref ) {
my $cx = 1;
my %packages;
AUTOLOAD_CX:
while ( my ($package) = caller $cx ) {
next if exists $packages{$package};
$packages{$package} = undef;
if (do {
no strict 'refs'; ## no critic NoStrict
defined &{"$package\::AUTOLOAD"};
}
or $package->can('AUTOLOAD')
)
{
$function_ref = "$package\::$function_name";
last AUTOLOAD_CX;
}
}
continue {
++$cx;
}
}
if ( not defined $function_ref ) {
return FAIL;
}
# XXX What do to with the first arg?
my ( undef, $results_ref ) = $term->getarg(1)->to_data;
my @results = @{ $results_ref->[0] };
eval {
no strict 'refs'; ## no critic NoStrict
$function_ref->(@results);
};
if ( my $e = $@ ) {
# Extreme caution here.
if ( $e =~ UNDEFINED_SUBROUTINE_ERROR ) {
return FAIL;
}
}
return CONTINUE;
};
sub find { return $PRIMITIVES[ $_[1] ] }
1;
__END__
=head1 NAME
AI::Prolog::Engine::Primitives - The code for running aiprolog builtins
=head1 SYNOPSIS
my $builtin = AI::Prolog::Engine::Primitives ->find($builtin_id);
=head1 DESCRIPTION
This module contains the code to handle the built-in predicates. The
L<AI::Prolog::Engine|AI::Prolog::Engine> assigns many builtins an ID
number and this number is used to lookup the sub necessary to execute
the built-in.
=head1 AUTHOR
lib/AI/Prolog/Introduction.pod view on Meta::CPAN
=head1 NAME
AI::Prolog::Introduction - The what and the why of logic programming.
=head1 REVISION
$Id: Introduction.pod,v 1.2 2005/02/20 18:27:55 ovid Exp $
=head1 RATIONALE
You can skip this if you already know logic programming.
Note that most of this was pulled from my write-up about logic programming in
Perl at L<http://www.perlmonks.org/?node_id=424075>.
In Perl, generally you can append one list to another with this:
my @Z = (@X, @Y);
However, that's telling the language what to do. As sentient beings, we can
look at that and infer more information. Given C<@Z> and C<@X>, we could infer
C<@Y>. Given just C<@Z>, we could infer all combinations of C<@X> and C<@Y>
that can be combined to form C<@Z>.
Perl cannot do that. In logic programming, however, by defining what
C<append()> looks like, we get all of that other information.
In Prolog, it looks like this:
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
(There's actually often something called a "cut" after the first definition,
but we'll keep this simple.)
What the above code says is "appending an empty list to a non-empty list yields
the non-empty list." This is a boundary condition. Logic programs frequently
require a careful analysis of boundary conditions to avoid infinite loops
(similar to how recursive functions in Perl generally should have a terminating
condition defined in them.)
The second line is where the bulk of the work gets done. In Prolog, to identify
the head (first element) of a list and its tail (all elements except the
first), we use the syntax [head|tail]. Since ":-" is read as "if" in Prolog,
what this says if we want to concatenate (a,b,c) and (d,e,f):
=over 4
=item * Given a list with a head of W and a tail of X:
@list1 = qw/a b c/; (qw/a/ is W, the head, and qw/b c/ is X, the tail)
=item * If it's appended to list Y:
@Y = qw/d e f/;
=item * We get a list with a head of W and a tail of Z:
@list2 = qw/a b c d e f/;
=item * Only if X appended to Y forms Z:
X is qw/b c/. Y is qw/d e f/. Z is qw/b c d e f/.
=back
But how do we know if X appended to Y forms Z? Well, it's recursive. You see,
the head of X is 'b' and it's tail is 'c'. Let's follow the transformations:
append([a,b,c],[d,e,f],[a,b,c,d,e,f])
if append([b,c],[d,e,f],[b,c,d,e,f])
if append([c],[d,e,f],[c,d,e,f])
if append([],[d,e,f],[d,e,f])
As you can see, the last line matches our boundary condition, so the program
can determine what the concatenation is.
Now that may seem confusing at first, but so was the Schwartzian transform when
many of us encountered it. After a while, it becomes natural. Sit down and work
it out and you'll see what's going one.
So what does this give us? Well, we can now append lists X and Y to form Z:
append([a], [b,c,d], Z).
Given Y and Z, we can infer X.
append(X, [b,c,d], [a,b,c,d]).
And finally, given Z, we can infer all X and Y that combine to form Z.
append(X,Y,[a,b,c,d]).
Note that you get all of that from one definition of how to append two lists.
You also don't have to tell the program how to do it. It just figures it out
for you.
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
W-Prolog: L<http://goanna.cs.rmit.edu.au/~winikoff/wp/>
X-Prolog: L<http://www.iro.umontreal.ca/~vaucher/XProlog/>
Roman BartE<225>k's online guide to programming Prolog:
L<http://kti.ms.mff.cuni.cz/~bartak/prolog/index.html>
lib/AI/Prolog/KnowledgeBase.pm view on Meta::CPAN
use warnings;
use Carp qw( confess carp );
use Hash::Util 'lock_keys';
use aliased 'AI::Prolog::Engine';
use aliased 'AI::Prolog::Parser';
use aliased 'AI::Prolog::TermList::Clause';
sub new {
my $self = bless {
ht => {},
primitives => {}, # only uses keys
oldIndex => "",
} => shift;
lock_keys %$self;
return $self;
}
sub ht { shift->{ht} } # temp hack XXX
sub to_string {
my $self = shift;
return "{"
. (
join ', ' => map { join '=' => $_->[0], $_->[1] }
sort { $a->[2] <=> $b->[2] }
map { [ $_, $self->_sortable_term( $self->{_vardict}{$_} ) ] }
keys %{ $self->{ht} }
) . "}";
}
sub _sortable_term {
my ( $self, $term ) = @_;
my $string = $term->to_string;
my $number = substr $string => 1;
return $string, $number;
}
sub put {
my ( $self, $key, $termlist ) = @_;
$self->{ht}{$key} = $termlist;
}
sub elements { [ values %{ shift->{ht} } ] }
sub reset {
my $self = shift;
$self->{ht} = {};
$self->{primitives} = {};
$self->{oldIndex} = '';
}
sub consult {
my ( $self, $program ) = @_;
$self->{oldIndex} = '';
return Parser->consult( $program, $self );
}
sub add_primitive {
my ( $self, $clause ) = @_;
my $term = $clause->term;
my $predicate = $term->predicate;
my $c = $self->{ht}{$predicate};
if ($c) {
while ( $c->next_clause ) {
$c = $c->next_clause;
}
$c->next_clause($clause);
}
else {
$self->{primitives}{$predicate} = 1;
$self->{ht}{$predicate} = $clause;
}
}
sub add_clause {
my ( $self, $clause ) = @_;
my $term = $clause->term;
my $predicate = $term->predicate;
if ( $self->{primitives}{$predicate} ) {
carp("Trying to modify primitive predicate: $predicate");
return;
}
unless ( $predicate eq $self->{oldIndex} ) {
delete $self->{ht}{$predicate};
$self->{ht}{$predicate} = $clause;
$self->{oldIndex} = $predicate;
}
else {
my $c = $self->{ht}{$predicate};
while ( $c->next_clause ) {
$c = $c->next_clause;
}
$c->next_clause($clause);
}
}
sub assert {
my ( $self, $term ) = @_;
$term = $term->clean_up;
# XXX whoops. Need to check exact semantics in Term
my $newC = Clause->new( $term->deref, undef );
my $predicate = $term->predicate;
if ( $self->{primitives}{$predicate} ) {
carp("Trying to assert a primitive: $predicate");
return;
}
my $c = $self->{ht}{$predicate};
if ($c) {
while ( $c->next_clause ) {
$c = $c->next_clause;
}
$c->next_clause($newC);
}
else {
$self->{ht}{$predicate} = $newC;
}
}
sub asserta {
my ( $self, $term ) = @_;
my $predicate = $term->predicate;
if ( $self->{primitives}{$predicate} ) {
carp("Trying to assert a primitive: $predicate");
return;
}
$term = $term->clean_up;
my $newC = Clause->new( $term->deref, undef );
my $c = $self->{ht}{$predicate};
$newC->next_clause($c);
$self->{ht}{$predicate} = $newC;
}
sub retract {
my ( $self, $term, $stack ) = @_;
my $newC = Clause->new( $term, undef ); #, undef);
my $predicate = $term->predicate;
if ( exists $self->{primitives}{$predicate} ) {
carp("Trying to retract a primitive: $predicate");
return;
}
my $cc;
my $c = $self->{ht}{$predicate};
while ($c) {
my $vars = [];
my $xxx = $c->term->refresh($vars);
my $top = @{$stack};
if ( $xxx->unify( $term, $stack ) ) {
if ($cc) {
$cc->next_clause( $c->next_clause );
}
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;
if ( $self->{primitives}{$predicate} ) {
carp("Trying to retractall primitives: $predicate");
return;
}
delete $self->{ht}{$predicate};
return 1;
}
sub get {
my ( $self, $term ) = @_;
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
AI::Prolog::KnowledgeBase - The Prolog database.
=head1 SYNOPSIS
my $kb = KnowledgeBase->new;
=head1 DESCRIPTION
There are no user-serviceable parts inside here. See L<AI::Prolog|AI::Prolog>
for more information. If you must know more, there are a few comments
sprinkled through the code.
=head1 AUTHOR
Curtis "Ovid" Poe, E<lt>moc tod oohay ta eop_divo_sitrucE<gt>
lib/AI/Prolog/Parser.pm view on Meta::CPAN
use aliased 'AI::Prolog::Term::Number';
use aliased 'AI::Prolog::TermList';
use aliased 'AI::Prolog::TermList::Clause';
use aliased 'AI::Prolog::TermList::Primitive';
my $ATOM = qr/[[:alpha:]][[:alnum:]_]*/;
use constant NULL => 'null';
sub new {
my ( $class, $string ) = @_;
my $self = bless {
_str => PreProcessor->process($string),
_posn => 0,
_start => 0,
_varnum => 0,
_internal => 0,
_vardict => {},
} => $class;
lock_keys %$self;
return $self;
}
sub _vardict_to_string {
my $self = shift;
return "{"
. (
join ', ' => map { join '=' => $_->[0], $_->[1] }
sort { $a->[2] <=> $b->[2] }
map { [ $_, $self->_sortable_term( $self->{_vardict}{$_} ) ] }
keys %{ $self->{_vardict} }
) . "}";
}
sub _sortable_term {
my ( $self, $term ) = @_;
my $string = $term->to_string;
my $number = substr $string => 1;
return $string, $number;
}
sub to_string {
my $self = shift;
my $output = Clone::clone($self);
$output->{_vardict} = $self->_vardict_to_string;
return "{"
. substr( $self->{_str}, 0, $self->{_posn} ) . " ^ "
. substr( $self->{_str}, $self->{_posn} ) . " | "
. $self->_vardict_to_string . " }";
}
sub _posn { shift->{_posn} }
sub _str { shift->{_str} }
sub _start { shift->{_start} }
sub _varnum { shift->{_varnum} }
sub _vardict { shift->{_vardict} }
sub _internal {
my $self = shift;
if (@_) {
$self->{_internal} = shift;
return $self;
}
return $self->{_internal};
}
# get the current character
sub current {
my $self = shift;
return '#' if $self->empty;
return substr $self->{_str} => $self->{_posn}, 1;
}
# peek at the next character
sub peek {
my $self = shift;
return '#' if $self->empty;
return substr( $self->{_str} => ( $self->{_posn} + 1 ), 1 ) || '#';
}
# is the parsestring empty?
sub empty {
my $self = shift;
return $self->{_posn} >= length $self->{_str};
}
my $LINENUM = 1;
sub linenum {
my $self = shift;
if (@_) {
$LINENUM = shift;
return $self;
}
$LINENUM;
}
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
sub getname {
my $self = shift;
$self->{_start} = $self->{_posn};
my $getname;
if ( $self->current =~ /['"]/ ) {
# Normally, Prolog distinguishes between single and double quoted strings
my $string = substr $self->{_str} => $self->{_start};
$getname = extract_delimited($string);
$self->{_posn} += length $getname;
return substr $getname => 1, length($getname) - 2; # strip the quotes
}
else {
my $string = substr $self->{_str} => $self->{_start};
($getname) = $string =~ /^($ATOM)/;
$self->{_posn} += length $getname;
return $getname;
}
}
# recognize a number
# XXX same issues as getname
sub getnum {
my $self = shift;
$self->{_start} = $self->{_posn};
my $string = substr $self->{_str} => $self->{_start};
my ($getnum) = $string =~ /^($RE{num}{real})/;
if ( '.' eq substr $getnum => -1, 1 ) {
$getnum = substr $getnum => 0, length($getnum) - 1;
}
$self->{_posn} += length $getnum;
return $getnum;
}
# get the term corresponding to a name.
# if the name is new, create a new variable
sub getvar {
my $self = shift;
my $string = $self->getname;
my $term = $self->{_vardict}{$string};
unless ($term) {
$term = Term->new( $self->{_varnum}++ ); # XXX wrong _varnum?
$self->{_vardict}{$string} = $term;
}
return ( $term, $string );
}
my $ANON = 'a';
sub get_anon {
my $self = shift;
# HACK!!!
my $string = '___' . $ANON++;
$self->advance;
my $term = $self->{_vardict}{$string};
unless ($term) {
$term = Term->new( $self->{_varnum}++ ); # XXX wrong _varnum?
$self->{_vardict}{$string} = $term;
}
return ( $term, $string );
}
# handle errors in one place
sub parseerror {
my ( $self, $character ) = @_;
my $linenum = $self->linenum;
croak "Unexpected character: ($character) at line number $linenum";
}
# skips whitespace and prolog comments
sub skipspace {
my $self = shift;
$self->advance while $self->current =~ /[[:space:]]/;
_skipcomment($self);
}
# XXX Other subtle differences
sub _skipcomment {
my $self = shift;
if ( $self->current eq '%' ) {
while ( $self->current ne "\n" && $self->current ne "#" ) {
$self->advance;
}
$self->skipspace;
}
if ( $self->current eq "/" ) {
$self->advance;
if ( $self->current ne "*" ) {
$self->parseerror("Expecting '*' after '/'");
}
$self->advance;
while ( $self->current ne "*" && $self->current ne "#" ) {
$self->advance;
}
$self->advance;
if ( $self->current ne "/" ) {
$self->parseerror("Expecting terminating '/' on comment");
}
$self->advance;
$self->skipspace;
}
}
# reset the variable dictionary
sub nextclause {
my $self = shift;
$self->{_vardict} = {};
$self->{_varnum} = 0;
}
# takes a hash and extends it with the clauses in the string
# $program is a string representing a prolog program
# $db is an initial program that will be augmented with the
# clauses parsed.
# class method, not an instance method
sub consult {
my ( $class, $program, $db ) = @_;
$db ||= KnowledgeBase->new;
my $self = $class->new($program);
$self->linenum(1);
$self->skipspace;
until ( $self->empty ) {
my $termlist = $self->_termlist;
my $head = $termlist->term;
my $body = $termlist->next;
my $is_primitive = $body && $body->isa(Primitive);
unless ($is_primitive) {
my $predicate = $head->predicate;
$is_primitive = exists $db->{primitives}{$predicate};
}
my $add = $is_primitive ? 'add_primitive' : 'add_clause';
my $clause = Clause->new( $head, $body );
my $adding_builtins = Engine->_adding_builtins;
$clause->is_builtin(1) if $adding_builtins;
$db->$add( $clause, $adding_builtins );
$self->skipspace;
$self->nextclause; # new set of vars
}
return $db;
}
sub resolve {
my ( $class, $db ) = @_;
foreach my $termlist ( values %{ $db->ht } ) {
$termlist->resolve($db);
}
}
sub _termlist {
my ($self) = @_;
my $termlist = TermList->new;
my @ts = $self->_term;
$self->skipspace;
if ( $self->current eq ':' ) {
$self->advance;
if ( $self->current eq '=' ) {
# we're parsing a primitive
$self->advance;
$self->skipspace;
my $id = $self->getnum;
$self->skipspace;
$termlist->{term} = $ts[0];
$termlist->{next} = Primitive->new($id);
}
elsif ( $self->current ne '-' ) {
$self->parseerror("Expected '-' after ':'");
}
else {
$self->advance;
$self->skipspace;
push @ts => $self->_term;
$self->skipspace;
while ( $self->current eq ',' ) {
$self->advance;
$self->skipspace;
push @ts => $self->_term;
$self->skipspace;
}
my @tsl;
for my $j ( reverse 1 .. $#ts ) {
$tsl[$j] = $termlist->new( $ts[$j], $tsl[ $j + 1 ] );
}
$termlist->{term} = $ts[0];
$termlist->{next} = $tsl[1];
}
}
else {
$termlist->{term} = $ts[0];
$termlist->{next} = undef;
}
if ( $self->current ne '.' ) {
$self->parseerror("Expected '.' Got '@{[$self->current]}'");
}
$self->advance;
return $termlist;
}
# This constructor is the simplest way to construct a term. The term is given
# in standard notation.
# Example: my $term = Term->new(Parser->new("p(1,a(X,b))"));
sub _term {
my ($self) = @_;
my $term = Term->new( undef, 0 );
my $ts = [];
my $i = 0;
$self->skipspace; # otherwise we crash when we hit leading
# spaces
if ( $self->current =~ /^[[:lower:]'"]$/ ) {
$term->{functor} = $self->getname;
$term->{bound} = 1;
$term->{deref} = 0;
if ( '(' eq $self->current ) {
$self->advance;
$self->skipspace;
$ts->[ $i++ ] = $self->_term;
$self->skipspace;
while ( ',' eq $self->current ) {
$self->advance;
$self->skipspace;
$ts->[ $i++ ] = $self->_term;
$self->skipspace;
}
if ( ')' ne $self->current ) {
$self->parseerror(
"Expecting: ')'. Got (@{[$self->current]})");
}
$self->advance;
$term->{args} = [];
$term->{args}[$_] = $ts->[$_] for 0 .. ( $i - 1 );
$term->{arity} = $i;
}
else {
$term->{arity} = 0;
}
}
elsif ( $self->current =~ /^[[:upper:]]$/ ) {
$term->{bound} = 1;
$term->{deref} = 1;
my ( $ref, $string ) = $self->getvar;
$term->{ref} = $ref;
$term->{varname} = $string;
}
elsif ( '_' eq $self->current && $self->peek =~ /^[\]\|\.;\s\,\)]$/ ) {
# temporary hack to allow anonymous variables
# this should really be cleaned up
$term->{bound} = 1;
$term->{deref} = 1;
my ( $ref, $string ) = $self->get_anon;
$term->{ref} = $ref;
$term->{varname} = $string;
}
elsif ( $self->current =~ /^[-.[:digit:]]$/ ) {
return Number->new( $self->getnum );
}
elsif ( '[' eq $self->current ) {
$self->advance;
if ( ']' eq $self->current ) {
$self->advance;
$term->{functor} = NULL;
$term->{arity} = 0;
$term->{bound} = 1;
$term->{deref} = 0;
}
else {
$self->skipspace;
$ts->[ $i++ ] = $self->_term;
$self->skipspace;
while ( ',' eq $self->current ) {
$self->advance;
$self->skipspace;
$ts->[ $i++ ] = $self->_term;
$self->skipspace;
}
if ( '|' eq $self->current ) {
$self->advance;
$self->skipspace;
$ts->[ $i++ ] = $self->_term;
$self->skipspace;
}
else {
$ts->[ $i++ ] = $term->new( NULL, 0 );
}
if ( ']' ne $self->current ) {
$self->parseerror("Expecting ']'");
}
$self->advance;
$term->{bound} = 1;
$term->{deref} = 0;
$term->{functor} = "cons";
$term->{arity} = 2;
$term->{args} = [];
for my $j ( reverse 1 .. $i - 2 ) {
my $term = $term->new( "cons", 2 );
$term->setarg( 0, $ts->[$j] );
$term->setarg( 1, $ts->[ $j + 1 ] );
$ts->[$j] = $term;
}
$term->{args}[0] = $ts->[0];
$term->{args}[1] = $ts->[1];
}
}
elsif ( '!' eq $self->current ) {
$self->advance;
return $term->CUT;
}
else {
$self->parseerror(
"Term should begin with a letter, a digit, or '[', not a @{[$self->current]}"
);
}
return $term;
}
1;
__END__
=head1 NAME
AI::Prolog::Parser - A simple Prolog parser.
=head1 SYNOPSIS
my $database = Parser->consult($prolog_text).
=head1 DESCRIPTION
There are no user-serviceable parts inside here. See L<AI::Prolog|AI::Prolog>
for more information. If you must know more, there are a few comments
sprinkled through the code.
=head1 SEE ALSO
W-Prolog: L<http://goanna.cs.rmit.edu.au/~winikoff/wp/>
lib/AI/Prolog/Parser/PreProcessor.pm view on Meta::CPAN
package AI::Prolog::Parser::PreProcessor;
$REVISION = '$Id: PreProcessor.pm,v 1.2 2005/08/06 23:28:40 ovid Exp $';
$VERSION = '0.01';
use strict;
use warnings;
use aliased 'AI::Prolog::Parser::PreProcessor::Math';
sub process {
my ($class, $prolog) = @_;
# why the abstraction? Because I want DCGs in here, too. Maybe
# other stuff ...
$prolog = Math->process($prolog);
return $prolog;
}
1;
__END__
=head1 NAME
AI::Prolog::Parser::PreProcessor - The AI::Prolog Preprocessor
=head1 SYNOPSIS
my $program = AI::Prolog::Parser::Preprocessor->process($prolog_text).
=head1 DESCRIPTION
This code reads in the Prolog text and rewrites it to a for that is suitable
for the L<AI::Prolog::Parser|AI::Prolog::Parser> to read. Users of
L<AI::Prolog||AI::Prolog> should never need to know about this.
=head1 AUTHOR
Curtis "Ovid" Poe, E<lt>moc tod oohay ta eop_divo_sitrucE<gt>
lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN
# ** must be before *
my $op = qr{(?:\*\*|[-+*/%])};
my $compare = qr/(?:(?:\\|=)?=|is|[<>]=?)/;
my $lparen = qr/\(/;
my $rparen = qr/\)/;
# Having a word boundary prior to $num breaks the regex
# when trying to match negative numbers
my $simple_math_term = qr/(?!\.(?![0-9]))(?:$num\b|\b$var\b)/;
my $simple_rhs = qr/
$simple_math_term
(?:
\s*
$op
\s*
$simple_math_term
)*
/x;
my $simple_group_term = qr/$lparen\s*$simple_rhs\s*$rparen/;
my $math_term = qr/(?:$simple_math_term|$simple_group_term)/;
my $complex_rhs = qr/
$math_term
(?:
\s*
$op
\s*
$math_term
)*
/x;
my $complex_group_term = qr/$lparen\s*$complex_rhs\s*$rparen/;
my $final_math_term = qr/(?:$math_term|$complex_group_term)/;
my $rhs = qr/
$final_math_term
(?:
\s*
$op
\s*
$final_math_term
)*
/x;
my $expression = qr/
(
($simple_math_term)
\s+
($compare)
\s+
($rhs)
)
(?=[,.])
/x;
my %convert = (
qw{
is is
= eq
+ plus
/ div
- minus
% mod
* mult
** pow
< lt
<= le
> gt
>= ge
== 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);
my @tokens;
while ( my $token = $lexer->() ) {
push @tokens => $token;
}
return \@tokens;
}
sub _lexer {
my $rhs = shift;
# the entire "$prev_op" thing is to allow the lexer to be aware of '7 + -3'
# $op_ok is false on the first pass because it can never be first, but we
# might have '-7 * (-2 + 3)'
my $op_ok = 0;
return sub {
LEXER: {
$op_ok = 0, return [ 'OP', $1 ]
if $op_ok && $rhs =~ /\G ($op) /gcx;
$op_ok = 1, return [ 'ATOM', $1 ]
if $rhs =~ /\G ($simple_math_term) /gcx;
$op_ok = 0, return [ 'LPAREN', '(' ]
if $rhs =~ /\G $lparen /gcx;
$op_ok = 1, return [ 'RPAREN', ')' ]
if $rhs =~ /\G $rparen /gcx;
redo LEXER if $rhs =~ /\G \s+ /gcx;
}
};
}
sub _parse {
my ( $class, $tokens ) = @_;
my $parens_left = 1;
REDUCE: while ($parens_left) {
my ( $first, $last );
for my $i ( 0 .. $#$tokens ) {
my $token = $tokens->[$i];
next unless $token;
if ( "(" eq _as_string($token) ) {
$first = $i;
}
if ( ")" eq _as_string($token) ) {
unless ( defined $first ) {
# XXX I should probably cache the string and show it.
# XXX But it doesn't matter because that shouldn't happen here
croak(
"Parse error in math pre-processor. Mismatched parens"
);
}
$last = $i;
$tokens->[$first] = $class->_parse_group(
[ @{$tokens}[ $first + 1 .. $last - 1 ] ] );
undef $tokens->[$_] for $first + 1 .. $last;
@$tokens = grep $_ => @$tokens;
undef $first;
undef $last;
redo REDUCE;
}
}
$parens_left = 0 unless defined $first;
}
return _as_string( $class->_parse_group($tokens) );
}
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;
}
#main::diag Dumper $tokens;
return $tokens->[0]; # should never have more than on token left
}
sub _prev_token {
my ( $tokens, $index ) = @_;
for my $i ( reverse 0 .. $index - 1 ) {
return $i if defined $tokens->[$i];
}
}
sub _next_token {
my ( $tokens, $index ) = @_;
for my $i ( $index + 1 .. $#$tokens ) {
return $i if defined $tokens->[$i];
}
}
sub _as_string { ref $_[0] ? $_[0][1] : $_[0] }
sub match { shift; shift =~ $expression }
# The following are testing hooks
sub _compare { shift; shift =~ /^$compare$/ }
sub _op { shift; shift =~ /^$op$/ }
lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN
1;
__END__
=head1 NAME
AI::Prolog::Parser::PreProcessor::Math - The AI::Prolog math macro
=head1 SYNOPSIS
my $program = AI::Prolog::Parser::PreProcessor::Math->process($prolog_text).
=head1 DESCRIPTION
This code reads in the Prolog text and rewrites it to a for that is suitable
for the L<AI::Prolog::Parser|AI::Prolog::Parser> to read. Users of
L<AI::Prolog||AI::Prolog> should never need to know about this.
=head1 TODO
Constant folding for performance improvment. No need to internally have
( run in 0.460 second using v1.01-cache-2.11-cpan-4d50c553e7e )