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
20anti_unify_(A, B, LGG) :-
21 22 A == B, !, LGG = A.
23anti_unify_(A, B, LGG) :-
24 25 26 (LGG == A ; LGG == B), !.
27anti_unify_(A, B, _LGG) :-
28 29 30 31 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 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
75private_public(myguardedmap(A, B, LGG), anti_unify(A, B, LGG)).
76
79is_first_antiunificand(V, anti_unify(V1, _, _)) :- V == V1.
80
81same_functor(A, B) :-
82 functor(A, Name, Arity),
83 functor(B, Name, Arity)