home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_OCT86.ZIP / OBJ1.LTG < prev    next >
Encoding:
Text File  |  1986-08-29  |  4.6 KB  |  159 lines
  1.  
  2.  
  3. Listing 1
  4.                   
  5. An Object-Oriented Prolog System
  6.  
  7. % object definition
  8. add_object(SuperClass,Object,ObjectMethods) :-
  9.         add_methods(Object,ObjectMethods),
  10.         link(Object,SuperClass).
  11.  
  12. % definition of a new object - "compiles" object code to Prolog
  13. add_methods(_,[]) :- !.
  14. add_methods(Object,[(Head :- Body)|Rest]) :- !,
  15.         Head =.. [Predicate | Args],
  16.         PrologHead =.. [Predicate, Object | Args],
  17.         assert((PrologHead :- Body)),
  18.         functor(Object,ObjName,_),
  19.         assert(index(Object,ObjName,(Head :- Body))), % to allow inquiries
  20.         add_methods(Object,Rest).
  21. add_methods(Object,[Method|Rest]) :-
  22.         Method =.. [Predicate | Args],
  23.         Head =.. [Predicate, Object | Args],
  24.         assert(Head),
  25.         functor(Object,ObjName,_),
  26.         assert(index(Object,ObjName,Method)),   % to allow inquiries
  27.         add_methods(Object,Rest).
  28.  
  29. % create a new isa link
  30. link(Object,SuperClass) :-
  31.         clause(isa(Object,SuperClass),true) -> true ;   % to avoid redundancy
  32.         assert(isa(Object,SuperClass)).
  33.  
  34. create_root :-
  35.   clause(index(obj,obj,_),_) -> true ;          % OK if root already there
  36.   add_methods(obj,
  37.         [description('an object')]).
  38.  
  39. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  40. % execution message
  41. send(Object,Message) :-
  42.         Message =.. [Predicate | Args],
  43.         Query =.. [Predicate, Object1 | Args],
  44.         isa_chain(Object,Object1),
  45.         clause(Query,Body) ->           % override dup methods
  46.         call(Body).
  47.  
  48. isa_chain(Object, Object).              % try the Object itself first
  49. isa_chain(Object1,Object3) :-           % get ancestors
  50.         isa(Object1,Object2),
  51.         \+Object1=Object2,              % to avoid redundancy
  52.         isa_chain(Object2,Object3).
  53.  
  54. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  55.  
  56. % inquiry messages
  57.  
  58. % what exists?
  59. exists(Object) :-
  60.         index(Object,_,_).
  61.  
  62. what_exists :-
  63.         setof(Object,exists(Object),Objects),
  64.         writeList(Objects).
  65.  
  66. % what objects exist with ObjectName? (in case you forget parameters)
  67. object_name(ObjectName) :-
  68.         (    index(Object,ObjectName,_),
  69.              write(Object), nl,
  70.              send(Object,description(What)),
  71.              nl, write(What), nl, fail
  72.         ;    true
  73.         ).
  74.  
  75. % what are the methods of Object?
  76. methods(Object) :-
  77.         setof(Method,ObjName^index(Object,ObjName,Method),Methods),
  78.         writeList(Methods).
  79.  
  80. writeList([]) :- !, nl.
  81. writeList([Head|Rest]) :-
  82.         nl, write(Head), nl,
  83.         writeList(Rest).
  84.  
  85. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  86. % deletions and unlinking
  87.  
  88. % remove the links for Object
  89. unlink(Object) :-
  90.         (    retract(isa(Object,_)),
  91.              fail
  92.         ;    retract(isa(_,Object)),
  93.              fail
  94.         ;    true
  95.         ).
  96.  
  97. % remove a particular link
  98. unlink(Object,SuperClass) :-
  99.         (    retract(isa(Object,SuperClass)),
  100.              fail
  101.         ;    true
  102.         ).
  103.  
  104. % revise the definition of Object
  105. redefine_object(SuperClass,Object,Methods) :-
  106.         remove_object(Object),
  107.         add_object(SuperClass,Object,Methods).
  108.  
  109. %%% examples:
  110. add_circuit_objs :-
  111.   create_root,
  112.   add_object(obj,circuit,[]),
  113.   add_object(circuit,gate,[]),
  114.   add_object(gate,and_gate(In1,In2),
  115.         [(output(O) :- In1=1, In2=1 -> O=1 ; O=0),
  116.     description('an and_gate with Boolean inputs: Input1, Input2') ] ),
  117.   add_object(gate,or_gate(In1,In2),
  118.         [(output(O) :- In1=0, In2=0 -> O=0 ; O=1),
  119.     description('an or_gate with Boolean inputs: Input1, Input2') ] ),
  120.   add_object(gate,not_gate(In1),
  121.         [(output(O) :- In1=1 -> O=0 ; O=1),
  122.     description('a not_gate with Boolean inputs: Input1') ] ),
  123.   add_object(circuit,circuit1(In1,In2),
  124.         [(output(O) :-  send(not_gate(In1),output(Not1)),
  125.                         send(not_gate(In2),output(Not2)),
  126.                         send(or_gate(Not1,Not2),output(O)) ),
  127.     description('a circuit with Boolean inputs: Input1, Input2') ] ).
  128.  
  129. /******************* sample log of a Prolog session:
  130.  
  131. Quintus Prolog Release 2.0 (Sun)
  132. Copyright (C) 1986, Quintus Computer Systems, Inc.  All rights reserved.
  133.  
  134. | ?- compile(oops).
  135. [compilation completed]
  136. [12.600 sec 6632 bytes]
  137. | ?- add_circuit_objs.
  138.  
  139. yes
  140. | ?- send(circuit1(1,0),output(Out)).
  141.  
  142. Out = 1
  143.  
  144. | ?- send(circuit1(0,1),output(Out)).
  145.  
  146. Out = 1
  147.  
  148. | ?- send(circuit1(1,1),output(Out)).
  149.  
  150. Out = 0
  151.  
  152. | ?- halt.
  153. ********************************************************************/
  154. d(circuit1(1,1),output(Out)).
  155.  
  156. Out = 0
  157.  
  158. | ?- halt.
  159. **************************************************