home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_OCT86.ZIP / OBJ2.LTG < prev    next >
Encoding:
Text File  |  1986-08-29  |  2.0 KB  |  62 lines
  1.  
  2.  
  3. Listing 2
  4.                             
  5. Improvements
  6.  
  7. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  8. % to avoid the problem of "failure to unify in the head", this alternative
  9. % version of "send" always selects an method without regard to the parameters
  10. % of the target object or of the message
  11.  
  12. send(Object,Message) :-
  13.         Message =.. [Predicate | Args],
  14.         length(Args,MsgArity),
  15.         GoalArity is MsgArity + 1,
  16.         functor(Goal,Predicate,GoalArity),      % Goal with uninst args
  17.         arg(1,Goal,Skeleton),
  18.         isa_chain(Object,Object1),
  19.         mgt(Object1,Skeleton),  % Skeleton is Object1 w/ uninst args
  20.         clause(Goal,Body) ->    % commit to override dup methods
  21.         Goal =.. [Predicate,Object1|Args], % instantiate args of Goal
  22.         Body.
  23.  
  24. % "mgt" stands for "most general term"
  25. mgt(Term,Skeleton) :-
  26.         nonvar(Term) ->
  27.         functor(Term,Functor,Arity), functor(Skeleton,Functor,Arity) ;
  28.         Term = Skeleton.
  29.  
  30. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  31. % to get breadth-first, left-to-right selection of methods from ancestors
  32.  
  33. isa_chain(Object,Object).               % try Object itself first
  34. isa_chain(Object,Ancestor) :-
  35.         previous_generations([Object],Ancestor).
  36.  
  37. previous_generations([obj],_) :- !, fail.       % the root has no parents
  38. previous_generations(Objects,Ancestor) :-
  39.         parents(Objects,Parents),
  40.         \+ Parents = [],
  41.         (    member(Ancestor,Parents)
  42.         ;    previous_generations(Parents, Ancestor)
  43.         ).
  44.  
  45. parents([],[]).
  46. parents([Object|Rest],AllParents) :-
  47.         bagof0(Parent,Object^isa(Object,Parent),Parents),
  48.         parents(Rest,RestParents),
  49.         append(Parents,RestParents,AllParents).
  50.  
  51. % like standard builtin bagof, except Bag is [] when no solutions
  52. bagof0(X,G,B) :-
  53.         bagof(X,G,B) -> true ; B = [].
  54.  
  55. member(X,[X|_]).
  56. member(X,[_|L]) :- member(X,L).
  57.  
  58. append([],L,L).
  59. append([H|L],M,[H|N]) :- append(L,M,N).
  60. ue ; B = [].
  61.  
  62. member(X,[X|_