home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
aijournl
/
1986_10
/
object.bbs
< prev
next >
Wrap
File List
|
1986-07-14
|
11KB
|
377 lines
% An Object-Oriented Prolog System, described in @b(AI Expert).
% Written in Quintus Prolog.
% Edward P. Stabler, Jr.
% Quintus Computer Systems
% 1310 Villa Street
% Mountain View, CA 94041
% 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
).
% remove a method - this approach uses "clause references" - some
% prologs do not have this facility
remove_method(Object,Method) :-
( clause(index(Object,_,Method),true),
headBody(Method,Head,Body),
Head =.. [Predicate | Args],
PrologHead =.. [Predicate, Object | Args],
clause(PrologHead,Body,Ref),
erase(Ref),
fail
; clause(index(Object,_,Method),true,Ref),
erase(Ref),
fail
; true
).
% remove an object altogether
remove_object(Object) :-
( remove_method(Object,_), % remove methods
fail
; retract(index(Object,_,_)), % remove index entries
fail
; unlink(Object) % remove isa links
).
% remove all objects (including obj)
remove_all :-
( remove_object(_),
fail
; true
).
headBody((Head :- Body), Head, Body) :- !.
headBody(Head, Head, true).
% revise the definition of Object
redefine_object(SuperClass,Object,Methods) :-
remove_object(Object),
add_object(SuperClass,Object,Methods).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
add_geometric_objs :-
create_root,
add_object(obj,reg_poly(No_of_sides,Length),
[(perimeter(P) :- P is No_of_sides*Length),
description('a reg poly with parameters: No_of_sides, Length') ] ),
add_object(reg_poly(5,Length),pentagon(Length),[]),
add_object(reg_poly(4,Length),square(Length),
[(area(A) :- A is Length*Length),
description('a square with parameters: Length_of_side') ] ).
% the methods for trace_output were added to facilitate tracing and debugging
add_circuit_objs :-
create_root,
add_object(obj,circuit,[]),
add_object(circuit,circuit1(In1,In2),
[(output(O) :- send(gate1(In1),output(G1)),
send(gate2(In2),output(G2)),
send(gate3(G1,G2),output(O)) ),
(trace_output(O) :- send(circuit1(In1,In2),output(O)),
write('circuit1 output is '),
write(O), nl ),
description('a circuit with Boolean inputs: Input1, Input2') ] ),
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(not_gate(In1),gate1(In1),[]),
add_object(not_gate(In1),gate2(In1),[]),
add_object(or_gate(In1,In2),gate3(In1,In2),[]),
add_object(circuit1(In1,In2),circuit1a(In1,In2),
[(trace_output(O) :- send(circuit1(In1,In2),output(O)),
write('circuit1a output is '),
write(O), nl ) ]),
add_object(circuit1(In1,In2),circuit1b(In1,In2),
[(trace_output(O) :- send(circuit1(In1,In2),output(O)),
write('circuit1b output is '),
write(O), nl ) ]),
add_object(circuit1(In1,In2),circuit1c(In1,In2),
[(trace_output(O) :- send(circuit1(In1,In2),output(O)),
write('circuit1c output is '),
write(O), nl ) ]),
add_object(circuit,circuit2(In1,In2,In3),
[(output(O) :- send(circuit1a(In1,In2),output(C1)),
send(circuit1b(In2,In3),output(C2)),
send(circuit1c(C1,C2),output(O)) ),
(trace_output(O) :- send(circuit1a(In1,In2),trace_output(C1)),
send(circuit1b(In2,In3),trace_output(C2)),
send(circuit1c(C1,C2),trace_output(O)),
write('circuit2 output is '),
write(O), nl ),
description('a circuit with Boolean inputs: In1, In2, In3') ] ),
add_object(circuit2(In1,In2,In3),circuit2a(In1,In2,In3),
[(trace_output(O) :- send(circuit2(In1,In2,In3),trace_output(O)),
write('circuit2a output is '),
write(O), nl ) ]),
add_object(circuit2(In1,In2,In3),circuit2b(In1,In2,In3),
[(trace_output(O) :- send(circuit2(In1,In2,In3),trace_output(O)),
write('circuit2b output is '),
write(O), nl ) ]),
add_object(circuit2(In1,In2,In3),circuit2c(In1,In2,In3),
[(trace_output(O) :- send(circuit2(In1,In2,In3),trace_output(O)),
write('circuit2c output is '),
write(O), nl ) ]).
add_loop :-
add_object(circuit,loop(In1,In2,In3),
[(start :-
write(input_to_loop(In1,In2,In3)), nl,
send(circuit2a(In1,In1,In2),output(C1)),
send(circuit2b(In2,In3,In3),output(C2)),
send(circuit2c(C1,In2,C2),output(O)),
send(loop(C1,C2,O),start) ),
description('a loop with Boolean inputs: In1, In2, In3') ] ).
/******************* 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
| ?- nogc. % turn off garbage collection - not needed here
yes
| ?- send(circuit1(1,0),output(Out)).
Out = 1
| ?- time(send(circuit1(0,1),output(Out))).
send(circuit1(0,1),output(1))
37ms
Out = 1
| ?- time(send(circuit1(1,1),output(Out))).
send(circuit1(1,1),output(0))
50ms
Out = 0
| ?- time(send(circuit2(1,0,1),output(Out))).
send(circuit2(1,0,1),output(0))
167ms
Out = 0
| ?- send(circuit2(1,0,1),trace_output(Out)).
circuit1a output is 1
circuit1b output is 1
circuit1c output is 0
circuit2 output is 0
Out = 0
| ?- send(circuit2(1,1,0),trace_output(Out)).
circuit1a output is 0
circuit1b output is 1
circuit1c output is 1
circuit2 output is 1
Out = 1
| ?- add_loop.
yes
| ?- send(loop(1,1,0),start).
input_to_loop(1,1,0)
input_to_loop(1,0,1)
input_to_loop(1,1,0)
input_to_loop(1,0,1)
input_to_loop(1,1,0)
input_to_loop(1,0,1)
input_to_loop(1,1,0)
input_to_loop(1,0,1)
input_to_loop(1,1,0)
input_to_loop(1,0,1)
input_to_loop(1,1,0)
Prolog interruption (h for help)? a
[ Execution aborted ]
| ?- send(loop(0,1,0),start).
input_to_loop(0,1,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
input_to_loop(0,0,0)
Prolog interruption (h for help)? a
[ Execution aborted ]
| ?- halt.
********************************************************************/
/* Possible improvements:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% to avoid the problem of "failure to unify in the head", this
% alternative version of "send" always selects an method without
% regard to the parameters of the target object or of the message
send(Object,Message) :-
Message =.. [Predicate | Args],
length(Args,MsgArity),
GoalArity is MsgArity + 1,
functor(Goal,Predicate,GoalArity), % Goal with uninst args
arg(1,Goal,Skeleton),
isa_chain(Object,Object1),
mgt(Object1,Skeleton), % Skeleton is Object1 w/ uninst args
clause(Goal,Body) -> % commit to override dup methods
Goal =.. [Predicate,Object1|Args], % instantiate args of Goal
Body.
% "mgt" stands for "most general term"
mgt(Term,Skeleton) :-
nonvar(Term) ->
functor(Term,Functor,Arity), functor(Skeleton,Functor,Arity) ;
Term = Skeleton.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% to get breadth-first, left-to-right selection of methods from ancestors
isa_chain(Object,Object). % try Object itself first
isa_chain(Object,Ancestor) :-
previous_generations([Object],Ancestor).
previous_generations([obj],_) :- !, fail. % the root has no parents
previous_generations(Objects,Ancestor) :-
parents(Objects,Parents),
\+ Parents = [],
( member(Ancestor,Parents)
; previous_generations(Parents, Ancestor)
).
parents([],[]).
parents([Object|Rest],AllParents) :-
bagof0(Parent,Object^isa(Object,Parent),Parents),
parents(Rest,RestParents),
append(Parents,RestParents,AllParents).
% like standard builtin bagof, except Bag is [] when no solutions
bagof0(X,G,B) :-
bagof(X,G,B) -> true ; B = [].
member(X,[X|_]).
member(X,[_|L]) :- member(X,L).
append([],L,L).
append([H|L],M,[H|N]) :- append(L,M,N).
*/