home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / aijournl / ai_oct86.arc / OBJECT1.LTG < prev    next >
Text File  |  1986-07-18  |  5KB  |  151 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ìèááááááááassert(isa(Object,SuperClass)).
  32.  
  33. create_root :-ì
  34. ááclause(index(obj,obj,_),_) -> true ;          % OK if root already thereì
  35. ááadd_methods(obj,ì
  36. áááááááá[description('an object')]).
  37.  
  38. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%ì
  39. % execution messageì
  40. send(Object,Message) :-ì
  41. ááááááááMessage =.. [Predicate | Args],ì
  42. ááááááááQuery =.. [Predicate, Object1 | Args],ì
  43. ááááááááisa_chain(Object,Object1),ì
  44. ááááááááclause(Query,Body) ->           % override dup methodsì
  45. áááááááácall(Body).
  46.  
  47. isa_chain(Object, Object).              % try the Object itself firstì
  48. isa_chain(Object1,Object3) :-           % get ancestorsì
  49. ááááááááisa(Object1,Object2),ì
  50. áááááááá\+Object1=Object2,              % to avoid redundancyì
  51. ááááááááisa_chain(Object2,Object3).
  52.  
  53. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  54.  
  55. % inquiry messages
  56.  
  57. % what exists?ì
  58. exists(Object) :-ì
  59. ááááááááindex(Object,_,_).
  60.  
  61. what_exists :-ì
  62. áááááááásetof(Object,exists(Object),Objects),ì
  63. ááááááááwriteList(Objects).
  64.  
  65. % what objects exist with ObjectName? (in case you forget parameters)ì
  66. object_name(ObjectName) :-ì
  67. áááááááá(    index(Object,ObjectName,_),ì
  68. áááááááááááááwrite(Object), nl,ì
  69. ááááááááááááásend(Object,description(What)),ì
  70. ááááááááááááánl, write(What), nl, failì
  71. áááááááá;    trueì
  72. áááááááá).
  73.  
  74. % what are the methods of Object?ì
  75. methods(Object) :-ì
  76. áááááááásetof(Method,ObjName^index(Object,ObjName,Method),Methods),ì
  77. ááááááááwriteList(Methods).
  78.  
  79. writeList([]) :- !, nl.ì
  80. writeList([Head|Rest]) :-ì
  81. áááááááánl, write(Head), nl,ì
  82. ááááááááwriteList(Rest).
  83.  
  84. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%ì
  85. % deletions and unlinkingè
  86. % remove the links for Objectì
  87. unlink(Object) :-ì
  88. áááááááá(    retract(isa(Object,_)),ì
  89. áááááááááááááfailì
  90. áááááááá;    retract(isa(_,Object)),ì
  91. áááááááááááááfailì
  92. áááááááá;    trueì
  93. áááááááá).
  94.  
  95. % remove a particular linkì
  96. unlink(Object,SuperClass) :-ì
  97. áááááááá(    retract(isa(Object,SuperClass)),ì
  98. áááááááááááááfailì
  99. áááááááá;    trueì
  100. áááááááá).
  101.  
  102. % revise the definition of Objectì
  103. redefine_object(SuperClass,Object,Methods) :-ì
  104. ááááááááremove_object(Object),ì
  105. ááááááááadd_object(SuperClass,Object,Methods).
  106.  
  107. %%% examples:ì
  108. add_circuit_objs :-ì
  109. áácreate_root,ì
  110. ááadd_object(obj,circuit,[]),ì
  111. ááadd_object(circuit,gate,[]),ì
  112. ááadd_object(gate,and_gate(In1,In2),ì
  113. áááááááá[(output(O) :- In1=1, In2=1 -> O=1 ; O=0),ì
  114. áááádescription('an and_gate with Boolean inputs: Input1, Input2') ] ),ì
  115. ááadd_object(gate,or_gate(In1,In2),ì
  116. áááááááá[(output(O) :- In1=0, In2=0 -> O=0 ; O=1),ì
  117. áááádescription('an or_gate with Boolean inputs: Input1, Input2') ] ),ì
  118. ááadd_object(gate,not_gate(In1),ì
  119. áááááááá[(output(O) :- In1=1 -> O=0 ; O=1),ì
  120. áááádescription('a not_gate with Boolean inputs: Input1') ] ),ì
  121. ááadd_object(circuit,circuit1(In1,In2),ì
  122. áááááááá[(output(O) :-  send(not_gate(In1),output(Not1)),ì
  123. áááááááááááááááááááááááásend(not_gate(In2),output(Not2)),ì
  124. áááááááááááááááááááááááásend(or_gate(Not1,Not2),output(O)) ),ì
  125. áááádescription('a circuit with Boolean inputs: Input1, Input2') ] ).
  126.  
  127. /******************* sample log of a Prolog session:
  128.  
  129. Quintus Prolog Release 2.0 (Sun)ì
  130. Copyright (C) 1986, Quintus Computer Systems, Inc.  All rights reserved.
  131.  
  132. | ?- compile(oops).ì
  133. [compilation completed]ì
  134. [12.600 sec 6632 bytes]ì
  135. | ?- add_circuit_objs.
  136.  
  137. yesì
  138. | ?- send(circuit1(1,0),output(Out)).
  139. èOut = 1
  140.  
  141. | ?- send(circuit1(0,1),output(Out)).
  142.  
  143. Out = 1
  144.  
  145. | ?- send(circuit1(1,1),output(Out)).
  146.  
  147. Out = 0
  148.  
  149. | ?- halt.ì
  150. ********************************************************************/
  151.