home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_OCT86.ZIP / OBJECT.BBS < prev    next >
Encoding:
File List  |  1986-07-14  |  10.7 KB  |  377 lines
  1.  
  2. % An Object-Oriented Prolog System, described in @b(AI Expert).
  3. % Written in Quintus Prolog.
  4.  
  5. % Edward P. Stabler, Jr.
  6. % Quintus Computer Systems
  7. % 1310 Villa Street
  8. % Mountain View, CA 94041
  9.  
  10. % object definition 
  11. add_object(SuperClass,Object,ObjectMethods) :-
  12.     add_methods(Object,ObjectMethods),
  13.     link(Object,SuperClass).
  14.  
  15. % definition of a new object - "compiles" object code to Prolog
  16. add_methods(_,[]) :- !.
  17. add_methods(Object,[(Head :- Body)|Rest]) :- !,
  18.     Head =.. [Predicate | Args],
  19.     PrologHead =.. [Predicate, Object | Args],
  20.     assert((PrologHead :- Body)),
  21.     functor(Object,ObjName,_),
  22.     assert(index(Object,ObjName,(Head :- Body))), % to allow inquiries
  23.     add_methods(Object,Rest).
  24. add_methods(Object,[Method|Rest]) :- 
  25.     Method =.. [Predicate | Args],
  26.     Head =.. [Predicate, Object | Args],
  27.     assert(Head),
  28.     functor(Object,ObjName,_),
  29.     assert(index(Object,ObjName,Method)),    % to allow inquiries
  30.     add_methods(Object,Rest).
  31.  
  32. % create a new isa link
  33. link(Object,SuperClass) :-
  34.     clause(isa(Object,SuperClass),true) -> true ;      % to avoid redundancy
  35.     assert(isa(Object,SuperClass)).
  36.  
  37. create_root :-
  38.   clause(index(obj,obj,_),_) -> true ;        % OK if root already there
  39.   add_methods(obj,
  40.     [description('an object')]).
  41.  
  42. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  43. % execution message
  44. send(Object,Message) :-
  45.     Message =.. [Predicate | Args],
  46.     Query =.. [Predicate, Object1 | Args],
  47.     isa_chain(Object,Object1),
  48.     clause(Query,Body) ->        % override dup methods
  49.     call(Body).
  50.  
  51. isa_chain(Object, Object).         % try the Object itself first
  52. isa_chain(Object1,Object3) :-        % get ancestors
  53.     isa(Object1,Object2),
  54.     \+Object1=Object2,        % to avoid redundancy
  55.     isa_chain(Object2,Object3).
  56.  
  57. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  58.  
  59. % inquiry messages
  60.  
  61. % what exists?
  62. exists(Object) :-
  63.     index(Object,_,_).
  64.  
  65. what_exists :-
  66.     setof(Object,exists(Object),Objects),
  67.     writeList(Objects).
  68.  
  69. % what objects exist with ObjectName? (in case you forget parameters)
  70. object_name(ObjectName) :-
  71.     (    index(Object,ObjectName,_),
  72.          write(Object), nl,
  73.          send(Object,description(What)),
  74.          nl, write(What), nl, fail
  75.     ;    true
  76.     ).
  77.  
  78. % what are the methods of Object?
  79. methods(Object) :-
  80.     setof(Method,ObjName^index(Object,ObjName,Method),Methods),
  81.     writeList(Methods).
  82.  
  83. writeList([]) :- !, nl.
  84. writeList([Head|Rest]) :-
  85.     nl, write(Head), nl,
  86.     writeList(Rest).
  87.  
  88. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  89. % deletions and unlinking
  90.  
  91. % remove the links for Object
  92. unlink(Object) :-
  93.     (    retract(isa(Object,_)),
  94.          fail 
  95.     ;    retract(isa(_,Object)),
  96.          fail 
  97.     ;    true
  98.     ).
  99.  
  100. % remove a particular link
  101. unlink(Object,SuperClass) :-
  102.     (    retract(isa(Object,SuperClass)),
  103.          fail 
  104.     ;    true
  105.     ).
  106.  
  107. % remove a method - this approach uses "clause references" - some
  108. %  prologs do not have this facility
  109. remove_method(Object,Method) :-
  110.     (    clause(index(Object,_,Method),true),
  111.          headBody(Method,Head,Body),
  112.          Head =.. [Predicate | Args],
  113.          PrologHead =.. [Predicate, Object | Args],
  114.          clause(PrologHead,Body,Ref),
  115.          erase(Ref),
  116.          fail 
  117.     ;    clause(index(Object,_,Method),true,Ref),
  118.          erase(Ref),
  119.          fail 
  120.     ;    true
  121.     ).
  122.  
  123. % remove an object altogether
  124. remove_object(Object) :-
  125.     (    remove_method(Object,_),        % remove methods
  126.          fail 
  127.     ;    retract(index(Object,_,_)),    % remove index entries
  128.          fail 
  129.     ;    unlink(Object)            % remove isa links
  130.     ).
  131.  
  132. % remove all objects (including obj)
  133. remove_all :-
  134.     (    remove_object(_),
  135.          fail 
  136.     ;    true
  137.     ).
  138.  
  139. headBody((Head :- Body), Head, Body) :- !.
  140. headBody(Head, Head, true).
  141.  
  142. % revise the definition of Object
  143. redefine_object(SuperClass,Object,Methods) :-
  144.     remove_object(Object),
  145.     add_object(SuperClass,Object,Methods).
  146.  
  147. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  148.  
  149. add_geometric_objs :-
  150.   create_root,
  151.   add_object(obj,reg_poly(No_of_sides,Length),
  152.     [(perimeter(P) :- P is No_of_sides*Length),
  153.      description('a reg poly with parameters: No_of_sides, Length') ] ),
  154.   add_object(reg_poly(5,Length),pentagon(Length),[]),
  155.   add_object(reg_poly(4,Length),square(Length),
  156.     [(area(A) :- A is Length*Length),
  157.    description('a square with parameters: Length_of_side') ] ).
  158.  
  159. % the methods for trace_output were added to facilitate tracing and debugging
  160. add_circuit_objs :-
  161.   create_root,
  162.   add_object(obj,circuit,[]),
  163.   add_object(circuit,circuit1(In1,In2),
  164.     [(output(O) :-    send(gate1(In1),output(G1)),
  165.             send(gate2(In2),output(G2)),
  166.             send(gate3(G1,G2),output(O)) ),
  167.      (trace_output(O) :- send(circuit1(In1,In2),output(O)),
  168.                  write('circuit1 output is '),
  169.                  write(O), nl ),
  170.      description('a circuit with Boolean inputs: Input1, Input2') ] ),
  171.   add_object(circuit,gate,[]),
  172.   add_object(gate,and_gate(In1,In2),
  173.     [(output(O) :- In1=1, In2=1 -> O=1 ; O=0),
  174.      description('an and_gate with Boolean inputs: Input1, Input2') ] ),
  175.   add_object(gate,or_gate(In1,In2),
  176.     [(output(O) :- In1=0, In2=0 -> O=0 ; O=1),
  177.      description('an or_gate with Boolean inputs: Input1, Input2') ] ),
  178.   add_object(gate,not_gate(In1),
  179.     [(output(O) :- In1=1 -> O=0 ; O=1),
  180.      description('a not_gate with Boolean inputs: Input1') ] ),
  181.   add_object(not_gate(In1),gate1(In1),[]),
  182.   add_object(not_gate(In1),gate2(In1),[]),
  183.   add_object(or_gate(In1,In2),gate3(In1,In2),[]),
  184.   add_object(circuit1(In1,In2),circuit1a(In1,In2),
  185.     [(trace_output(O) :- send(circuit1(In1,In2),output(O)),
  186.                  write('circuit1a output is '),
  187.                  write(O), nl ) ]),
  188.   add_object(circuit1(In1,In2),circuit1b(In1,In2),
  189.     [(trace_output(O) :- send(circuit1(In1,In2),output(O)),
  190.                  write('circuit1b output is '),
  191.                  write(O), nl ) ]),
  192.   add_object(circuit1(In1,In2),circuit1c(In1,In2),
  193.     [(trace_output(O) :- send(circuit1(In1,In2),output(O)),
  194.                  write('circuit1c output is '),
  195.                  write(O), nl ) ]),
  196.   add_object(circuit,circuit2(In1,In2,In3),
  197.     [(output(O) :-    send(circuit1a(In1,In2),output(C1)),
  198.             send(circuit1b(In2,In3),output(C2)),
  199.             send(circuit1c(C1,C2),output(O)) ),
  200.      (trace_output(O) :- send(circuit1a(In1,In2),trace_output(C1)),
  201.                  send(circuit1b(In2,In3),trace_output(C2)),
  202.                  send(circuit1c(C1,C2),trace_output(O)),
  203.                  write('circuit2 output is '),
  204.                  write(O), nl ),
  205.      description('a circuit with Boolean inputs: In1, In2, In3') ] ),
  206.   add_object(circuit2(In1,In2,In3),circuit2a(In1,In2,In3),
  207.     [(trace_output(O) :- send(circuit2(In1,In2,In3),trace_output(O)),
  208.                  write('circuit2a output is '),
  209.                  write(O), nl ) ]),
  210.   add_object(circuit2(In1,In2,In3),circuit2b(In1,In2,In3),
  211.     [(trace_output(O) :- send(circuit2(In1,In2,In3),trace_output(O)),
  212.                  write('circuit2b output is '),
  213.                  write(O), nl ) ]),
  214.   add_object(circuit2(In1,In2,In3),circuit2c(In1,In2,In3),
  215.     [(trace_output(O) :- send(circuit2(In1,In2,In3),trace_output(O)),
  216.                  write('circuit2c output is '),
  217.                  write(O), nl ) ]).
  218.  
  219. add_loop :-
  220.   add_object(circuit,loop(In1,In2,In3),
  221.     [(start :-    
  222.             write(input_to_loop(In1,In2,In3)), nl,
  223.             send(circuit2a(In1,In1,In2),output(C1)),
  224.             send(circuit2b(In2,In3,In3),output(C2)),
  225.             send(circuit2c(C1,In2,C2),output(O)),
  226.             send(loop(C1,C2,O),start) ),
  227.      description('a loop with Boolean inputs: In1, In2, In3') ] ).
  228.  
  229.  
  230. /******************* sample log of a Prolog session:
  231.  
  232. Quintus Prolog Release 2.0 (Sun)
  233. Copyright (C) 1986, Quintus Computer Systems, Inc.  All rights reserved.
  234.  
  235. | ?- compile(oops).
  236. [compilation completed]
  237. [12.600 sec 6632 bytes]
  238. | ?- add_circuit_objs.
  239.  
  240. yes
  241. | ?- nogc.        % turn off garbage collection - not needed here
  242.  
  243. yes
  244. | ?- send(circuit1(1,0),output(Out)).
  245.  
  246. Out = 1 
  247.  
  248. | ?- time(send(circuit1(0,1),output(Out))).
  249. send(circuit1(0,1),output(1))
  250. 37ms
  251.  
  252. Out = 1 
  253.  
  254. | ?- time(send(circuit1(1,1),output(Out))).
  255. send(circuit1(1,1),output(0))
  256. 50ms
  257.  
  258. Out = 0 
  259.  
  260. | ?- time(send(circuit2(1,0,1),output(Out))).
  261. send(circuit2(1,0,1),output(0))
  262. 167ms
  263.  
  264. Out = 0 
  265.  
  266. | ?- send(circuit2(1,0,1),trace_output(Out)).
  267. circuit1a output is 1
  268. circuit1b output is 1
  269. circuit1c output is 0
  270. circuit2 output is 0
  271.  
  272. Out = 0 
  273.  
  274. | ?- send(circuit2(1,1,0),trace_output(Out)).
  275. circuit1a output is 0
  276. circuit1b output is 1
  277. circuit1c output is 1
  278. circuit2 output is 1
  279.  
  280. Out = 1 
  281.  
  282. | ?- add_loop.
  283.  
  284. yes
  285. | ?- send(loop(1,1,0),start).
  286. input_to_loop(1,1,0)
  287. input_to_loop(1,0,1)
  288. input_to_loop(1,1,0)
  289. input_to_loop(1,0,1)
  290. input_to_loop(1,1,0)
  291. input_to_loop(1,0,1)
  292. input_to_loop(1,1,0)
  293. input_to_loop(1,0,1)
  294. input_to_loop(1,1,0)
  295. input_to_loop(1,0,1)
  296. input_to_loop(1,1,0)
  297.  
  298. Prolog interruption (h for help)? a
  299. [ Execution aborted ]
  300.  
  301.  
  302. | ?- send(loop(0,1,0),start).
  303. input_to_loop(0,1,0)
  304. input_to_loop(0,0,0)
  305. input_to_loop(0,0,0)
  306. input_to_loop(0,0,0)
  307. input_to_loop(0,0,0)
  308. input_to_loop(0,0,0)
  309. input_to_loop(0,0,0)
  310. input_to_loop(0,0,0)
  311. input_to_loop(0,0,0)
  312. input_to_loop(0,0,0)
  313. input_to_loop(0,0,0)
  314.  
  315. Prolog interruption (h for help)? a
  316. [ Execution aborted ]
  317.  
  318. | ?- halt.
  319. ********************************************************************/
  320. /* Possible improvements:
  321.  
  322. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  323. % to avoid the problem of "failure to unify in the head", this
  324. %  alternative version of "send" always selects an method without
  325. %  regard to the parameters of the target object or of the message
  326.  
  327. send(Object,Message) :-
  328.     Message =.. [Predicate | Args],
  329.     length(Args,MsgArity),
  330.     GoalArity is MsgArity + 1,
  331.     functor(Goal,Predicate,GoalArity),    % Goal with uninst args
  332.     arg(1,Goal,Skeleton),
  333.     isa_chain(Object,Object1),
  334.     mgt(Object1,Skeleton),    % Skeleton is Object1 w/ uninst args
  335.     clause(Goal,Body) ->    % commit to override dup methods
  336.     Goal =.. [Predicate,Object1|Args], % instantiate args of Goal
  337.     Body.
  338.  
  339. % "mgt" stands for "most general term"
  340. mgt(Term,Skeleton) :-
  341.     nonvar(Term) -> 
  342.     functor(Term,Functor,Arity), functor(Skeleton,Functor,Arity) ;
  343.     Term = Skeleton.
  344.  
  345. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  346. % to get breadth-first, left-to-right selection of methods from ancestors
  347.  
  348. isa_chain(Object,Object).        % try Object itself first
  349. isa_chain(Object,Ancestor) :-
  350.     previous_generations([Object],Ancestor).
  351.  
  352. previous_generations([obj],_) :- !, fail.    % the root has no parents
  353. previous_generations(Objects,Ancestor) :-
  354.     parents(Objects,Parents),
  355.     \+ Parents = [],
  356.     (    member(Ancestor,Parents)
  357.     ;    previous_generations(Parents, Ancestor)
  358.     ).
  359.  
  360. parents([],[]).
  361. parents([Object|Rest],AllParents) :-
  362.     bagof0(Parent,Object^isa(Object,Parent),Parents),
  363.     parents(Rest,RestParents),
  364.     append(Parents,RestParents,AllParents).
  365.  
  366. % like standard builtin bagof, except Bag is [] when no solutions
  367. bagof0(X,G,B) :-
  368.     bagof(X,G,B) -> true ; B = [].
  369.  
  370. member(X,[X|_]).
  371. member(X,[_|L]) :- member(X,L).
  372.  
  373. append([],L,L).
  374. append([H|L],M,[H|N]) :- append(L,M,N).
  375.  
  376. */
  377.