

Listing 2
                            
Improvements

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% to avoid the problem of "failure to unify in the head", this alternative
% version of "send" always selects an method without regard to the parameters
% of the target object or of the message

send(Object,Message) :-
        Message =.. [Predicate | Args],
        length(Args,MsgArity),
        GoalArity is MsgArity + 1,
        functor(Goal,Predicate,GoalArity),      % Goal with uninst args
        arg(1,Goal,Skeleton),
        isa_chain(Object,Object1),
        mgt(Object1,Skeleton),  % Skeleton is Object1 w/ uninst args
        clause(Goal,Body) ->    % commit to override dup methods
        Goal =.. [Predicate,Object1|Args], % instantiate args of Goal
        Body.

% "mgt" stands for "most general term"
mgt(Term,Skeleton) :-
        nonvar(Term) ->
        functor(Term,Functor,Arity), functor(Skeleton,Functor,Arity) ;
        Term = Skeleton.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% to get breadth-first, left-to-right selection of methods from ancestors
isa_chain(Object,Object).               % try Object itself first
isa_chain(Object,Ancestor) :-
        previous_generations([Object],Ancestor).

previous_generations([obj],_) :- !, fail.       % the root has no parents
previous_generations(Objects,Ancestor) :-
        parents(Objects,Parents),
        \+ Parents = [],
        (    member(Ancestor,Parents)
        ;    previous_generations(Parents, Ancestor)
        ).

parents([],[]).
parents([Object|Rest],AllParents) :-
        bagof0(Parent,Object^isa(Object,Parent),Parents),
        parents(Rest,RestParents),
        append(Parents,RestParents,AllParents).

% like standard builtin bagof, except Bag is [] when no solutions
bagof0(X,G,B) :-
        bagof(X,G,B) -> true ; B = [].

member(X,[X|_]).
member(X,[_|L]) :- member(X,L).

append([],L,L).
append([H|L],M,[H|N]) :- append(L,M,N).
