13
14:- module( pdt_xref,
15 [ find_reference_to/9 16 17 ]
18 ). 19
20:- use_module(pdt_prolog_library(utils4modules)). 21:- use_module(pdt_prolog_library(utils4modules_visibility)). 22
23:- use_module( pdt_common_pl(properties), [properties_for_predicate/4] ). 24:- use_module(library(lists)). 25
26:- use_module(pdt_common_pl('callgraph/pdt_call_graph')). 27
30 33find_unique( Goal ) :-
34 setof( Goal, Goal, Set),
35 member(Goal, Set).
36
37:- dynamic(result/5). 38:- dynamic(result_transparent/6). 39
40assert_result(IsAlias, QGoal, Caller, clause_term_position(Ref, TermPosition), Kind) :-
41 QGoal = M:Goal,
42 ( predicate_property(Caller, transparent),
43 \+ predicate_property(Caller, meta_predicate(_)),
44 ( Kind = metacall(_, _)
45 ; Kind = database(_, _)
46 )
47 -> ( retract(result_transparent(IsAlias, Goal, Ref, TermPosition, Kind, Modules))
48 -> ( member(M, Modules)
49 -> NewModules = Modules
50 ; NewModules = [M|Modules]
51 )
52 ; NewModules = [M]
53 ),
54 assertz(result_transparent(IsAlias, Goal, Ref, TermPosition, Kind, NewModules))
55 ; assertz(result(IsAlias, QGoal, Ref, TermPosition, Kind))
56 ),
57 !.
58assert_result(IsAlias, QGoal, _, file_term_position(File, TermPosition), Kind) :-
59 QGoal = _:_Goal,
60 assertz(result(IsAlias, QGoal, File, TermPosition, Kind)),
61 !.
62
63assert_result(IsAlias, QGoal, _, clause(Ref), Kind) :-
64 QGoal = _:_Goal,
65 assertz(result(IsAlias, QGoal, Ref, no_term_position, Kind)),
66 !.
67
68assert_result(_,_,_,_,_).
71find_reference_to(Term, ExactMatch, Root, RefModule, RefName, RefArity, RefFile, Position, PropertyList) :-
72 ( Term = predicate(SearchMod, _, Functor, Separator, Arity0)
73 -> ( Separator == (//),
74 nonvar(Arity0)
75 -> Arity is Arity0 + 2
76 ; Arity = Arity0
77 )
78 ; Term = goal(SearchGoal),
79 nonvar(SearchGoal),
80 SearchGoal = SearchMod:H,
81 callable(H),
82 functor(H, Functor, Arity)
83 ),
84 ( var(Functor),
85 var(SearchMod)
86 -> fail
87 ; true
88 ),
89 retractall(result(_, _, _, _, _)),
90 retractall(result_transparent(_, _, _, _, _, _)),
91 ( var(SearchGoal)
92 -> perform_search(Functor, Arity, SearchMod, ExactMatch)
93 ; perform_search_for_goal(SearchMod, Functor, Arity, SearchGoal)
94 ),
95 !,
96 ( retract(result(Alias, M0:ReferencingGoal, ClauseRefOrFile, Termposition, _))
97 ; retract(result_transparent(Alias, ReferencingGoal, ClauseRefOrFile, Termposition, _, M0s))
98 ),
99 ( atom(ClauseRefOrFile)
100 -> RefFile = ClauseRefOrFile,
101 ( nonvar(Root)
102 -> sub_atom(RefFile, 0, _, _, Root)
103 ; true
104 ),
105 Line = 1,
106 once(module_of_file(RefFile, RefModule)),
107 RefName = (initialization),
108 RefArity = 1
109 ; ClauseRef = ClauseRefOrFile,
110 clause_property(ClauseRef, predicate(RefModule:RefName/RefArity)),
111 ( nonvar(SearchMod),
112 var(Functor),
113 var(Arity)
114 -> SearchMod \== RefModule
115 ; true
116 ),
117 clause_property(ClauseRef, file(RefFile)),
118 ( nonvar(Root)
119 -> sub_atom(RefFile, 0, _, _, Root)
120 ; true
121 ),
122 123 clause_property(ClauseRef, source(RefFile)),
124 clause_property(ClauseRef, line_count(Line))
125 ),
126 properties_for_predicate(RefModule,RefName,RefArity,PropertyList0),
127 ( ( Termposition = term_position(Start, End, _, _, _)
128 ; Termposition = Start-End
129 )
130 -> format(atom(Position), '~w-~w', [Start, End])
131 ; Position = Line
132 ),
133 functor(ReferencingGoal, N, A),
134 ( nonvar(M0)
135 -> ( declared_in_module(M0, N, A, M)
136 -> true
137 ; M0 = M
138 )
139 ; nonvar(M0s),
140 setof(
141 M2,
142 M1^N^A^M0s^(
143 member(M1, M0s),
144 ( declared_in_module(M1, N, A, M2)
145 -> true
146 ; M2 = M1
147 )
148 ),
149 Ms
150 ),
151 atomic_list_concat(Ms, ', ', ModuleList),
152 format(atom(TransparentTargetsAtom), ' in execution context ~w (context dependend)', [ModuleList])
153 ),
154 ( Separator == (//)
155 -> format(atom(Label), '~w//~w', [N, Arity0])
156 ; format(atom(Label), '~w/~w', [N, A])
157 ),
158 PropertyList1 = [label(Label),line(Line)|PropertyList0],
159 ( nonvar(M),
160 M \== RefModule
161 -> format(atom(Prefix), '~w:', [M]),
162 PropertyList2 = [prefix(Prefix)|PropertyList1]
163 ; PropertyList2 = PropertyList1
164 ),
165 ( nonvar(Alias)
166 -> format(atom(AliasAtom), ' [alias for ~w]', [Alias]),
167 ( nonvar(TransparentTargetsAtom)
168 -> atom_concat(TransparentTargetsAtom, AliasAtom, Suffix)
169 ; Suffix = AliasAtom
170 )
171 ; Suffix = TransparentTargetsAtom
172 ),
173 ( nonvar(Suffix)
174 -> PropertyList = [suffix(Suffix)|PropertyList2]
175 ; PropertyList = PropertyList2
176 ).
177
178perform_search(Functor, Arity, Module, ExactMatch) :-
179 ( nonvar(Functor)
180 -> setof(
181 p(SearchModule, SearchFunctor, SearchArity, IsAlias),
182 Module^Functor^Arity^ExactMatch^search_predicate_indicator(Module, Functor, Arity, ExactMatch, SearchModule, SearchFunctor, SearchArity, IsAlias),
183 Predicates
184 ),
185 member(p(SearchModule, SearchFunctor, SearchArity, IsAlias), Predicates)
186 ; Module = SearchModule
187 ),
188 ( nonvar(SearchFunctor),
189 nonvar(SearchArity)
190 -> functor(Goal, SearchFunctor, SearchArity)
191 ; true
192 ),
193 collect_candidates(SearchModule, SearchFunctor, SearchArity, Candidates),
194 pdt_walk_code([trace_reference(SearchModule:Goal), predicates(Candidates), on_trace(pdt_xref:assert_result(IsAlias))]),
195 fail.
196
197perform_search(_Functor, _Arity, _SearchMod, _ExactMatch).
198
199search_predicate_indicator(SearchModule0, SearchFunctor0, SearchArity, true, SearchModule, SearchFunctor, SearchArity, IsAlias) :-
200 nonvar(SearchArity),
201 !,
202 ( declared_in_module(SearchModule0, SearchFunctor0, SearchArity, SearchModule0),
203 possible_alias(SearchModule0, SearchFunctor0, SearchArity, SearchModule, SearchFunctor),
204 IsAlias = SearchModule0:SearchFunctor0/SearchArity
205 ; SearchModule0 = SearchModule,
206 SearchFunctor0 = SearchFunctor
207 ).
208
209search_predicate_indicator(SearchModule0, SearchFunctor0, Arity, true, SearchModule, SearchFunctor, SearchArity, IsAlias) :-
210 var(Arity),
211 !,
212 setof(
213 M-A,
214 declared_in_module(M, SearchFunctor0, A, M),
215 MAs
216 ),
217 member(SearchModule0-SearchArity, MAs),
218 ( SearchModule0 = SearchModule,
219 SearchFunctor0 = SearchFunctor
220 ; possible_alias(SearchModule0, SearchFunctor0, SearchArity, SearchModule, SearchFunctor),
221 IsAlias = SearchModule0:SearchFunctor0/SearchArity
222 ).
223
224search_predicate_indicator(SearchModule0, Functor, SearchArity, false, SearchModule, SearchFunctor, SearchArity, IsAlias) :-
225 nonvar(SearchArity),
226 !,
227 setof(
228 M-F,
229 (declared_in_module(M, F, SearchArity, M), once(sub_atom(F, _, _, _, Functor))),
230 MFs
231 ),
232 member(SearchModule0-SearchFunctor0, MFs),
233 ( SearchModule0 = SearchModule,
234 SearchFunctor0 = SearchFunctor
235 ; possible_alias(SearchModule0, SearchFunctor0, SearchArity, SearchModule, SearchFunctor),
236 IsAlias = SearchModule0:SearchFunctor0/SearchArity
237 ).
238
239search_predicate_indicator(SearchModule0, Functor, Arity, false, SearchModule, SearchFunctor, SearchArity, IsAlias) :-
240 var(Arity),
241 !,
242 setof(
243 M-F-A,
244 (declared_in_module(M, F, A, M), once(sub_atom(F, _, _, _, Functor))),
245 MFAs
246 ),
247 member(SearchModule0-SearchFunctor0-SearchArity, MFAs),
248 ( SearchModule0 = SearchModule,
249 SearchFunctor0 = SearchFunctor
250 ; possible_alias(SearchModule0, SearchFunctor0, SearchArity, SearchModule, SearchFunctor),
251 IsAlias = SearchModule0:SearchFunctor0/SearchArity
252 ).
253
254possible_alias(Module, Name, Arity, ImportingModule, AliasName) :-
255 functor(Head, Name, Arity),
256 \+ predicate_property(Module:Head, multifile),
257 predicate_property(Module:Head, file(File)),
258 source_file_property(File, load_context(ImportingModule, _Position, Options)),
259 memberchk(imports(Imports), Options),
260 memberchk(Name/Arity as AliasName, Imports).
261
262perform_search_for_goal(SearchModule, SearchFunctor, SearchArity, SearchGoal) :-
263 collect_candidates(SearchModule, SearchFunctor, SearchArity, Candidates),
264 pdt_walk_code([trace_reference(SearchGoal), predicates(Candidates), on_trace(pdt_xref:assert_result(_))]).
265
266collect_candidates(SearchModule, SearchFunctor, SearchArity, Candidates) :-
267 ensure_call_graph_generated,
268 setof(Module:Name/Arity, (
269 SearchModule^SearchFunctor^SearchArity^NumberOfCalls^calls(SearchModule, SearchFunctor, SearchArity, Module, Name, Arity, NumberOfCalls)
270 ), Candidates).
271
385
386