res results from the CPAN

AI-Prolog

view release on metacpan or search on metacpan

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 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

Changes view on Meta::CPAN

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94         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)

Changes view on Meta::CPAN

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145       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).

Changes view on Meta::CPAN

183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205         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.

MANIFEST view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18 bin/aiprolog
Changes
data/sleepy.pro
data/spider.pro
examples/append.pl
examples/benchmark.pl
examples/cut.pl
examples/data_structures.pl
examples/hanoi.pl
examples/if_else.pl
examples/member.pl
examples/monkey.pl
examples/path.pl
examples/schedule.pl
examples/trace.pl
lib/AI/Prolog.pm
lib/AI/Prolog/Article.pod
lib/AI/Prolog/Builtins.pod

MANIFEST view on Meta::CPAN

46
47
48
49
50
51
52
53
54
55
56
57 t/35clause.t
t/35primitive.t
t/35step.t
t/40parser.t
t/50engine.t
t/60aiprolog.t
t/70builtins.t
t/80math.t
t/80preprocessor.t
t/80preprocessor_math.t
t/90results.t
t/99regression.t

META.yml view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 --- #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

README view on Meta::CPAN

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25  
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

bin/aiprolog view on Meta::CPAN

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97         }
        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';

bin/aiprolog view on Meta::CPAN

121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148 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.

bin/aiprolog view on Meta::CPAN

160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229  
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

1
2
3
4
5
6
7
8
9
10
11
12
13
14 /* "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).

data/sleepy.pro view on Meta::CPAN

324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344         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),

data/spider.pro view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12 %"Spider" -- A Sample Adventure Game in Prolog
% David Matuszek, Villanova University
% http://www.csc.vill.edu/~dmatusze/resources/prolog/spider.html
 
% This defines my current location
 
i_am_at(meadow).
 
% These facts describe how the rooms are connected.
 
path(spider, d, cave).
path(cave, u, spider).

examples/append.pl view on Meta::CPAN

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32 $Data::Dumper::Terse = 1;
 
use AI::Prolog 0.64;
my $prolog = AI::Prolog->new(<<"END_PROLOG");
append([], X, X).
append([W|X], Y, [W|Z]) :- append(X, Y, Z).
END_PROLOG
 
print "Appending two lists 'append([a],[b,c,d],Z).'\n";
$prolog->query('append([a],[b,c,d],Z).');
while (my $result = $prolog->results) {
    print Dumper($result),"\n";
}
 
print "\nWhich lists appends to a known list to form another known list?\n'append(X,[b,c,d],[a,b,c,d]).'\n";
$prolog->query('append(X,[b,c,d],[a,b,c,d]).');
while (my $result = $prolog->results) {
    print Dumper($result),"\n";
}
 
print "\nWhich lists can be appended to form a given list?\n'append(X, Y, [foo, bar, 7, baz]).'\n";
my $list = $prolog->list(qw/foo bar 7 baz/);
$prolog->query("append(X,Y,[$list]).");
while (my $result = $prolog->results) {
    print Dumper($result),"\n";
}

examples/benchmark.pl view on Meta::CPAN

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24 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]) :-

examples/cut.pl view on Meta::CPAN

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31 my $prolog = Prolog->new(<<'END_PROLOG');
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
 
Engine->formatted(1);
$prolog->query('append(X,Y,[a,b,c,d]).');
 
print "Without a cut:\n";
 
while (my $result = $prolog->results) {
    print $result;
}
 
$prolog = Prolog->new(<<'END_PROLOG');
append([], X, X) :- !.   % note the cut operator
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
 
print "\nWith a cut:\n";
$prolog->query('append(X,Y,[a,b,c,d]).');
while (my $result = $prolog->results) {
    print $result;
}

examples/data_structures.pl view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62  
use strict;
use warnings;
use lib ('../lib/', 'lib/');
use Data::Dumper;
$Data::Dumper::Indent = 0;
 
use AI::Prolog;
 
# note that the following line sets an experimental interface option
AI::Prolog->raw_results(0);
my $database = <<'END_PROLOG';
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
 
my $logic = AI::Prolog->new($database);
$logic->query('append(LIST1,LIST2,[a,b,c,d]).');
while (my $result = $logic->results) {
    print Dumper($result->LIST1);
    print Dumper($result->LIST2);
}
 
 
AI::Prolog::Engine->raw_results(1);
$logic->query('append([X|Y],Z,[a,b,c,d]).');
while (my $result = $logic->results) {
    print Dumper($result);
}
 
# [HEAD|TAIL] syntax is buggy in queries with result object
#AI::Prolog::Engine->raw_results(0);
#$logic->query('append([X|Y],Z,[a,b,c,d]).');
#while (my $result = $logic->results) {
#    print Dumper($result->X);
#    print Dumper($result->Y);
#    print Dumper($result->Z);
#}
 
AI::Prolog::Engine->raw_results(0);
$logic = AI::Prolog->new(thief_prog());
$logic->query('steals(badguy, GOODS, VICTIM).');
while (my $result = $logic->results) {
    printf "badguy steals %s from %s\n"
        => $result->GOODS, $result->VICTIM;
}
 
AI::Prolog::Engine->raw_results(1);
$logic->query('steals(badguy, GOODS, VICTIM).');
while (my $result = $logic->results) {
    print Dumper($result);
}
 
sub thief_prog {
    return <<'    END_PROG';
    steals(PERP, STUFF, VICTIM) :-
        thief(PERP),
        valuable(STUFF),
        owns(VICTIM,STUFF),
        not(knows(PERP,VICTIM)).
    thief(badguy).

examples/if_else.pl view on Meta::CPAN

4
5
6
7
8
9
10
11
12
13
14
15
16
17 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

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30 classtime(Time) :- member(Time,   [morning_day1,morning_day2,noon_day1,noon_day2]).
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

25
26
27
28
29
30
31
32
33
34
35
36         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

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30  
my $query = shift || 2;
my $prolog = AI::Prolog->new(path_prog());
 
$prolog->query('solve( Dest, L).')   if $query == 1;
$prolog->query('solve( p(8,8), L).') if $query == 2; 
$prolog->query('solve( p(2,2), L).') if $query == 3;
 
my $t0 = new Benchmark;
#$prolog->trace(1);
my $results = $prolog->results;
print Dumper($results);
my $t1 = new Benchmark;
my $td = timediff($t1, $t0);
print "the code took:",timestr($td),"\n";
 
sub path_prog {
    return <<'    END_PROG';
    solve(Dest,L) :- 
       solve(p(1,1), Dest, L).
    solve(S, Dest, Sol) :-
        path(S, Dest, [S], Path),

examples/schedule.pl view on Meta::CPAN

41
42
43
44
45
46
47
48
49
50
51
52
53 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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56 #!/usr/local/bin/perl -l
 
use strict;
use warnings;
use lib ('../lib/', 'lib/');
 
use aliased 'https://metacpan.org/pod/AI::Prolog">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").

lib/AI/Prolog.pm view on Meta::CPAN

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88 use aliased 'https://metacpan.org/pod/AI::Prolog::Engine">AI::Prolog::Engine';
 
use Text::Quote;
use Regexp::Common;
 
# they don't want pretty printed strings if they're using this interface
Engine->formatted(0);
 
# Until (and unless) we figure out the weird bug that prevents some values
# binding in the external interface, we need to stick with this as the default
Engine->raw_results(1);
 
sub new {
    my ( $class, $program ) = @_;
    my $self = bless {
        _prog   => Parser->consult($program),
        _query  => undef,
        _engine => undef,
    } => $class;
    lock_keys %$self;
    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);
}

lib/AI/Prolog.pm view on Meta::CPAN

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140  
 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

lib/AI/Prolog.pm view on Meta::CPAN

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179  
See also Robert Pratte's perl.com article, "Logic Programming with Perl and
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>.

lib/AI/Prolog.pm view on Meta::CPAN

222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309 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

lib/AI/Prolog.pm view on Meta::CPAN

314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378  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

lib/AI/Prolog.pm view on Meta::CPAN

415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435 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/>

lib/AI/Prolog.pm view on Meta::CPAN

442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462 =head1 AUTHOR
 
Curtis "Ovid" Poe, E<lt>moc tod oohay ta eop_divo_sitrucE<gt>
 
Reverse the name to email me.
 
This work is based on W-Prolog, L<http://goanna.cs.rmit.edu.au/~winikoff/wp/>,
by Dr. Michael Winikoff.  Many thanks to Dr. Winikoff for granting me
permission to port this.
 
Many features also borrowed from X-Prolog L<http://www.iro.umontreal.ca/~vaucher/XProlog/>
with Dr. Jean Vaucher's permission.
 
=head1 ACKNOWLEDGEMENTS
 
Patches and other help has also been provided by: Joshua ben Jore and
Sean O'Rourke.
 
=head1 COPYRIGHT AND LICENSE
 
Copyright 2005 by Curtis "Ovid" Poe

lib/AI/Prolog/Article.pod view on Meta::CPAN

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42 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.
 
=head2 What is Logic Programming?
 
Logic programming is somewhat of a mystery to many Perl programmers because,
unlike imperative, objective, and functional styles, Perl does not have direct
support for logic programming.   There is, however, much interest in bringing
logic programming to Perl 6.  With luck the information presented here will not
be merely theoretical.
 
Logic programming is not as alien as programmers might think.  Regular
expressions, SQL and grammars are all closely related to logic programming.
The shared component of these seemingly disparate technologies is how they
I<describe> their goals rather than state how to achieve it.  This is the
essence of logic programming.  Rather than tell the computer how to achieve a
given goal, we tell the computer what the goal looks like and let it figure out
how to get there.  Because of this, some refer to logic programming as
"specification-based programming" because the specification and the program are
one and the same.
 
This article will focus on C<AI::Prolog>.  Prolog, though not a "pure" logic
programming language, is the most widely used in the field.  C<AI::Prolog> is a

lib/AI/Prolog/Article.pod view on Meta::CPAN

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71 =head2 3 Things to Learn
 
Most programming in Prolog boils down to learning three things:  facts, rules,
and queries.  The basics of these can be learned in just a few minutes and will
let you read many Prolog programs.
 
=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

lib/AI/Prolog/Article.pod view on Meta::CPAN

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111 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

lib/AI/Prolog/Article.pod view on Meta::CPAN

222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314 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.
 
=head2 How this works
 
At this point, it's worth having a bit of a digression to explain how this
works.
 
Many deductive systems in artificial intelligence are based on two algorithms:
backtracking and unification.  You're probably already familiar with backtracking
from regular expressions.  In fact, regular expressions are very similar to
Prolog in that you specify a pattern for your data and let the regex engine
worry about how to do the matching.
 
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

lib/AI/Prolog/Article.pod view on Meta::CPAN

345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365 we stated this unification is unimportant, we can ignore that.
 
We now have a fact which unifies with the first term in the rule, so we push
this information onto a stack.  Since there are still additional facts we can
try, we set a "choice point" in the stack telling us which fact we last tried.
If we have to backtrack to see a choice point, we move on to the next fact and
try again.
 
Moving on to the next term in the rule, C<male(Person)>, we know that "sally"
is unified to C<Person>, so we now try to unify C<male(sally)> with all of the
corresponding rules in the knowledge base. Since we can't, the logic engine
backs up to the last item where we could make a new choice and sees
C<parent(bill, tom)>. C<Person> gets unified with I<bill>. Then in moving to
the next rule we see that we unify with C<male(bill)>. Now, we check the first
item in the rule and see that it's C<father(Person)>. and the logic engine
reports that I<bill> is a father.
 
Note that we can then force the engine to backtrack and by continuously
following this procedure, we can determine who all the fathers are.
 
And that's how logic programming works. Simple, eh? (Well, individual items can

lib/AI/Prolog/Article.pod view on Meta::CPAN

391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439  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).

lib/AI/Prolog/Article.pod view on Meta::CPAN

442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463    
 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)

lib/AI/Prolog/Article.pod view on Meta::CPAN

478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497   <<== 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":

lib/AI/Prolog/Article.pod view on Meta::CPAN

563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597      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.
 
=item * You must remember to synchronize data structures if the data changes.
 
=item * Often you need to change your code if your relations change.
 
=item * The code can get complex, leading to more bugs.
 
=back
 
=head2 Prolog versus SQL
 
At this point, there's a good chance that you're thinking that you would just

lib/AI/Prolog/Article.pod view on Meta::CPAN

639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679  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
programming language using SQL.
 
Let's take a look at recursion and see why this is a win.
 
=head2 Recursion and Lists
 
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 | _ ]).

lib/AI/Prolog/Article.pod view on Meta::CPAN

767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794   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.
 
Perhaps the most significant is the depth-first exhaustive search algorithm
used for deduction.  This is slow and due to the dynamically typed nature of
Prolog, many of the optimizations that have been applied to databases cannot be

lib/AI/Prolog/Article.pod view on Meta::CPAN

854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874 =item * Natural language processing
 
=item * Rules-based systems
 
=item * Scheduling systems
 
=item * And much more (it was even embedded in Windows NT) 
 
=back
 
At the present time, I would not recommend C<AI::Prolog> for production work.
Attempts to bring logic programming to Perl are still relatively recent and no
module (to this author's knowledge) is currently ready for widespread use.  The
C<AI::Prolog> distribution has a number of sample programs in the C<examples/>
directory and two complete, albeit small, games in the C<data/> directory.
 
=head1 References
 
=head2 Online Resources
 
=over 4

lib/AI/Prolog/Article.pod view on Meta::CPAN

887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907 http://amzi.com/ExpertSystemsInProlog/xsipfrtop.htm
 
This free online book, also by Amzi!, walks you through building expert
systems.  It includes expert systems for solving Rubik's cube, tax preparation,
car diagnostics and many other examples.
 
=item Databases Vs AI
 
http://lsdis.cs.uga.edu/~cartic/SemWeb/DatabasesAI.ppt
 
This Powerpoint presentation discusses AI in Prolog and compares it to SQL
databases.
 
=item W-Prolog
 
http://goanna.cs.rmit.edu.au/~winikoff/wp/
 
Dr. Michael Winikoff kindly gave me permission to port this Java application to
Perl.  This formed the basis of the earliest versions.
 
=item X-Prolog

lib/AI/Prolog/Article.pod view on Meta::CPAN

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941 =item Programming in Prolog
 
http://portal.acm.org/citation.cfm?id=39071
 
This book is sometimes referred to simply as "Clocksin/Mellish".  First
published in the early 80s, this is the book that brought Prolog into the
mainstream.
 
=item The Art of Prolog
 
htp://mitpress.mit.edu/catalog/item/default.asp?ttype=2&tid=8327
 
This excellent MIT textbook is very in-depth and covers "proving" Prolog
programming, second-order logic, grammars, and many working examples.
 
=back
 
=head1 Credits
 
Many thanks to Rebekah Golden, Danny Werner and David Wheeler for their
excellents comments and insights.

lib/AI/Prolog/Builtins.pod view on Meta::CPAN

126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146  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:

lib/AI/Prolog/Builtins.pod view on Meta::CPAN

331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351 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.

lib/AI/Prolog/Builtins.pod view on Meta::CPAN

366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386  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

lib/AI/Prolog/Cookbook.pod view on Meta::CPAN

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43  
=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

lib/AI/Prolog/Cookbook.pod view on Meta::CPAN

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134     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) :-

lib/AI/Prolog/Cookbook.pod view on Meta::CPAN

150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169 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.

lib/AI/Prolog/Engine.pm view on Meta::CPAN

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74     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;
}

lib/AI/Prolog/Engine.pm view on Meta::CPAN

98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118     _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).

lib/AI/Prolog/Engine.pm view on Meta::CPAN

160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190             %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) = @_;

lib/AI/Prolog/Engine.pm view on Meta::CPAN

192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310         _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;

lib/AI/Prolog/Engine.pm view on Meta::CPAN

335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375     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.

lib/AI/Prolog/Engine.pm view on Meta::CPAN

382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417 =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

lib/AI/Prolog/Engine.pm view on Meta::CPAN

419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511  
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>

lib/AI/Prolog/Engine/Primitives.pm view on Meta::CPAN

104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143             $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;

lib/AI/Prolog/Engine/Primitives.pm view on Meta::CPAN

418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444     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;

lib/AI/Prolog/Introduction.pod view on Meta::CPAN

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118  
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

lib/AI/Prolog/KnowledgeBase.pm view on Meta::CPAN

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61     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 );

lib/AI/Prolog/KnowledgeBase.pm view on Meta::CPAN

144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164 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 {

lib/AI/Prolog/Parser.pm view on Meta::CPAN

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182     $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 );

lib/AI/Prolog/Parser.pm view on Meta::CPAN

232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259         }
        $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;

lib/AI/Prolog/Parser.pm view on Meta::CPAN

273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296         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 ':' ) {

lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63 my $rhs                = qr/
    $final_math_term
    (?:
        \s*
        $op
        \s*
        $final_math_term
    )*
/x;
 
my $expression = qr/
    (
        ($simple_math_term)
        \s+
        ($compare)
        \s+
        ($rhs)
    )
    (?=[,.])
/x;

lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102         <=    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;

lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN

194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214  
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$/ }
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$/ }

lib/AI/Prolog/Parser/PreProcessor/Math.pm view on Meta::CPAN

230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250  
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
C<is(X, plus(3, 4))> when I can do C<is(X, 5)>.  It shouldn't be too hard.
 
Figure out how to preserve line number.
 
=head1 AUTHOR
 
Curtis "Ovid" Poe, E<lt>moc tod oohay ta eop_divo_sitrucE<gt>
 
Reverse the name to email me.
 
=head1 COPYRIGHT AND LICENSE
 
Copyright 2005 by Curtis "Ovid" Poe

lib/AI/Prolog/Term.pm view on Meta::CPAN

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39 # A term is a basic data structure in Prolog
# There are three types of terms:
#   1. Values     (i.e., have a functor and arguments)
#   2. Variables  (i.e., unbound)
#   3. References (bound to another variable)
 
my $VARNUM = 1;
 
# controls where occurcheck is used in unification.
# In early Java versions, the occurcheck was always performed
# which resulted in lower performance.
 
my $OCCURCHECK = 0;
 
sub occurcheck {
    my ( $class, $value ) = @_;
    $OCCURCHECK = $value if defined $value;
    return $OCCURCHECK;
}
 
# controls printing of lists as [a,b]

lib/AI/Prolog/Term.pm view on Meta::CPAN

80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99         # if bound is false, $self is a reference to a free variable
        bound => 0,
        varid => $VARNUM++,
 
        # if bound and deref are both true, $self is a reference to a ref
        deref => 0,
        ref   => undef,
 
        ID       => undef,
        varname  => undef,
        _results => undef,
 
        #source  => "_new_var",
    } => $class;
    lock_keys %$self;
    return $self;
}
 
sub _new_with_id {
    my ( $class, $id ) = @_;

lib/AI/Prolog/Term.pm view on Meta::CPAN

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127         # if bound is false, $self is a reference to a free variable
        bound => 0,
        varid => $id,
 
        # if bound and deref are both true, $self is a reference to a ref
        deref => 0,
        ref   => undef,
 
        varname  => undef,
        ID       => undef,
        _results => undef,
 
        #source  => "_new_with_id: $id",
    } => $class;
    lock_keys %$self;
    return $self;
}
 
sub _new_from_functor_and_arity {
    my ( $class, $functor, $arity ) = @_;
    my $print_functor = defined $functor ? $functor : 'null';

lib/AI/Prolog/Term.pm view on Meta::CPAN

135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155  
        # if bound is false, $self is a reference to a free variable
        bound => 1,
        varid => 0,    # XXX ??
             # if bound and deref are both true, $self is a reference to a ref
        deref => 0,
        ref   => undef,
 
        varname  => undef,
        ID       => undef,
        _results => undef,
 
        #source  => "_new_from_functor_and_arity: ($print_functor) ($arity)",
    } => $class;
    lock_keys %$self;
    return $self;
}
 
sub varnum  {$VARNUM}              # class method
sub functor { shift->{functor} }
sub arity   { shift->{arity} }

lib/AI/Prolog/Term.pm view on Meta::CPAN

197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216         $self->{deref} = 1;
        $self->{ref}   = $term;
    }
    else {
        croak(    "AI::Prolog::Term->bind("
                . $self->to_string
                . ").  Cannot bind to nonvar!" );
    }
}
 
# unbinds a term -- i.e., resets it to a variable
sub unbind {
    my $self = shift;
    $self->{bound} = 0;
    $self->{ref}   = undef;
 
    # XXX Now possible for a bind to have had no effect so ignore safety test
    # XXX if (bound) bound = false;
    # XXX else IO.error("Term.unbind","Can't unbind var!");
}

lib/AI/Prolog/Term.pm view on Meta::CPAN

305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325     else {
        print( $indent. "args:  null" );
    }
 
#print($indent . "args:  ", scalar @{$self->{args}}) if defined $self->{args}[0];
    print( $indent . "deref:  ", ( $self->{deref} ? 'true' : 'false' ) );
    print( $indent . "varid:  ", $self->{varid}, "\n" );
}
 
# Unification is the basic primitive operation in logic programming.
# $stack: the stack is used to store the address of variables which
# are bound by the unification.  This is needed when backtracking.
 
sub unify {
    my ( $self, $term, $stack ) = @_;
 
    #_dumpit($self);
    #_dumpit($term);
 
    foreach ( $self, $term ) {
        $_ = $_->{ref} while $_->{bound} and $_->{deref};

lib/AI/Prolog/Term.pm view on Meta::CPAN

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470         return 1;
    }
 
    # do occurcheck if turned on
    return if $self->occurcheck && $term->occurs( $self->varid );
    $self->bind($term);
    push @{$stack} => $self;        # save for backtracking
    return 1;
}
 
# refresh creates new variables.  If the variables already exist
# in its arguments then they are used.  This is used when parsing
# a clause so that variables throughout the clause are shared.
# Includes a copy operation.
 
sub refresh {
    my ( $self, $term_aref ) = @_;
    if ( $self->{bound} ) {
        if ( $self->{deref} ) {
            return $self->{ref}->refresh($term_aref);
        }
        else {
            if ( 0 == $self->{arity} ) {
                return $self;
            }
            else {
                my $term = ( CORE::ref $self)
                    ->_new_from_functor_and_arity( $self->{functor},
                    $self->{arity} );
                for my $i ( 0 .. $self->{arity} - 1 ) {
                    $term->{args}[$i]
                        = $self->{args}[$i]->refresh($term_aref);
                }
                return $term;
            }
        }
    }
 
    # else unbound
    unless ( $term_aref->[ $self->{varid} ] ) {
        $term_aref->[ $self->{varid} ] = $self->new;
    }
    return $term_aref->[ $self->{varid} ];
}
 
sub to_data {
    my $self = shift;
    $self->{_results} = {};
 
    # @results is the full results, if we ever need it
    my @results = $self->_to_data($self);
    return AsObject->new( $self->{_results} ), \@results;
}
 
sub _to_data {
    my ( $self, $parent ) = @_;
    if ( defined $self->{varname} ) {
 
        # XXX here's where the [HEAD|TAIL] bug is.  The engine works fine,
        # but we can't bind TAIL to a result object and are forced to
        # switch to raw_results.
        my $varname = delete $self->{varname};
        ( $parent->{_results}{$varname} ) = $self->_to_data($parent);
        $self->{varname} = $varname;
    }
    if ( $self->{bound} ) {
        my $functor = $self->functor;
        my $arity   = $self->arity;
        return $self->ref->_to_data($parent) if $self->{deref};
        return [] if NULL eq $functor && !$arity;
        if ( "cons" eq $functor && 2 == $arity ) {
            my @result = $self->{args}[0]->_to_data($parent);
            my $term   = $self->{args}[1];
 
            while ( "cons" eq $term->getfunctor && 2 == $term->getarity ) {
                if ( $term->{varname} ) {
                  push @result => $term->_to_data($parent);
                } else {
                  push @result => $term->getarg(0)->_to_data($parent);
                }
                $term = $term->getarg(1);
            }
 
            # XXX Not really sure about this one
            push @result => $term->_to_data($parent)
                unless NULL eq $term->getfunctor && !$term->getarity;
 
            #    ? "]"
            #    : "|" . $term->_to_data($parent) . "]";
            return \@result;
        }
        else {
            my @results = $self->functor;
            if ( $self->arity ) {
 
                #push @results => [];
                my $arity = $self->arity;
                my @args  = @{ $self->args };
                if (@args) {
                    for my $i ( 0 .. $arity - 1 ) {
                        push @results => $args[$i]->_to_data($parent);
                    }
 
                    # I have no idea what the following line was doing.
                    #push @results => $args[$arity - 1]->_to_data($parent)
                }
            }
            return @results;
        }
    }    # else unbound;
    return undef;
}
 
my %varname_for;
my $varname = 'A';
 
sub to_string {
    require Data::Dumper;

lib/AI/Prolog/Term.pm view on Meta::CPAN

518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538         return $string;
    }    # else unbound;
         # return "_" . $self->varid;
    my $var = $self->{varname} || $varname_for{ $self->varid } || $varname++;
    $varname_for{ $self->varid } = $var;
    return $var;
}
 
# ----------------------------------------------------------
#  Copy a term to put in the database
#    - with new variables (freshly renumbered)
# ----------------------------------------------------------
 
# XXX XProlog
my %CVDICT;
my $CVN;
 
sub clean_up {
    my $self = shift;
    %CVDICT = ();
    $CVN    = 0;

lib/AI/Prolog/Term.pm view on Meta::CPAN

562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583             $term = $self->new( $CVN++ );
            $CVDICT{$self} = $term;    # XXX Should this be $self->to_string?
        }
    }
    return $term;
}
 
# From XProlog
sub value {
 
    # int i, res = 0;
    my $self = shift;
    my ( $i, $res ) = ( 0, 0 );
 
    unless ( $self->{bound} ) {
        my $term = $self->to_string;
        croak("Tried to to get value of unbound term ($term)");
    }
    return $self->{ref}->value if $self->{deref};
    my $functor = $self->getfunctor;
    my $arity   = $self->getarity;
    if ( 'rnd' eq $functor && 1 == $arity ) {

lib/AI/Prolog/Term.pm view on Meta::CPAN

613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633  my $query = Term->new("steals(Somebody, Something).");
 
=head1 DESCRIPTION
 
See L<AI::Prolog|AI::Prolog> for more information.  If you must know more,
there are plenty of comments sprinkled through the code.
 
=head1 BUGS
 
A query using C<[HEAD|TAIL]> syntax does not bind properly with the C<TAIL>
variable when returning a result object.  This bug can be found in the
C<_to_data> method of this class.
 
=head1 SEE ALSO
 
W-Prolog:  L<http://goanna.cs.rmit.edu.au/~winikoff/wp/>
 
Michael BartE<225>k's online guide to programming Prolog:
L<http://kti.ms.mff.cuni.cz/~bartak/prolog/index.html>
 
=head1 AUTHOR

lib/AI/Prolog/TermList.pm view on Meta::CPAN

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48     my $self = bless {
        term => undef,
        next => undef,
        next_clause =>
            undef,    # serves two purposes: either links clauses in database
                      # or points to defining clause for goals
        is_builtin => undef,
 
        varname  => undef,
        ID       => undef,
        _results => undef,
    } => $class;
    lock_keys %$self;
    return $self;
}
 
sub _new_from_term {
    my ( $class, $term ) = @_;
    my $self = $class->new;
    $self->{term} = $term;
    return $self;

lib/AI/Prolog/TermList.pm view on Meta::CPAN

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109  
    #my $to_string = "[" . $self->term->to_string;
    my $tl = $self->next;
    while ($tl) {
        $to_string .= ",$indent" . $tl->term->to_string;
        $tl = $tl->next;
    }
    return $to_string;
}
 
sub resolve {    # a.k.a. lookup_in
    my ( $self, $kb ) = @_;
    my $predicate = $self->{term}->predicate;
    $self->next_clause( $kb->get($predicate) );
}
 
1;
 
__END__
 
=head1 NAME

lib/AI/Prolog/TermList/Primitive.pm view on Meta::CPAN

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47 =head1 SYNOPSIS
 
No user serviceable parts inside.  You should never be seeing this.
 
=head1 DESCRIPTION
 
See L<AI::Prolog|AI::Prolog> for more information.  If you must know more,
there are plenty of comments sprinkled through the code.
 
Note that primitives are generally not implemented in terms of Prolog
predicates, but in terms of internal features that Prolog cannot handle
efficiently (or cannot handle at all).  Thus, every primitive has an C<ID>
associated with it.  This C<ID> identifies the internal code that makes it
work.
 
=head1 SEE ALSO
 
L<AI::Prolog>
 
L<AI::Prolog::Introduction>

( run in 0.781 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )