1:- module(anti_unify, [anti_unify/3]).    2
    3:- use_module(library(subsumes)).    4:- consult(guardedmap).    5
    6%!  anti_unify(?A, ?B, ?LGG) is semidet.
    7%
    8%   anti_unify/3 maintains the relation that `LGG` is the least general
    9%   generalization of `A` and `B`.
   10%
   11%   See the unit tests for examples.
   12anti_unify(A, B, LGG) :-
   13    % It's cleaner to assert subsumption up front,
   14    % even though it traverses LGG more than necessary.
   15    LGG subsumes A,
   16    LGG subsumes B,
   17    myguardedmap(A, B, LGG).
   18
   19% anti_unify(A, B, LGG) assumes that guard(A, B, LGG) has just succeeded.
   20anti_unify_(A, B, LGG) :-
   21    % If A == B then it is its own LGG.
   22    A == B, !, LGG = A.
   23anti_unify_(A, B, LGG) :-
   24    % anti_unify(A, LGG, LGG) iff LGG subsumes A, which is already
   25    % enforced, so the "when" clause is superfluous.
   26    (LGG == A ; LGG == B), !.
   27anti_unify_(A, B, _LGG) :-
   28    % If A and B are both nonvar then guard(A, B, LGG) implies that they
   29    % have different functors, so LGG is permavar (can never be nonvar),
   30    % which characterizes its observable behavior and is already enforced
   31    % by its existing subsumption of A and B.
   32    nonvar(A), nonvar(B), !.
   33anti_unify_(A, B, LGG) :-
   34    Callback = myguardedmap(A, B, LGG),
   35    (var(A)  ->  add_callback(A, Callback) ; true),
   36    (var(B)  ->  add_callback(B, Callback) ; true).
   37
   38myguardedmap(A, B, LGG) :- guardedmap(guard, anti_unify_, [A, B, LGG]).
   39
   40guard(A, B, _LGG) :-
   41    once(A == B ;
   42         var(A) ;
   43         var(B) ;
   44         \+ same_functor(A, B)).
   45
   46get_callbacks(Var, Callbacks) :- get_attr(Var, anti_unify, Callbacks), !.
   47get_callbacks(_, []).
   48
   49set_callbacks(Var, []) :- !, del_attr(Var, anti_unify).
   50set_callbacks(Var, Callbacks) :- put_attr(Var, anti_unify, Callbacks).
   51
   52add_callback(Var, Callback) :-
   53    get_callbacks(Var, Callbacks),
   54    maplist(\==(Callback), Callbacks)
   55    ->  set_callbacks(Var, [Callback|Callbacks])
   56    ;   true.
   57
   58attr_unify_hook(XCallbacks, Y) :-
   59    % Call it all!
   60    maplist(call, XCallbacks),
   61    (var(Y)
   62    ->  get_callbacks(Y, YCallbacks),
   63	set_callbacks(Y, []),
   64	maplist(call, YCallbacks)
   65    ;   true).
   66
   67attribute_goals(V) -->
   68    { call_dcg(
   69	  (get_callbacks, maplist(private_public), include(is_first_antiunificand(V))),
   70	  V, Goals) },
   71    Goals.
   72
   73% The callbacks use the non-exported myguardedmap/3 as a slight optimization,
   74% but for attribute_goals//1 we replace it with the exported anti_unify/3.
   75private_public(myguardedmap(A, B, LGG), anti_unify(A, B, LGG)).
   76
   77% Each antiunificand has a copy of the same callback, so we only need to
   78% retain the first antiunificand's copy.
   79is_first_antiunificand(V, anti_unify(V1, _, _)) :- V == V1.
   80
   81same_functor(A, B) :-
   82    functor(A, Name, Arity),
   83    functor(B, Name, Arity)