Prolog

Contributed by Chris Rathman

OOP Interpreter for Sending Messages

% An interpreter for object-oriented programs provided by
% Ivan Brakto in 'Prolog, Programming For Artificial Intelligence'
% with some minor patches to enable it to run on SWI-Prolog

:- op(600, xfy, ::).                            % send message to object

% use '::' operator as syntax for send message
Object::Message :-
   send(Object, Message).

% send(Message, Object): find Object's method and execute
send(Object, Message) :-
   get_methods(Object, Methods),                % Find Object's methods
   process(Message, Methods).                   % Execute corresponding method

% get the defined methods for the class
get_methods(Object, Methods) :-                 % Private methods
   object(Object, Methods).

% get the defined methods inherited from the superclass
get_methods(Object, Methods) :-                 % Inherited methods
   isa(Object, SuperObject),
   get_methods(SuperObject, Methods).

% process the method if it is defined as a fact
process(Message, [Message | _]) :-              % Use a fact
   process(Message, [Message | _]).

% process the method if it is defined as a rule
process(Message, [(Message :- Body) | _]) :-    % Use a rule
   call(Body).

process(Message, [_ | Methods]) :-              % break the message up
   process(Message, Methods).

shape class

object(
   shape(X, Y), [
      (getx(X) :- X is X),

      (gety(Y) :- Y is Y),

      (moveto(_Shape, _X, _Y) :- fail),

      (rmoveto(_Shape, _X, _Y) :- fail),

      (draw :- fail)
   ]
).

rectangle class

object(
   rectangle(X, Y, Width, Height), [
      (getwidth(W) :-
         W is Width),

      (getheight(H) :-
         H is Height),

      (setwidth(NewRectangle, NewWidth) :-
         NewRectangle = rectangle(X, Y, NewWidth, Height)),

      (setheight(NewRectangle, NewHeight) :-
         NewRectangle = rectangle(X, Y, Width, NewHeight)),

      (moveto(NewRectangle, NewX, NewY) :-
         NewRectangle = rectangle(NewX, NewY, Width, Height)),

      (rmoveto(NewRectangle, DeltaX, DeltaY) :-
         A is X + DeltaX,
         B is Y + DeltaY,
         NewRectangle = rectangle(A, B, Width, Height)),

      (draw :-
         write('Drawing a Rectangle at:('),
         write(X),
         write(','),
         write(Y),
         write('), width '),
         write(Width),
         write(', height '),
         write(Height),
         nl)
   ]
).

% set rectangle to inherit from shape class
isa(rectangle(X, Y, _WIDTH, _HEIGHT), shape(X, Y)).

circle class

object(
   circle(X, Y, Radius), [
      (getradius(R) :-
         R is Radius),

      (setradius(NewCircle, NewRadius) :-
         NewCircle = circle(X, Y, NewRadius)),

      (moveto(NewCircle, NewX, NewY) :-
         NewCircle = circle(NewX, NewY, Radius)),

      (rmoveto(NewCircle, DeltaX, DeltaY) :-
         A is X + DeltaX,
         B is Y + DeltaY,
         NewCircle = circle(A, B, Radius)),

      (draw :-
         write('Drawing a Circle at:('),
         write(X),
         write(','),
         write(Y),
         write('), radius '),
         write(Radius),
         nl)
   ]
).

% set circle to inherit from shape class
isa(circle(X, Y, _RADIUS), shape(X, Y)).

Polymorphism Test

% iterate through a list and send message
drawloop([]) :- true.
drawloop([Shape|Tail]) :-
   Shape::draw,
   Shape::rmoveto(ShapeMoved, 100, 100),
   ShapeMoved::draw,
   drawloop(Tail).

polymorph :-
   % create a list containing various shape instances
   Scribble = [
      rectangle(10, 20, 5, 6),
      circle(15, 25, 8)],

   % iterate through the list and handle shapes polymorphically
   drawloop(Scribble),

   % handle rectangle and instance
   ARectangle = rectangle(0, 0, 15, 15),
   ARectangle::draw,
   ARectangle::setwidth(BRectangle, 30),
   BRectangle::draw.

Polymorphism Test

?- consult('oop.pl').
?- consult('polymorph.pl').
?- polymorph

Output

Drawing a Rectangle at:(10,20), width 5, height 6
Drawing a Rectangle at:(110,120), width 5, height 6
Drawing a Circle at:(15,25), radius 8
Drawing a Circle at:(115,125), radius 8
Drawing a Rectangle at:(0,0), width 15, height 15
Drawing a Rectangle at:(0,0), width 30, height 15

Yes

Chris Rathman / Chris.Rathman@tx.rr.com