34
35:- module('$dwim',
36 [ dwim_predicate/2,
37 '$dwim_correct_goal'/3,
38 '$find_predicate'/2,
39 '$similar_module'/2
40 ]). 41
42:- meta_predicate
43 dwim_predicate(:, -),
44 '$dwim_correct_goal'(:, +, -),
45 '$similar_module'(:, -),
46 '$find_predicate'(:, -).
57'$dwim_correct_goal'(M:Goal, Bindings, Corrected) :-
58 correct_goal(Goal, M, Bindings, Corrected).
59
60correct_goal(Goal, M, _, M:Goal) :-
61 var(Goal),
62 !.
63correct_goal(Module:Goal, _, _, Module:Goal) :-
64 ( var(Module)
65 ; var(Goal)
66 ),
67 !.
68correct_goal(Vars^Goal0, M, Bindings, Vars^Goal) :- 69 !,
70 correct_goal(Goal0, M, Bindings, Goal).
71correct_goal(Module:Goal0, _, Bindings, Module:Goal) :-
72 current_predicate(_, Module:Goal0),
73 !,
74 correct_meta_arguments(Goal0, Module, Bindings, Goal).
75correct_goal(Goal0, M, Bindings, M:Goal) :- 76 current_predicate(_, M:Goal0),
77 !,
78 correct_meta_arguments(Goal0, M, Bindings, Goal).
79correct_goal(Goal0, M, Bindings, Goal) :- 80 dwim_predicate_list(M:Goal0, DWIMs0),
81 !,
82 principal_predicates(DWIMs0, M, DWIMs),
83 correct_literal(M:Goal0, Bindings, DWIMs, Goal1),
84 correct_meta_arguments(Goal1, M, Bindings, Goal).
85correct_goal(Goal, Module, _, NewGoal) :- 86 \+ current_prolog_flag(Module:unknown, fail),
87 callable(Goal),
88 !,
89 callable_name_arity(Goal, Name, Arity),
90 '$undefined_procedure'(Module, Name, Arity, Action),
91 ( Action == error
92 -> existence_error(Module:Name/Arity),
93 NewGoal = fail
94 ; Action == retry
95 -> NewGoal = Goal
96 ; NewGoal = fail
97 ).
98correct_goal(Goal, M, _, M:Goal).
99
100callable_name_arity(Goal, Name, Arity) :-
101 compound(Goal),
102 !,
103 compound_name_arity(Goal, Name, Arity).
104callable_name_arity(Goal, Goal, 0) :-
105 atom(Goal).
106
107existence_error(PredSpec) :-
108 strip_module(PredSpec, M, _),
109 current_prolog_flag(M:unknown, Unknown),
110 dwim_existence_error(Unknown, PredSpec).
111
112dwim_existence_error(fail, _) :- !.
113dwim_existence_error(Unknown, PredSpec) :-
114 '$current_typein_module'(TypeIn),
115 unqualify_if_context(TypeIn, PredSpec, Spec),
116 ( no_context(Spec)
117 -> true
118 ; Context = context(toplevel, 'DWIM could not correct goal')
119 ),
120 Error = error(existence_error(procedure, Spec), Context),
121 ( Unknown == error
122 -> throw(Error)
123 ; print_message(warning, Error)
124 ).
131no_context((^)/2).
132no_context((:-)/2).
133no_context((:-)/1).
134no_context((?-)/1).
144correct_meta_arguments(call(Goal), _, _, call(Goal)) :- !.
145correct_meta_arguments(Goal0, M, Bindings, Goal) :-
146 predicate_property(M:Goal0, meta_predicate(MHead)),
147 !,
148 functor(Goal0, Name, Arity),
149 functor(Goal, Name, Arity),
150 correct_margs(0, Arity, MHead, Goal0, Goal, M, Bindings).
151correct_meta_arguments(Goal, _, _, Goal).
152
153correct_margs(Arity, Arity, _, _, _, _, _) :- !.
154correct_margs(A, Arity, MHead, GoalIn, GoalOut, M, Bindings) :-
155 I is A+1,
156 arg(I, GoalIn, Ain),
157 arg(I, GoalOut, AOut),
158 ( arg(I, MHead, 0)
159 -> correct_goal(Ain, M, Bindings, AOut0),
160 unqualify_if_context(M, AOut0, AOut)
161 ; AOut = Ain
162 ),
163 correct_margs(I, Arity, MHead, GoalIn, GoalOut, M, Bindings).
171correct_literal(Goal, Bindings, [Dwim], DwimGoal) :-
172 strip_module(Goal, CM, G1),
173 strip_module(Dwim, DM, G2),
174 callable_name_arity(G1, _, Arity),
175 callable_name_arity(G2, Name, Arity), 176 !,
177 change_functor_name(G1, Name, G2),
178 ( ( current_predicate(CM:Name/Arity)
179 -> ConfirmGoal = G2,
180 DwimGoal = CM:G2
181 ; '$prefix_module'(DM, CM, G2, ConfirmGoal),
182 DwimGoal = ConfirmGoal
183 ),
184 goal_name(ConfirmGoal, Bindings, String),
185 '$confirm'(dwim_correct(String))
186 -> true
187 ; DwimGoal = Goal
188 ).
189correct_literal(Goal, Bindings, Dwims, NewGoal) :-
190 strip_module(Goal, _, G1),
191 callable_name_arity(G1, _, Arity),
192 include_arity(Dwims, Arity, [Dwim]),
193 !,
194 correct_literal(Goal, Bindings, [Dwim], NewGoal).
195correct_literal(Goal, _, Dwims, _) :-
196 print_message(error, dwim_undefined(Goal, Dwims)),
197 fail.
198
199change_functor_name(Term1, Name2, Term2) :-
200 compound(Term1),
201 !,
202 compound_name_arguments(Term1, _, Arguments),
203 compound_name_arguments(Term2, Name2, Arguments).
204change_functor_name(Term1, Name2, Name2) :-
205 atom(Term1).
206
207include_arity([], _, []).
208include_arity([H|T0], Arity, [H|T]) :-
209 strip_module(H, _, G),
210 functor(G, _, Arity),
211 !,
212 include_arity(T0, Arity, T).
213include_arity([_|T0], Arity, T) :-
214 include_arity(T0, Arity, T).
215
216
220
221goal_name(Goal, Bindings, String) :-
222 State = s(_),
223 ( bind_vars(Bindings),
224 numbervars(Goal, 0, _, [singletons(true), attvar(skip)]),
225 format(string(S), '~q', [Goal]),
226 nb_setarg(1, State, S),
227 fail
228 ; arg(1, State, String)
229 ).
230
231bind_vars([]).
232bind_vars([Name=Var|T]) :-
233 Var = '$VAR'(Name), 234 !,
235 bind_vars(T).
236bind_vars([_|T]) :-
237 bind_vars(T).
252'$find_predicate'(M:S, List) :-
253 name_arity(S, Name, Arity),
254 '$current_typein_module'(TypeIn),
255 ( M == TypeIn 256 -> true
257 ; Module = M
258 ),
259 find_predicate(Module, Name, Arity, L0),
260 !,
261 sort(L0, L1),
262 principal_pis(L1, Module, List).
263'$find_predicate'(_:S, List) :-
264 name_arity(S, Name, Arity),
265 findall(Name/Arity,
266 '$in_library'(Name, Arity, _Path), List),
267 List \== [],
268 !.
269'$find_predicate'(Spec, _) :-
270 existence_error(Spec),
271 fail.
272
273find_predicate(Module, Name, Arity, VList) :-
274 findall(Head, find_predicate_(Module, Name, Arity, Head), VList),
275 VList \== [],
276 !.
277find_predicate(Module, Name, Arity, Pack) :-
278 findall(PI, find_sim_pred(Module, Name, Arity, PI), List),
279 pack(List, Module, Arity, Packs),
280 '$member'(Dwim-Pack, Packs),
281 '$confirm'(dwim_correct(Dwim)),
282 !.
283
284unqualify_if_context(_, X, X) :-
285 var(X),
286 !.
287unqualify_if_context(C, C2:X, X) :-
288 C == C2,
289 !.
290unqualify_if_context(_, X, X) :- !.
297pack([], _, _, []) :- !.
298pack([M:T|Rest], Module, Arity, [Name-[M:T|R]|Packs]) :-
299 pack_name(M:T, Module, Arity, Name),
300 pack_(Module, Arity, Name, Rest, R, NewRest),
301 pack(NewRest, Module, Arity, Packs).
302
303pack_(Module, Arity, Name, List, [H|R], Rest) :-
304 '$select'(M:PI, List, R0),
305 pack_name(M:PI, Module, Arity, Name),
306 !,
307 '$prefix_module'(M, C, PI, H),
308 pack_(Module, Arity, Name, C, R0, R, Rest).
309pack_(_, _, _, _, Rest, [], Rest).
310
311pack_name(_:Name/_, M, A, Name) :-
312 var(M), var(A),
313 !.
314pack_name(M:Name/_, _, A, M:Name) :-
315 var(A),
316 !.
317pack_name(_:PI, M, _, PI) :-
318 var(M),
319 !.
320pack_name(QPI, _, _, QPI).
321
322
323find_predicate_(Module, Name, Arity, Module:Name/Arity) :-
324 current_module(Module),
325 current_predicate(Name, Module:Term),
326 functor(Term, Name, Arity).
327
328find_sim_pred(M, Name, Arity, Module:DName/DArity) :-
329 sim_module(M, Module),
330 '$dwim_predicate'(Module:Name, Term),
331 functor(Term, DName, DArity),
332 sim_arity(Arity, DArity).
333
334sim_module(M, Module) :-
335 var(M),
336 !,
337 current_module(Module).
338sim_module(M, M) :-
339 current_module(M),
340 !.
341sim_module(M, Module) :-
342 current_module(Module),
343 dwim_match(M, Module).
344
345sim_arity(A, _) :- var(A), !.
346sim_arity(A, D) :- abs(A-D) < 2.
353name_arity(Atom, Atom, _) :-
354 atom(Atom),
355 !.
356name_arity(Name/Arity, Name, Arity) :- !.
357name_arity(Name//DCGArity, Name, Arity) :-
358 ( var(DCGArity)
359 -> true
360 ; Arity is DCGArity+2
361 ).
362name_arity(Term, Name, Arity) :-
363 callable(Term),
364 !,
365 functor(Term, Name, Arity).
366name_arity(Spec, _, _) :-
367 throw(error(type_error(predicate_indicator, Spec), _)).
368
369
370principal_pis(PIS, M, Principals) :-
371 map_pi_heads(PIS, Heads),
372 principal_predicates(Heads, M, Heads2),
373 map_pi_heads(Principals, Heads2).
374
375map_pi_heads([], []) :- !.
376map_pi_heads([PI0|T0], [H0|T]) :-
377 map_pi_head(PI0, H0),
378 map_pi_heads(T0, T).
379
380map_pi_head(M:PI, M:Head) :-
381 nonvar(M),
382 !,
383 map_pi_head(PI, Head).
384map_pi_head(Name/Arity, Term) :-
385 functor(Term, Name, Arity).
392principal_predicates(Heads, M, Principals) :-
393 find_definitions(Heads, M, Heads2),
394 strip_subsumed_heads(Heads2, Principals).
395
396find_definitions([], _, []).
397find_definitions([H0|T0], M, [H|T]) :-
398 find_definition(H0, M, H),
399 find_definitions(T0, M, T).
400
401find_definition(Head, _, Def) :-
402 strip_module(Head, _, Plain),
403 callable(Plain),
404 ( predicate_property(Head, imported_from(Module))
405 -> ( predicate_property(system:Plain, imported_from(Module)),
406 sub_atom(Module, 0, _, _, $)
407 -> Def = system:Plain
408 ; Def = Module:Plain
409 )
410 ; Def = Head
411 ).
419strip_subsumed_heads([], []).
420strip_subsumed_heads([H|T0], T) :-
421 '$member'(H2, T0),
422 subsumes_term(H2, H),
423 \+ subsumes_term(H, H2),
424 !,
425 strip_subsumed_heads(T0, T).
426strip_subsumed_heads([H|T0], [H|T]) :-
427 strip_subsumed(T0, H, T1),
428 strip_subsumed_heads(T1, T).
429
430strip_subsumed([], _, []).
431strip_subsumed([H|T0], G, T) :-
432 subsumes_term(G, H),
433 !,
434 strip_subsumed(T0, G, T).
435strip_subsumed([H|T0], G, [H|T]) :-
436 strip_subsumed(T0, G, T).
448dwim_predicate(Head, DWIM) :-
449 dwim_predicate_list(Head, DWIMs),
450 '$member'(DWIM, DWIMs).
451
452dwim_predicate_list(Head, [Head]) :-
453 current_predicate(_, Head),
454 !.
455dwim_predicate_list(M:Head, DWIMs) :-
456 setof(DWIM, dwim_pred(M:Head, DWIM), DWIMs),
457 !.
458dwim_predicate_list(Head, DWIMs) :-
459 setof(DWIM, '$similar_module'(Head, DWIM), DWIMs),
460 !.
461dwim_predicate_list(_:Goal, DWIMs) :-
462 setof(Module:Goal,
463 current_predicate(_, Module:Goal),
464 DWIMs).
471dwim_pred(Head, M:Dwim) :-
472 strip_module(Head, Module, H),
473 default_module(Module, M),
474 '$dwim_predicate'(M:H, Dwim).
481'$similar_module'(Module:Goal, DwimModule:Goal) :-
482 current_module(DwimModule),
483 dwim_match(Module, DwimModule),
484 current_predicate(_, DwimModule:Goal)