36
37:- module(prolog_explain,
38 [ explain/1,
39 explain/2
40 ]). 41:- autoload(library(apply),[maplist/2]). 42:- autoload(library(lists),[flatten/2]). 43:- autoload(library(prolog_code), [pi_head/2]). 44:- autoload(library(solution_sequences), [distinct/2]). 45
46:- if(exists_source(library(pldoc/man_index))). 47:- autoload(library(pldoc/man_index), [man_object_property/2]). 48:- endif. 49
70
94
95explain(Item) :-
96 explain(Item, Explanation),
97 print_message(information, explain(Explanation)),
98 fail.
99explain(_).
100
101 104
110
111explain(Var, [isa(Var, 'unbound variable')]) :-
112 var(Var),
113 !.
114explain(I, [isa(I, 'an integer')]) :-
115 integer(I),
116 !.
117explain(F, [isa(F, 'a floating point number')]) :-
118 float(F),
119 !.
120explain(Q, [isa(Q, 'a rational (Q) number'),T]) :-
121 rational(Q),
122 ( catch(F is float(Q), error(evaluation_error(_),_), fail)
123 -> T = ' with approximate floating point value ~w'-[F]
124 ; T = ' that can not be represented as a floating point number'
125 ),
126 !.
127explain(S, [isa(S, 'a string of length ~D'-[Len])]) :-
128 string(S),
129 string_length(S, Len),
130 !.
131explain([], [isa([], 'a special constant denoting an empty list')]) :-
132 !.
133explain(A, [isa(A, 'an atom of length ~D'-[Len])]) :-
134 atom(A),
135 atom_length(A, Len).
136explain(A, Explanation) :-
137 atom(A),
138 current_op(Pri, F, A),
139 op_type(F, Type),
140 Explanation = [ isa(A, 'a ~w (~w) operator of priority ~d'-[Type, F, Pri]) ].
141explain(A, Explanation) :-
142 atom(A),
143 !,
144 explain_atom(A, Explanation).
145explain([H|T], Explanation) :-
146 List = [H|T],
147 is_list(T),
148 !,
149 length(List, L),
150 ( Explanation = [ isa(List, 'a proper list with ~d elements'-[L]) ]
151 ; maplist(printable, List),
152 Explanation = [ indent, 'Text is "~s"'-[List] ]
153 ).
154explain(List, Explanation) :-
155 List = [_|_],
156 !,
157 length(List, L),
158 !,
159 Explanation = [isa(List, 'is a not-closed list with ~D elements'-[L])].
160explain(Dict, Explanation) :-
161 is_dict(Dict, Tag),
162 !,
163 dict_pairs(Dict, Tag, Pairs),
164 length(Pairs, Count),
165 Explanation = [isa(Dict, 'is a dict with tag ~p and ~D keys'-[Tag, Count])].
166explain(Name//NTArity, Explanation) :-
167 atom(Name),
168 integer(NTArity),
169 NTArity >= 0,
170 !,
171 Arity is NTArity + 2,
172 explain(Name/Arity, Explanation).
173explain(Name/Arity, Explanation) :-
174 atom(Name),
175 integer(Arity),
176 Arity >= 0,
177 !,
178 functor(Head, Name, Arity),
179 distinct(Module, known_predicate(Module:Head)),
180 ( Module == system
181 -> true
182 ; \+ predicate_property(Module:Head, imported_from(_))
183 ),
184 explain_predicate(Module:Head, Explanation).
185explain(Module:Name/Arity, Explanation) :-
186 atom(Module), atom(Name), integer(Arity),
187 !,
188 functor(Head, Name, Arity),
189 explain_predicate(Module:Head, Explanation).
190explain(Module:Property, Explanation) :-
191 atom(Property),
192 explain_property(Property, Module, Explanation).
193explain(Module:Head, Explanation) :-
194 atom(Module), callable(Head),
195 predicate_property(Module:Head, _),
196 !,
197 explain_predicate(Module:Head, Explanation).
198explain(Term, Explanation) :-
199 compound(Term),
200 compound_name_arity(Term, _Name, Arity),
201 numbervars(Term, 0, _, [singletons(true)]),
202 Explanation = [isa(Term, 'is a compound term with arity ~D'-[Arity])].
203explain(Term, Explanation) :-
204 explain_functor(Term, Explanation).
205
211
212known_predicate(M:Head) :-
213 var(M),
214 current_predicate(_, M2:Head),
215 ( predicate_property(M2:Head, imported_from(M))
216 -> true
217 ; M = M2
218 ).
219known_predicate(Pred) :-
220 predicate_property(Pred, undefined).
221known_predicate(_:Head) :-
222 functor(Head, Name, Arity),
223 '$in_library'(Name, Arity, _Path).
224
225op_type(X, prefix) :-
226 atom_chars(X, [f, _]).
227op_type(X, infix) :-
228 atom_chars(X, [_, f, _]).
229op_type(X, postfix) :-
230 atom_chars(X, [_, f]).
231
232printable(C) :-
233 integer(C),
234 code_type(C, graph).
235
236
237 240
241explain_atom(A, Explanation) :-
242 referenced(A, Explanation).
243explain_atom(A, Explanation) :-
244 current_predicate(A, Module:Head),
245 ( Module == system
246 -> true
247 ; \+ predicate_property(Module:Head, imported_from(_))
248 ),
249 explain_predicate(Module:Head, Explanation).
250explain_atom(A, Explanation) :-
251 predicate_property(Module:Head, undefined),
252 functor(Head, A, _),
253 explain_predicate(Module:Head, Explanation).
254explain_atom(A, Explanation) :-
255 explain_property(A, _, Explanation).
256
261
262explain_property(Prop, M, Explanation) :-
263 explainable_property(Prop),
264 ( var(M)
265 -> freeze(M, module_property(M, class(user)))
266 ; true
267 ),
268 Pred = M:_,
269 predicate_property(Pred, Prop),
270 \+ predicate_property(Pred, imported_from(_)),
271 \+ hide_reference(Pred),
272 explain_predicate(Pred, Explanation).
273
274explainable_property(dynamic).
275explainable_property(thread_local).
276explainable_property(multifile).
277explainable_property(tabled).
278
279 282
283explain_functor(Head, Explanation) :-
284 referenced(Head, Explanation).
285explain_functor(Head, Explanation) :-
286 current_predicate(_, Module:Head),
287 \+ predicate_property(Module:Head, imported_from(_)),
288 explain_predicate(Module:Head, Explanation).
289explain_functor(Head, Explanation) :-
290 predicate_property(M:Head, undefined),
291 ( functor(Head, N, A),
292 Explanation = [ pi(M:N/A), 'is an undefined predicate' ]
293 ; referenced(M:Head, Explanation)
294 ).
295
296
297 300
301lproperty(built_in, [' built-in']).
302lproperty(thread_local, [' thread-local']).
303lproperty(dynamic, [' dynamic']).
304lproperty(multifile, [' multifile']).
305lproperty(transparent, [' meta']).
306
307tproperty(Pred, Explanation) :-
308 ( predicate_property(Pred, number_of_clauses(Count))
309 -> Explanation = [' with ~D clauses '-[Count]]
310 ; predicate_property(Pred, thread_local)
311 -> thread_self(Me),
312 Explanation = [' without clauses in thread ',
313 ansi(code, '~p', [Me]) ]
314 ; Explanation = [' without clauses']
315 ).
316tproperty(Pred, [' imported from module ', module(Module)]) :-
317 predicate_property(Pred, imported(Module)).
318tproperty(Pred, [' defined in ', url(File:Line)]) :-
319 predicate_property(Pred, file(File)),
320 predicate_property(Pred, line_count(Line)).
321tproperty(Pred, [' that can be autoloaded']) :-
322 predicate_property(Pred, autoload).
323
325
326explain_predicate(Pred, Explanation) :-
327 Pred = Module:Head,
328 functor(Head, Name, Arity),
329 ( predicate_property(Pred, non_terminal)
330 -> What = 'non-terminal'
331 ; What = 'predicate'
332 ),
333 ( predicate_property(Pred, undefined)
334 -> Explanation = [ pi(Module:Name/Arity),
335 ansi([bold,fg(default)], ' is an undefined ~w', [What])
336 ]
337 ; ( var(Module)
338 -> U0 = [ pi(Name/Arity),
339 ansi([bold,fg(default)], ' is a', [])
340 ]
341 ; U0 = [ pi(Module:Name/Arity),
342 ansi([bold,fg(default)], ' is a', [])
343 ]
344 ),
345 findall(Utter, (lproperty(Prop, Utter),
346 predicate_property(Pred, Prop)),
347 U1),
348 U2 = [ansi([bold,fg(default)], ' ~w', [What]) ],
349 findall(Utter, tproperty(Pred, Utter),
350 U3),
351 flatten([U0, U1, U2, U3], Explanation)
352 ).
353explain_predicate(Pred, Explanation) :-
354 distinct(Explanation, predicate_summary(Pred, Explanation)).
355explain_predicate(Pred, Explanation) :-
356 referenced(Pred, Explanation).
357
358:- if(current_predicate(man_object_property/2)). 359predicate_summary(Pred, Explanation) :-
360 Pred = _Module:Head,
361 functor(Head, Name, Arity),
362 man_object_property(Name/Arity, summary(Summary)),
363 source_file(Pred, File),
364 current_prolog_flag(home, Home),
365 sub_atom(File, 0, _, _, Home),
366 Explanation = [indent, 'Summary: "~w"'-[Summary] ].
367:- else. 368predicate_summary(_Pred, _Explanation) :-
369 fail.
370:- endif. 371
372
373 376
377referenced(Term, Explanation) :-
378 current_predicate(_, Module:Head),
379 ( predicate_property(Module:Head, built_in)
380 -> current_prolog_flag(access_level, system)
381 ; true
382 ),
383 \+ predicate_property(Module:Head, imported_from(_)),
384 Module:Head \= help_index:predicate(_,_,_,_,_),
385 nth_clause(Module:Head, N, Ref),
386 '$xr_member'(Ref, Term),
387 utter_referenced(Module:Head, N, Ref,
388 'Referenced', Explanation).
389referenced(_:Head, Explanation) :-
390 current_predicate(_, Module:Head),
391 ( predicate_property(Module:Head, built_in)
392 -> current_prolog_flag(access_level, system)
393 ; true
394 ),
395 \+ predicate_property(Module:Head, imported_from(_)),
396 nth_clause(Module:Head, N, Ref),
397 '$xr_member'(Ref, Head),
398 utter_referenced(Module:Head, N, Ref,
399 'Possibly referenced', Explanation).
400
401utter_referenced(_Module:class(_,_,_,_,_,_), _, _, _, _) :-
402 current_prolog_flag(xpce, true),
403 !,
404 fail.
405utter_referenced(_Module:lazy_send_method(_,_,_), _, _, _, _) :-
406 current_prolog_flag(xpce, true),
407 !,
408 fail.
409utter_referenced(_Module:lazy_get_method(_,_,_), _, _, _, _) :-
410 current_prolog_flag(xpce, true),
411 !,
412 fail.
413utter_referenced(From, _, _, _, _) :-
414 hide_reference(From),
415 !,
416 fail.
417utter_referenced(pce_xref:defined(_,_,_), _, _, _, _) :-
418 !,
419 fail.
420utter_referenced(pce_xref:called(_,_,_), _, _, _, _) :-
421 !,
422 fail.
423utter_referenced(pce_principal:send_implementation(_, _, _),
424 _, Ref, Text, Explanation) :-
425 current_prolog_flag(xpce, true),
426 !,
427 xpce_method_id(Ref, Id),
428 Explanation = [indent, '~w from ~w'-[Text, Id]].
429utter_referenced(pce_principal:get_implementation(Id, _, _, _),
430 _, Ref, Text, Explanation) :-
431 current_prolog_flag(xpce, true),
432 !,
433 xpce_method_id(Ref, Id),
434 Explanation = [indent, '~w from ~w'-[Text, Id]].
435utter_referenced(Head, N, Ref, Text, Explanation) :-
436 clause_property(Ref, file(File)),
437 clause_property(Ref, line_count(Line)),
438 !,
439 pi_head(PI, Head),
440 Explanation = [ indent,
441 '~w from ~d-th clause of '-[Text, N],
442 pi(PI), ' at ', url(File:Line)
443 ].
444utter_referenced(Head, N, _Ref, Text, Explanation) :-
445 pi_head(PI, Head),
446 Explanation = [ indent,
447 '~w from ~d-th clause of '-[Text, N],
448 pi(PI)
449 ].
450
451xpce_method_id(Ref, Id) :-
452 clause(Head, _Body, Ref),
453 strip_module(Head, _, H),
454 arg(1, H, Id).
455
456hide_reference(pce_xref:exported(_,_)).
457hide_reference(pce_xref:defined(_,_,_)).
458hide_reference(pce_xref:called(_,_,_)).
459hide_reference(prolog_xref:called(_,_,_,_,_)).
460hide_reference(prolog_xref:pred_mode(_,_,_)).
461hide_reference(prolog_xref:exported(_,_)).
462hide_reference(prolog_xref:dynamic(_,_,_)).
463hide_reference(prolog_xref:imported(_,_,_)).
464hide_reference(prolog_xref:pred_comment(_,_,_,_)).
465hide_reference(_:'$mode'(_,_)).
466hide_reference(_:'$pldoc'(_,_,_,_)).
467hide_reference(_:'$pldoc_link'(_,_)).
468hide_reference(prolog_manual_index:man_index(_,_,_,_,_)).
469
470
471 474
475:- multifile
476 prolog:message//1. 477
478prolog:message(explain(Explanation)) -->
479 report(Explanation).
480
481report(Explanation) -->
482 { string(Explanation),
483 !,
484 split_string(Explanation, "\n", "", Lines)
485 },
486 lines(Lines).
487report(Explanation) -->
488 { is_list(Explanation) },
489 report_list(Explanation).
490
491lines([]) -->
492 [].
493lines([H]) -->
494 !,
495 [ '~s'-[H] ].
496lines([H|T]) -->
497 [ '~s'-[H], nl ],
498 lines(T).
499
500report_list([]) -->
501 [].
502report_list([H|T]) -->
503 report1(H),
504 report_list(T).
505
506report1(indent) -->
507 !,
508 [ '~t~6|'-[] ].
509report1(String) -->
510 { atomic(String) },
511 [ '~w'-[String] ].
512report1(Fmt-Args) -->
513 !,
514 [ Fmt-Args ].
515report1(url(Location)) -->
516 [ url(Location) ].
517report1(url(URL, Label)) -->
518 [ url(URL, Label) ].
519report1(pi(PI)) -->
520 { pi_nt(PI, NT) },
521 [ ansi(code, '~q', [NT]) ].
522report1(ansi(Style, Fmt, Args)) -->
523 [ ansi(Style, Fmt, Args) ].
524report1(isa(Obj, Fmt-Args)) -->
525 !,
526 [ ansi(code, '~p', [Obj]),
527 ansi([bold,fg(default)], ' is ', []),
528 ansi([bold,fg(default)], Fmt, Args)
529 ].
530report1(isa(Obj, Descr)) -->
531 [ ansi(code, '~p', [Obj]),
532 ansi([bold,fg(default)], ' is ~w', [Descr])
533 ].
534
535pi_nt(Module:Name/Arity, NT),
536 atom(Module), atom(Name), integer(Arity),
537 Arity >= 2,
538 functor(Head, Name, Arity),
539 predicate_property(Module:Head, non_terminal) =>
540 Arity2 is Arity - 2,
541 NT = Module:Name//Arity2.
542pi_nt(PI, NT) =>
543 NT = PI