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