34
35:- module(codewalk_clause, []). 36
37:- use_module(library(prolog_xref), []). 38:- use_module(library(apply)). 39:- use_module(library(lists)). 40:- use_module(library(option)). 41:- use_module(library(ordsets)). 42:- use_module(library(prolog_metainference)). 43:- use_module(library(assertions)). 44:- use_module(library(extend_args)). 45:- use_module(library(extra_location)). 46:- use_module(library(file_clause)). 47:- use_module(library(from_utils)). 48:- use_module(library(meta_args)). 49:- use_module(library(option_utils)). 50:- use_module(library(condconc)). 51:- init_expansors. 52
53:- multifile
54 codewalk:walk_code/2. 55
56codewalk:walk_code(clause, Options1) :-
57 foldl(select_option_default,
58 [on_trace(OnTrace)-(codewalk:true_3),
59 on_head(OnHead)-(codewalk:true_2),
60 trace_reference(To)-To,
61 undefined(Undefined)-ignore,
62 trace_variables(TraceVars)-[],
63 concurrent(Concurrent)-true,
64 walkextras(Extras)-[initialization,
65 declaration,
66 asrparts([body])],
67 variable_names(VNL)-VNL],
68 Options1, Options),
69 option(module(Module), Options, Module),
70 option_files(Options, FileD),
71 Data = data{from:_,
72 on_trace:OnTrace,
73 on_head:OnHead,
74 module:Module,
75 trace_variables:TraceVars,
76 trace_reference:To,
77 concurrent:Concurrent,
78 undefined:Undefined},
79 cond_maplist(Concurrent, walk_extras_c(FileD, Data), [clause|Extras]).
80
(FileD, Opts, Extra) :-
82 walk_extras_(Extra, FileD, Opts).
83
(clause, FileD, Opts) :- walk_clause( FileD, Opts).
85walk_extras_(initialization, FileD, Opts) :- walk_from_initialization( FileD, Opts).
86walk_extras_(declaration, FileD, Opts) :- walk_from_loc_declaration(FileD, Opts).
87walk_extras_(asrparts(L), FileD, Opts) :- walk_from_assertion( FileD, Opts, L).
88
89walk_from_initialization(FileD, Opts) :-
90 forall(( '$init_goal'(_File, Goal, File:Line),
91 get_dict(File, FileD, _),
92 From = file(File, Line, -1, _),
93 option(from(From), Opts)
94 ),
95 walk_head_body('<initialization>', Goal, Opts)).
96
97walk_from_loc_declaration(FileD, Opts) :-
98 forall(( option(from(From), Opts),
99 loc_declaration(Body, M, body, From),
100 from_to_file(From, File),
101 get_dict(File, FileD, _)
102 ),
103 walk_head_body('<declaration>', M:Body, Opts)).
104
105current_assertion_goal(FileD, Opts, AsrPartL, M:Head, CM:Goal) :-
106 assertions:asr_head_prop(Asr, HM, Head, _, _, VNL, _, AFrom),
107 from_to_file(AFrom, File),
108 get_dict(File, FileD, _),
109 b_setval('$variable_names', VNL),
110 predicate_property(HM:Head, implementation_module(M)),
111 member(AsrPart, AsrPartL),
112 option(from(From), Opts),
113 assertion_goal(AsrPart, Asr, Goal, CM, From),
114 option(trace_variables(TraceVars), Opts),
115 maplist(trace_var(M:Head), TraceVars).
116
117walk_from_assertion(FileD, Opts, AsrPartL) :-
118 forall(current_assertion_goal(FileD, Opts, AsrPartL, Head, Goal),
119 walk_head_body('<assertion>'(Head), Goal, Opts)).
120
121assertion_goal(AsrPart, Asr, Prop, PM, From) :-
122 member(AsrPart-PartL,
123 [head-[head],
124 body-[comp, call, succ, glob]]),
125 member(Part, PartL),
126 127 curr_prop_asr(Part, PM:Prop, From, Asr).
128
129walk_clause(FileD, Opts) :-
130 option(trace_variables(TraceVars), Opts),
131 option(from(From), Opts),
132 option(concurrent(Concurrent), Opts),
133 collect_file_clause_db,
134 cond_forall(
135 Concurrent,
136 get_dict(File, FileD, _),
137 walk_clause_file(File, TraceVars, From, Opts)).
138
139walk_clause_file(File, TraceVars, From, Opts) :-
140 forall(file_clause(File, Head, Body, From),
141 ( maplist(trace_var(Head), TraceVars),
142 walk_head_body(Head, Body, Opts)
143 )).
144
145trace_var(Goal, TV) :- var_trace(TV, Goal).
146
147var_trace(non_fresh, Head) :-
148 term_variables(Head, Vars),
149 '$expand':mark_vars_non_fresh(Vars).
150var_trace(meta_arg, Head) :-
151 mark_meta_arguments(Head).
152
153walk_head_body(Head, Body, Opts) :-
154 option(on_head(OnHead), Opts),
155 option(from(From), Opts),
156 ignore(call(OnHead, Head, From)),
157 walk_called(Body, Head, user, Opts),
158 !.
159walk_head_body(Head, Body, _) :-
160 writeln(user_error, walk_head_body(Head, Body, -)),
161 fail.
162
163walk_called_mod(G, C, M, CM, Opts) :-
164 ( atom(M),
165 ( atom(CM)
166 ->NC = CM
167 ; var(CM) 168 ->NC = user
169 )
170 ->ignore(option(module(NC), Opts, NC)),
171 setup_call_cleanup(
172 ( '$current_source_module'(OldM),
173 '$set_source_module'(NC)
174 ),
175 walk_called(G, C, M, Opts),
176 '$set_source_module'(OldM))
177 ; true
178 ).
179
180walk_called(G, _, _, _) :-
181 var(G),
182 !.
183walk_called(true, _, _, _) :- !.
184walk_called(@(G,CM), C, N, Opts) :-
185 !,
186 strip_module(N:G, M, H),
187 walk_called_mod(H, C, M, CM, Opts).
188walk_called(M:G, C, _, Opts) :-
189 !,
190 walk_called_mod(G, C, M, M, Opts).
191walk_called((A,B), C, M, O) :-
192 !,
193 walk_called(A, C, M, O),
194 walk_called(B, C, M, O).
195walk_called((A->B), C, M, O) :-
196 !,
197 walk_called(A, C, M, O),
198 walk_called(B, C, M, O).
199walk_called((A*->B), C, M, O) :-
200 !,
201 walk_called(A, C, M, O),
202 walk_called(B, C, M, O).
203walk_called(\+(A), C, M, O) :-
204 !,
205 \+ \+ walk_called(A, C, M, O).
206walk_called((A;B), C, M, O) :-
207 !,
208 term_variables(A, VA),
209 term_variables(B, VB),
210 sort(VA, SA),
211 sort(VB, SB),
212 ord_union(SA, SB, L),
213 findall(L-V-Att,
214 ( member(E, [A, B]),
215 walk_called(E, C, M, O),
216 term_attvars(L, V),
217 maplist(get_attrs, V, Att)
218 ), LVA),
219 maplist(put_attrs_(L), LVA).
220walk_called(Goal, C, M, O) :-
221 walk_called_3(Goal, C, M, O),
222 fail.
223walk_called(Goal, C, M, O) :-
224 225 ignore(\+ walk_called_ontrace(Goal, C, M, O)),
226 option(trace_variables(TraceVars), O),
227 maplist(trace_var(M:Goal), TraceVars).
228
229put_attrs_(L, L-V-A) :- maplist(put_attrs, V, A).
230
231walk_called_ontrace(Goal, Caller, M, Opts) :-
232 option(trace_reference(To), Opts),
233 To \== (-),
234 ( subsumes_term(To, M:Goal)
235 -> M2 = M
236 ; predicate_property(M:Goal, implementation_module(M2)),
237 subsumes_term(To, M2:Goal)
238 ),
239 option(on_trace(OnTrace), Opts),
240 option(from(From), Opts),
241 call(OnTrace, M2:Goal, Caller, From).
242
243walk_called_3(Goal, _, M, Opts) :-
244 ( predicate_property(M:Goal, implementation_module(IM)),
245 prolog:called_by(Goal, IM, M, Called)
246 ; prolog:called_by(Goal, Called)
247 ),
248 Called \== [],
249 !,
250 walk_called_by(Called, M:Goal, M, Opts).
251walk_called_3(Meta, Caller, M, Opts) :-
252 ( inferred_meta_predicate(M:Meta, Head)
253 ; predicate_property(M:Meta, meta_predicate(Head))
254 ),
255 !,
256 mark_args_non_fresh(1, Head, Meta),
257 '$current_source_module'(CM),
258 walk_meta_call(1, Head, Meta, Caller, CM, Opts).
259walk_called_3(Goal, _, Module, _) :-
260 nonvar(Module),
261 '$get_predicate_attribute'(Module:Goal, defined, 1),
262 !.
263walk_called_3(Goal, Caller, Module, Opts) :-
264 callable(Goal),
265 nonvar(Module),
266 !,
267 undefined(Module:Goal, Caller, Opts).
268walk_called_3(_, _, _, _).
269
270undefined(_, _, Opts) :-
271 option(undefined(ignore), Opts),
272 !.
273undefined(Goal, _, _) :-
274 predicate_property(Goal, autoload(_)),
275 !.
276undefined(Goal, Caller, Opts) :-
277 option(undefined(trace), Opts),
278 option(on_trace(OnTrace), Opts),
279 option(from(From), Opts),
280 call(OnTrace, Goal, Caller, From),
281 fail.
282undefined(_, _, _).
283
284walk_called_by([], _, _, _).
285walk_called_by([H|T], C, CM, O) :-
286 ( H = G+N
287 -> ( extend(G, N, G1, O)
288 -> walk_called(G1, C, CM, O)
289 ; true
290 )
291 ; walk_called(H, C, CM, O)
292 ),
293 walk_called_by(T, C, CM, O).
294
295walk_meta_call(I, Head, Meta, Caller, M, Opts) :-
296 arg(I, Head, AS),
297 !,
298 ( integer(AS)
299 -> arg(I, Meta, MA),
300 ( extend(MA, AS, Goal, Opts)
301 ->walk_called(Goal, Caller, M, Opts)
302 ; true
303 )
304 ; AS == (^)
305 -> arg(I, Meta, MA),
306 remove_quantifier(MA, Goal, M, MG),
307 walk_called(Goal, Caller, MG, Opts)
308 ; AS == (//)
309 -> arg(I, Meta, DCG),
310 walk_dcg_body(DCG, Caller, M, Opts)
311 ; true
312 ),
313 succ(I, I2),
314 walk_meta_call(I2, Head, Meta, Caller, M, Opts).
315walk_meta_call(_, _, _, _, _, _).
316
317mark_args_non_fresh(I, Head, Meta) :-
318 arg(I, Head, AS),
319 !,
320 ( ( integer(AS)
321 ; AS == (^)
322 ; AS == (//)
323 )
324 ->true
325 ; arg(I, Meta, MA),
326 term_variables(MA, Vars),
327 '$expand':mark_vars_non_fresh(Vars)
328 ),
329 succ(I, I2),
330 mark_args_non_fresh(I2, Head, Meta).
331mark_args_non_fresh(_, _, _).
332
333walk_dcg_body(Var, _, _, _) :-
334 var(Var),
335 !.
336walk_dcg_body([], _, _, _) :- !.
337walk_dcg_body([_|_], _, _, _) :- !.
338walk_dcg_body(String, _, _, _) :-
339 string(String),
340 !.
341walk_dcg_body(!, _, _, _) :- !.
342walk_dcg_body(M:G, C, _, O) :-
343 !,
344 ( nonvar(M)
345 -> walk_dcg_body(G, C, M, O)
346 ; fail
347 ).
348walk_dcg_body((A,B), C, M, O) :-
349 !,
350 walk_dcg_body(A, C, M, O),
351 walk_dcg_body(B, C, M, O).
352walk_dcg_body((A->B), C, M, O) :-
353 !,
354 walk_dcg_body(A, C, M, O),
355 walk_dcg_body(B, C, M, O).
356walk_dcg_body((A*->B), C, M, O) :-
357 !,
358 walk_dcg_body(A, C, M, O),
359 walk_dcg_body(B, C, M, O).
360walk_dcg_body((A;B), C, M, O) :-
361 !,
362 \+ \+ walk_dcg_body(A, C, M, O),
363 \+ \+ walk_dcg_body(B, C, M, O).
364walk_dcg_body((A|B), C, M, O) :-
365 !,
366 \+ \+ walk_dcg_body(A, C, M, O),
367 \+ \+ walk_dcg_body(B, C, M, O).
368walk_dcg_body({G}, C, M, O) :-
369 !,
370 walk_called(G, C, M, O).
371walk_dcg_body(G, C, M, O) :-
372 extend_args(G, [_, _], G2),
373 walk_called(G2, C, M, O).
374
375extend(Goal, _, _, _) :-
376 var(Goal),
377 !,
378 fail.
379extend(Goal, 0, Goal, _) :- !.
380extend(M:Goal, N, M:GoalEx, Opts) :-
381 !,
382 extend(Goal, N, GoalEx, Opts).
383extend(Goal, N, GoalEx, _) :-
384 callable(Goal),
385 !,
386 length(Extra, N),
387 '$expand':mark_vars_non_fresh(Extra),
388 extend_args(Goal, Extra, GoalEx).
389extend(Goal, _, _, Opts) :-
390 option(from(From), Opts),
391 print_message(error, error(type_error(callable, Goal), From)),
392 fail.
393
394remove_quantifier(Goal, Goal, M, M) :-
395 var(Goal),
396 !.
397remove_quantifier(_^Goal1, Goal, M1, M) :-
398 !,
399 remove_quantifier(Goal1, Goal, M1, M).
400remove_quantifier(M1:Goal1, Goal, _, M) :-
401 !,
402 remove_quantifier(Goal1, Goal, M1, M).
403remove_quantifier(Goal, Goal, M, M)