Category : Files from Magazines
Archive   : AIOCT86.ZIP
Filename : OBJECT.BBS

 
Output of file : OBJECT.BBS contained in archive : AIOCT86.ZIP

% 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).

*/


  3 Responses to “Category : Files from Magazines
Archive   : AIOCT86.ZIP
Filename : OBJECT.BBS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/