Category : Files from Magazines
Archive   : AIOCT86.ZIP
Filename : OBJ1.LTG

Listing 1

An Object-Oriented Prolog System

% object definition
add_object(SuperClass,Object,ObjectMethods) :-
add_methods(Object,ObjectMethods),
link(Object,SuperClass).

% definition of a new object - "compiles" object code to Prolog
add_methods(_,[]) :- !.
add_methods(Object,[(Head :- Body)|Rest]) :- !,
Head =.. [Predicate | Args],
PrologHead =.. [Predicate, Object | Args],
assert((PrologHead :- Body)),
functor(Object,ObjName,_),
assert(index(Object,ObjName,(Head :- Body))), % to allow inquiries
add_methods(Object,Rest).
add_methods(Object,[Method|Rest]) :-
Method =.. [Predicate | Args],
Head =.. [Predicate, Object | Args],
assert(Head),
functor(Object,ObjName,_),
assert(index(Object,ObjName,Method)), % to allow inquiries
add_methods(Object,Rest).

% create a new isa link
link(Object,SuperClass) :-
clause(isa(Object,SuperClass),true) -> true ; % to avoid redundancy
assert(isa(Object,SuperClass)).

create_root :-
clause(index(obj,obj,_),_) -> true ; % OK if root already there
add_methods(obj,
[description('an object')]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% execution message
send(Object,Message) :-
Message =.. [Predicate | Args],
Query =.. [Predicate, Object1 | Args],
isa_chain(Object,Object1),
clause(Query,Body) -> % override dup methods
call(Body).

isa_chain(Object, Object). % try the Object itself first
isa_chain(Object1,Object3) :- % get ancestors
isa(Object1,Object2),
\+Object1=Object2, % to avoid redundancy
isa_chain(Object2,Object3).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% inquiry messages

% what exists?
exists(Object) :-
index(Object,_,_).

what_exists :-
setof(Object,exists(Object),Objects),

writeList(Objects).

% what objects exist with ObjectName? (in case you forget parameters)
object_name(ObjectName) :-
( index(Object,ObjectName,_),
write(Object), nl,
send(Object,description(What)),
nl, write(What), nl, fail
; true
).

% what are the methods of Object?
methods(Object) :-
setof(Method,ObjName^index(Object,ObjName,Method),Methods),
writeList(Methods).

writeList([]) :- !, nl.
writeList([Head|Rest]) :-
nl, write(Head), nl,
writeList(Rest).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% deletions and unlinking

% remove the links for Object
unlink(Object) :-
( retract(isa(Object,_)),
fail
; retract(isa(_,Object)),
fail
; true
).

% remove a particular link
unlink(Object,SuperClass) :-
( retract(isa(Object,SuperClass)),
fail
; true
).

% revise the definition of Object
redefine_object(SuperClass,Object,Methods) :-
remove_object(Object),
add_object(SuperClass,Object,Methods).

%%% examples:
add_circuit_objs :-
create_root,
add_object(obj,circuit,[]),
add_object(circuit,gate,[]),
add_object(gate,and_gate(In1,In2),
[(output(O) :- In1=1, In2=1 -> O=1 ; O=0),
description('an and_gate with Boolean inputs: Input1, Input2') ] ),
add_object(gate,or_gate(In1,In2),
[(output(O) :- In1=0, In2=0 -> O=0 ; O=1),
description('an or_gate with Boolean inputs: Input1, Input2') ] ),
add_object(gate,not_gate(In1),
[(output(O) :- In1=1 -> O=0 ; O=1),
description('a not_gate with Boolean inputs: Input1') ] ),
add_object(circuit,circuit1(In1,In2),
[(output(O) :- send(not_gate(In1),output(Not1)),
send(not_gate(In2),output(Not2)),
send(or_gate(Not1,Not2),output(O)) ),
description('a circuit with Boolean inputs: Input1, Input2') ] ).

/******************* sample log of a Prolog session:

Quintus Prolog Release 2.0 (Sun)
Copyright (C) 1986, Quintus Computer Systems, Inc. All rights reserved.

| ?- compile(oops).
[compilation completed]
[12.600 sec 6632 bytes]
| ?- add_circuit_objs.

yes
| ?- send(circuit1(1,0),output(Out)).

Out = 1

| ?- send(circuit1(0,1),output(Out)).

Out = 1

| ?- send(circuit1(1,1),output(Out)).

Out = 0

| ?- halt.
********************************************************************/
d(circuit1(1,1),output(Out)).

Out = 0

| ?- halt.
**************************************************