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
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
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)
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).
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.
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
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
lib/AI/Prolog/Article.pod view on Meta::CPAN
$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:
lib/AI/Prolog/Article.pod view on Meta::CPAN
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.
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
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>
lib/AI/Prolog/Engine.pm view on Meta::CPAN
} => $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.
lib/AI/Prolog/Engine.pm view on Meta::CPAN
# 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;
lib/AI/Prolog/Engine.pm view on Meta::CPAN
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);
lib/AI/Prolog/Engine.pm view on Meta::CPAN
=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
lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN
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$/ }
sub _simple_rhs { shift; shift =~ /^$simple_rhs$/ }
sub _simple_group_term { shift; shift =~ /^$simple_group_term$/ }
sub _simple_math_term { shift; shift =~ /^$simple_math_term$/ }
sub _math_term { shift; shift =~ /^$math_term$/ }
sub _complex_rhs { shift; shift =~ /^$complex_rhs$/ }
sub _complex_group_term { shift; shift =~ /^$complex_group_term$/ }
lib/AI/Prolog/Term.pm view on Meta::CPAN
. "). Cannot bind to nonvar!" );
}
}
# unbinds a term -- i.e., resets it to a variable
sub unbind {
my $self = shift;
$self->{bound} = 0;
$self->{ref} = undef;
# XXX Now possible for a bind to have had no effect so ignore safety test
# XXX if (bound) bound = false;
# XXX else IO.error("Term.unbind","Can't unbind var!");
}
# set specific arguments. A primitive way of constructing terms is to
# create them with Term(s,f) and then build up the arguments. Using the
# parser is much simpler
sub setarg {
my ( $self, $pos, $val ) = @_;
if ( $self->{bound} && !$self->{deref} ) {
#!/usr/bin/perl -w
use strict;
use Test::More;
eval "use Test::Pod 1.06";
plan skip_all => "Test::Pod 1.06 required for testing POD" if $@;
all_pod_files_ok();
t/05examples.t view on Meta::CPAN
#!/usr/local/bin/perl
use strict;
use warnings;
#use Test::More 'no_plan';
use Test::More tests => 6;
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
}
use lib '../lib/';
use aliased 'AI::Prolog';
t/10choicepoint.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 10choicepoint.t,v 1.2 2005/02/13 21:01:02 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 11;
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::ChoicePoint';
use_ok($CLASS) or die;
}
#!/usr/bin/perl
# '$Id: 20term.t,v 1.6 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 92;
#use Test::More 'no_plan';
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::Term';
use_ok($CLASS) or die;
}
#!/usr/bin/perl
# '$Id: 25cut.t,v 1.1 2005/02/20 18:27:55 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 27;
#use Test::More 'no_plan';
#XXX This is a bit annoying. Term knows about its subclass, CUT,
# and this forces us to use Term before we use_ok($CLASS).
use aliased 'AI::Prolog::Term';
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
t/25number.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 25number.t,v 1.1 2005/02/20 18:27:55 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 34;
#use Test::More 'no_plan';
#XXX This is a bit annoying. Term knows about its subclass, CUT,
# and this forces us to use Term before we use_ok($CLASS).
use aliased 'AI::Prolog::Term';
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
t/30termlist.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 30termlist.t,v 1.3 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
#use Test::More 'no_plan';
use Test::More tests => 14;
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::TermList';
use_ok($CLASS) or die;
}
t/35clause.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 35clause.t,v 1.2 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
#use Test::More 'no_plan';
use Test::More tests => 14;
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::TermList::Clause';
use_ok($CLASS) or die;
}
t/35primitive.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 35primitive.t,v 1.2 2005/06/20 07:36:48 ovid Exp $';
use warnings;
use strict;
#use Test::More 'no_plan';
use Test::More tests => 6;
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::TermList::Primitive';
use_ok($CLASS) or die;
}
# XXX These are mostly stub tests. I'm going to have to
# come back and flesh these out more
use aliased 'AI::Prolog::Parser';
use aliased 'AI::Prolog::Term';
can_ok $CLASS, 'new';
ok my $primitive = $CLASS->new(7),
'... and creating a new primitive from a parser object should succeed';
isa_ok $primitive, $CLASS, '... and the object it creates';
#!/usr/bin/perl
# '$Id: 35step.t,v 1.2 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
#use Test::More 'no_plan';
use Test::More tests => 12;
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::TermList::Step';
use_ok($CLASS) or die;
}
# XXX These are mostly stub tests. I'm going to have to
# come back and flesh these out more
use aliased 'AI::Prolog::Parser';
use aliased 'AI::Prolog::TermList';
use aliased 'AI::Prolog::Term';
use aliased 'AI::Prolog::TermList::Primitive';
my $termlist = Parser->new("p(X,p(X,Y)).")->_termlist;
#$termlist->next(Primitive->new(7)); # doesn't have to be a primitive. Just for testing
can_ok $CLASS, 'new';
ok my $step = $CLASS->new($termlist),
'... and creating a new step from a parser object should succeed';
isa_ok $step, $CLASS, '... and the object it creates';
can_ok $step, 'to_string';
is $step->to_string, "\n\tSTEP",
'... and its to_string representation should be correct';
can_ok $step, 'term';
ok my $term = $step->term, '... and calling it should succeed';
isa_ok $term, Term, '... and the object it returns';
is $term->functor, 'STEP', '... and it should have the correct functor';
is $term->arity, 0, '... and the correct arity';
can_ok $step, 'next';
diag "Flesh out the Step tests when we start using this more";
__END__
ok my $termlist = $step->next, '... and calling it should succeed';
isa_ok $termlist, TermList, '... and the object it returns';
is_deeply $termlist, $termlist, '... and it should be the termlist we instantiated the Step with';
t/40parser.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 40parser.t,v 1.6 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
use Test::More;
BEGIN {
eval 'use Test::MockModule';
if ($@) {
plan skip_all => 'Test::MockModule required for this';
} else {
plan tests => 76;
}
}
#use Test::More 'no_plan';
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::Parser';
t/50engine.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 50engine.t,v 1.10 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 35;
#use Test::More 'no_plan';
use Clone qw/clone/;
my $CLASS;
BEGIN {
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::Engine';
t/50engine.t view on Meta::CPAN
once/1
or/2
perlcall2/2
print/1
println/1
retract/1
trace/0
true/0
var/1
wprologcase/3
wprologtest/2
write/1
writeln/1
};
@keys = sort keys %{$database->ht};
is_deeply \@keys, \@expected,
'... and the basic prolog terms should be bootstrapped';
can_ok $engine, 'results';
is $engine->results, 'append([], [a,b,c,d], [a,b,c,d])',
'... calling it the first time should provide the first unification';
t/50engine.t view on Meta::CPAN
my $bootstrapped_db = clone($database);
$query = Term->new('append(X,[d],[a,b,c,d]).');
can_ok $engine, 'query';
$engine->query($query);
is $engine->results,'append([a,b,c], [d], [a,b,c,d])',
'... and it should let us issue a new query against the same db';
ok !$engine->results, '... and it should not return spurious results';
# this will eventually test data structures
can_ok $CLASS, 'formatted';
$engine->formatted(0);
$engine->query(Term->new('append(X,Y,[a,b,c,d])'));
my $result = $engine->results;
is_deeply $result->X, [], '... and the X result should be correct';
is_deeply $result->Y, [qw/a b c d/], '... and the Y result should be correct';
$result = $engine->results;
t/60aiprolog.t view on Meta::CPAN
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 5;
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog';
use_ok($CLASS, ':all') or die;
}
t/70builtins.t view on Meta::CPAN
use warnings;
use strict;
use Test::More;
BEGIN {
eval q{
use Test::MockModule;
use Test::Differences};
if ($@) {
plan skip_all => "Test::MockModule, Test::Differences required for this";
} else {
plan tests => 39;
}
}
#use Test::More qw/no_plan/;
use Clone qw/clone/;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
}
t/70builtins.t view on Meta::CPAN
'... and it should behave as expected';
$prolog->query('loves(sally,X)');
is $prolog->results, 'loves(sally, A)',
'... and the asserted fact should remain unchanged.';
$prolog->do("retract(loves(ovid,perl)).");
$prolog->query("loves(ovid,X)");
ok ! $prolog->results,
"retract(X) should remove a fact from the database";
my @test_me;
sub test_me {
my ( $first, $second, $third, $fourth ) = @_;
@test_me = ( "\L$first", "\U$second", "\u$third", $fourth );
return;
}
$prolog->query(q{perlcall2( "test_me", ["FIND ME","and me","also me", 42] ).});
ok $prolog->results, 'Called a perl function ok';
is_deeply \@test_me, ["find me","AND ME", "Also me", 42],
'Perl function got results ok';
@test_me = ();
$prolog->query(q{perlcall2( X, ["Uh..."] ).});
ok ! $prolog->results, "Didn't call an unknown perl function";
TODO: {
local $TODO = "Can't prohibit unbound values in perlcall/2";
@test_me = ();
$prolog->query(q{perlcall2( "test_me", ["Uh...", X] ).});
ok ! $prolog->results, "Didn't call a perl function w/ unknown variables";
}
ok $prolog = Prolog->new(<<'END_PROLOG'), 'We should be able to parse a cut (!) operator';
append([], X, X) :- !.
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
$prolog->query('append(X,Y,[a,b,c,d])');
is $prolog->results, 'append([], [a,b,c,d], [a,b,c,d])',
'... and it should return the correct results';
ok ! $prolog->results, '... and halt backtracking appropriately';
$prolog = Prolog->new(<<'END_PROLOG');
test_var(VAR,X) :-
if(var(VAR), eq(X,is_var), eq(X,not_var)).
END_PROLOG
$prolog->query('test_var(X, Y)');
is $prolog->results, 'test_var(A, is_var)', 'var(X) should evaluate to true';
$prolog->query('test_var(42, Y)');
is $prolog->results, 'test_var(42, not_var)',
'... and var(42) should evaluate to not true';
$prolog->query('test_var(ovid, Y)');
is $prolog->results, 'test_var(ovid, not_var)',
'... and var(ovid) should evaluate to not true';
{
my $faux_kb = Test::MockModule->new(KnowledgeBase);
my @stdout;
$faux_kb->mock(_print => sub { push @stdout => @_ });
$prolog->query('listing.');
$prolog->results;
my $results = join ''=> @stdout;
my $count = ($results =~ s/(\d+\.\s+\w+\/\d+:)//g);
#!/usr/bin/perl
# '$Id: 80math.t,v 1.5 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 31;
#use Test::More qw/no_plan/;
use Clone qw/clone/;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
}
use aliased 'AI::Prolog';
t/80preprocessor.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 80preprocessor.t,v 1.2 2005/06/20 07:36:48 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 8;
#use Test::More qw/no_plan/;
use aliased 'AI::Prolog';
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::Parser::PreProcessor';
use_ok($CLASS) or die;
t/80preprocessor_math.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 80preprocessor_math.t,v 1.3 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 140;
#use Test::More qw/no_plan/;
my $CLASS;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog::Parser::PreProcessor::Math';
use_ok($CLASS) or die;
}
t/90results.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 50engine.t,v 1.10 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
use Test::More tests => 6;
my $CLASS;
BEGIN {
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'AI::Prolog';
use_ok($CLASS) or die;
}
t/99regression.t view on Meta::CPAN
#!/usr/bin/perl
# '$Id: 99regression.t,v 1.4 2005/08/06 23:28:40 ovid Exp $';
use warnings;
use strict;
use Test::More;
BEGIN {
eval q{use Test::MockModule};
if ($@) {
plan skip_all => "Test::MockModule, Test::Exception required for this";
} else {
plan tests => 5;
}
}
#use Test::More qw/no_plan/;
BEGIN
{
chdir 't' if -d 't';
unshift @INC => '../lib';
}
use aliased 'AI::Prolog';
( run in 0.686 second using v1.01-cache-2.11-cpan-87723dcf8b7 )