home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_OCT86.ZIP / OBJECT2.LTG < prev    next >
Encoding:
Text File  |  1986-07-18  |  2.0 KB  |  59 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. isa_chain(Object,Object).               % try Object itself firstì
  33. isa_chain(Object,Ancestor) :-ì
  34. ááááááááprevious_generations([Object],Ancestor).
  35.  
  36. previous_generations([obj],_) :- !, fail.       % the root has no parentsì
  37. previous_generations(Objects,Ancestor) :-ì
  38. ááááááááparents(Objects,Parents),ì
  39. áááááááá\+ Parents = [],ì
  40. áááááááá(    member(Ancestor,Parents)ì
  41. áááááááá;    previous_generations(Parents, Ancestor)ì
  42. áááááááá).
  43.  
  44. parents([],[]).ì
  45. parents([Object|Rest],AllParents) :-ì
  46. áááááááábagof0(Parent,Object^isa(Object,Parent),Parents),ì
  47. ááááááááparents(Rest,RestParents),ì
  48. ááááááááappend(Parents,RestParents,AllParents).
  49.  
  50. % like standard builtin bagof, except Bag is [] when no solutionsì
  51. bagof0(X,G,B) :-ì
  52. áááááááábagof(X,G,B) -> true ; B = [].
  53.  
  54. member(X,[X|_]).ì
  55. member(X,[_|L]) :- member(X,L).
  56.  
  57. append([],L,L).ì
  58. append([H|L],M,[H|N]) :- append(L,M,N).
  59.