34
35:- module(called_from, [called_from/1,
36 called_from/2,
37 called_from/5,
38 collect_called_from/5,
39 collect_called_from/6,
40 current_called_from/5,
41 current_used_from/6,
42 used_predicates/2,
43 used_predicates/3
44 ]). 45
46:- use_module(library(option)). 47:- use_module(library(pairs)). 48:- use_module(library(assertions)). 49:- use_module(library(normalize_head)). 50:- use_module(library(normalize_pi)). 51:- use_module(library(codewalk)). 52:- use_module(library(extra_location)). 53:- use_module(library(location_utils)). 54:- use_module(library(dynamic_locations)). 55:- use_module(library(from_utils)). 56:- init_expansors. 57
58:- multifile
59 prolog:message//1. 60
61:- dynamic called_from_db/5. 62
63prolog:message(acheck(called_from(MsgLoc, Args))) -->
64 MsgLoc,
65 ['~w called from ~w'-Args].
66
67called_from(Ref) :-
68 called_from(Ref, _).
69
70called_from(Ref, Caller) :-
71 ( called_from(Ref, _CM, Caller, [], Sorted),
72 maplist(print_call_point, Sorted),
73 fail
74 ; cleanup_dynl_db,
75 retractall(called_from_db(_, _, _, _, _))
76 ).
77
78called_from(Ref, CM, Caller, Options, Pairs) :-
79 normalize_head(Ref, M:H),
80 collect_called_from(H, M, CM, Caller, Options, Pairs).
81
82collect_called_from(H, M, CM, Caller, Options, Sorted) :-
83 collect_called_from(H, M, CM, Caller, Options),
84 findall(Loc-[M:F/A, CPI],
85 ( current_called_from(H, M, CM, From, C),
86 functor(H, F, A),
87 normalize_pi(C, CPI),
88 from_location(From, Loc)
89 ), Pairs),
90 sort(Pairs, Sorted).
91
92collect_called_from(Ref, M, CM, Caller, Options1) :-
93 retractall(called_from_db(_, _, _, _, _)),
94 merge_options([source(true),
95 infer_meta_predicates(false),
96 autoload(false),
97 evaluate(false),
98 method(prolog),
99 trace_reference(_:Ref),
100 module_class([user, system, library]),
101 on_trace(collect_call_point(M, CM, Caller))],
102 Options1, Options),
103 walk_code(Options).
104
105current_called_from(H, M, CM, From, Caller) :-
106 current_used_from([retract, query], H, M, CM, From, Caller).
107
108current_used_from(DynTypes, H, M, CM, From, Caller) :-
109 ( called_from_db(H, M, CM, Caller, From)
110 ; loc_dynamic(H, M, dynamic(Type, CM, Caller), From),
111 memberchk(Type, DynTypes)
112 ; loc_declaration(H, CM, goal, From),
113 predicate_property(CM:H, implementation_module(M))
114 ; curr_prop_asr(head, CM:H, From, _),
115 predicate_property(CM:H, implementation_module(M)),
116 Caller = '<assertion>'(M:H)
117 ).
118
119:- public collect_call_point/6. 120:- meta_predicate collect_call_point(?, ?, ?, +, +, +). 121collect_call_point(IM, M, Caller, MGoal, Caller, From) :-
122 ignore(record_location_dynamic(MGoal, IM, From)),
123 MGoal = M:Goal,
124 predicate_property(MGoal, implementation_module(IM)),
125 update_fact_from(called_from_db(Goal, IM, M, Caller), From).
126
127print_call_point(L-A) :-
128 print_message(information, acheck(called_from(L, A))).
129
136used_predicates(Module, Context, PIL) :-
137 collect_called_from(_, Module, Context, _, [source(false)]),
138 findall(F/A,
139 ( current_called_from(H, Module, Context, _, _),
140 functor(H, F, A)
141 ), PIU),
142 sort(PIU, PIL).
143
144used_predicates(Module, Groups) :-
145 collect_called_from(_, Module, _, _, [source(false)]),
146 findall(Context-(F/A),
147 ( current_called_from(H, Module, Context, _, _),
148 functor(H, F, A)
149 ), Pairs),
150 sort(Pairs, Sorted),
151 group_pairs_by_key(Sorted, Groups)