Object Oriented Programming in Prolog

/* programs from E. Stabler, "Object Oriented Programming in 
Prolog", AI Expert, October 1986, pp 46-57 */


/* ---------------1st program ---------------------- */
/* this is the simplest form of object oriented programming and 
message sending */ 

/* objects are defined using the predicate object(name,methods).
where name is any term used to designate an object possibly including
parameters, and methods is a list of prolog rules for responding to 
messages. Methods can be of two types, either simple facts or rules */ 

send(Object,Message):- object(Object,Methods),
                      get_method(Message,Methods,Method),
                      Method.
get_method(Message,[First|Rest],Method):-
                      fact_or_rule(Message,First,Method).
get_method(Message,[_|Rest],Method):-
                      get_method(Message,Rest,Method).
fact_or_rule(Message,Message,true).
fact_or_rule(Message,(Message:-Body),Body).

/* this is an example of an object */

object(reg_polygon(No_of_sides,Length_of_side),
       [(perimeter(P):-P is No_of_sides*Length_of_side),
        description('a regular polygon')]).


/* these are examples of goals

?-send(reg_polygon(4,5), perimeter(P)).
should return P = 20
?-send(reg_polygon(4,5), description(P)).
should return P = 'a regular polygon'
*/

/* ---------------2nd program ---------------------- */
/* this is a more complex programs that handles inheritance of 
methods.  In addition to the previous predicates we have to 
define the isa relationship between objects. */

send(Object,Message):- isa_chain(Object,Object1),
                      object(Object1,Methods),
                      get_method(Message,Methods,Method),
                      Method.
/* we are interested in using only the first method found */
get_method(Message,[First|Rest],Method):-
                      fact_or_rule(Message,First,Method),!.
get_method(Message,[_|Rest],Method):-
                      get_method(Message,Rest,Method).
fact_or_rule(Message,Message,true).
fact_or_rule(Message,(Message:-Body),Body).

isa_chain(Object,Object).
isa_chain(Object1,Object3):-
                      isa(Object1,Object2),
                      \+Object1=Object2,
                      isa_chain(Object2,Object3).

/* these are examples of objects */

object(reg_polygon(No_of_sides,Length_of_side),
       [(perimeter(P):-P is No_of_sides*Length_of_side),
        description('a regular polygon')]).
object(square(Length_of_side),
       [description('a square')]).
isa(square(L),reg_polygon(4,L)).
isa(pentagon(L),reg_polygon(5,L)).


/* ---------------3rd program ---------------------- */
/* this version compiles methods into clauses.
Every time add_object is called it creates new clauses containing 
the methods defined for the given object.

add_object(superclass,objectname,methods) takes as arguments
an object's superclass, an object, and a list of methods 
and creates a collection of clauses, one per method plus one for 
the isa relationship.

For example:

add_object(object,
           reg_polygon(No_of_sides,Length_of_side),
           [(perimeter(P):-P is No_of_sides*Length_of_side),
            description('a regular polygon')]).

creates the three clauses:

isa(reg_polygon(No_of_sides,Length_of_side),object).
perimeter(reg_polygon(No_of_sides,Length_of_side), P):-
            P is No_of_sides*Length_of_side.
description(reg_polygon(No_of_sides,Length_of_side),
            'a regular polygon').

The program requires the creation of a root for the hierarchy of objects.
This is done by proving the goal create_root. The root is assumed to be 
an object called object.

Here is the program
*/

/* add_object create the clause by creating the methods and the isa
relationship */

add_object(Superclass,Object,Methods):-
                      add_methods(Object,Methods),
                      link(Object,Superclass).

/* add_methods creates the methods. There are two different clauses 
for the two types of methods (rule and fact). */

add_methods(_,[]):-!.
/* this is for rules */
add_methods(Object,[(Head:-Body)|Rest]):-
                     Head=..[Predicate|Args],
                     MethodHead=..[Predicate,Object|Args],
                     assert((MethodHead:-Body)),
                     add_methods(Object,Rest).
/* and this is for facts */
add_methods(Object,[Method|Rest]):-
                     Method=..[Predicate|Args],
                     MethodHead=..[Predicate,Object|Args],
                     assert(MethodHead).
                     add_methods(Object,Rest).

/* link creates the isa clause */
link(Object,Superclass):-
                     isa(Object,Superclass),!,true;
                     assert(isa(Object,Superclass)).

/* send sends a message to an object */
send(Object,Message):-
                     Message=..[Predicate|Args],
                     Goal=..[Predicate,Object1|Args],
                     isa_chain(Object,Object1),
                     clause(Goal,Body),!,call(Body).

/* the isa chain is checked as in the previous program */
isa_chain(Object,Object).
isa_chain(Object1,Object3):-
                      isa(Object1,Object2),
                      \+Object1=Object2,
                      isa_chain(Object2,Object3).

/* create_roots creates the root of the hierarchy */
create_root:- add_methods(object,[description('an object')]).

/* the root of the class tree has to be created before starting 
Here are some examples of goals 

?-create_root.       

?-add_object(object,reg_polygon(No_of_sides,Length_of_side),
       [(perimeter(P):-P is No_of_sides*Length_of_side),
        description('a regular polygon')]).
?-add_object(reg_polygon(4,Length_of_side),square(Length_of_side),
       [description('a square')]).
?-add_object(reg_polygon(5,L),pentagon(L),
       [description('a pentagon')]).
*/