35
36:- module(check,
37 [ check/0, 38 list_undefined/0, 39 list_undefined/1, 40 list_autoload/0, 41 list_redefined/0, 42 list_void_declarations/0, 43 list_trivial_fails/0, 44 list_trivial_fails/1, 45 list_strings/0, 46 list_strings/1 47 ]).
48:- use_module(library(lists)).
49:- use_module(library(pairs)).
50:- use_module(library(option)).
51:- use_module(library(apply)).
52:- use_module(library(prolog_codewalk)).
53:- use_module(library(occurs)).
54
55:- set_prolog_flag(generate_debug_info, false).
56
57:- multifile
58 trivial_fail_goal/1,
59 string_predicate/1,
60 valid_string_goal/1,
61 checker/2.
62
63:- dynamic checker/2.
64
65
77
78:- predicate_options(list_undefined/1, 1,
79 [ module_class(list(oneof([user,library])))
80 ]).
81
95
96check :-
97 checker(Checker, Message),
98 print_message(informational,check(pass(Message))),
99 catch(Checker,E,print_message(error,E)),
100 fail.
101check.
102
117
118:- thread_local
119 undef/2.
120
121list_undefined :-
122 list_undefined([]).
123
124list_undefined(Options) :-
125 merge_options(Options,
126 [ module_class([user])
127 ],
128 WalkOptions),
129 prolog_walk_code([ undefined(trace),
130 on_trace(found_undef)
131 | WalkOptions
132 ]),
133 findall(PI-From, retract(undef(PI, From)), Pairs),
134 ( Pairs == []
135 -> true
136 ; print_message(warning, check(undefined_predicates)),
137 keysort(Pairs, Sorted),
138 group_pairs_by_key(Sorted, Grouped),
139 maplist(report_undefined, Grouped)
140 ).
141
142:- public found_undef/3.
143
144found_undef(To, _Caller, From) :-
145 goal_pi(To, PI),
146 ( undef(PI, From)
147 -> true
148 ; compiled(PI)
149 -> true
150 ; assertz(undef(PI,From))
151 ).
152
153compiled(system:'$call_cleanup'/0). 154compiled(system:'$catch'/0).
155compiled(system:'$cut'/0).
156
157goal_pi(M:Head, M:Name/Arity) :-
158 functor(Head, Name, Arity).
159
160report_undefined(PI-FromList) :-
161 print_message(warning, check(undefined(PI, FromList))).
162
163
174
175list_autoload :-
176 setup_call_cleanup(
177 ( current_prolog_flag(access_level, OldLevel),
178 current_prolog_flag(autoload, OldAutoLoad),
179 set_prolog_flag(access_level, system),
180 set_prolog_flag(autoload, false)
181 ),
182 list_autoload_(OldLevel),
183 ( set_prolog_flag(access_level, OldLevel),
184 set_prolog_flag(autoload, OldAutoLoad)
185 )).
186
187list_autoload_(SystemMode) :-
188 ( setof(Lib-Pred,
189 autoload_predicate(Module, Lib, Pred, SystemMode),
190 Pairs),
191 print_message(informational,
192 check(autoload(Module, Pairs))),
193 fail
194 ; true
195 ).
196
197autoload_predicate(Module, Library, Name/Arity, SystemMode) :-
198 predicate_property(Module:Head, undefined),
199 check_module_enabled(Module, SystemMode),
200 ( \+ predicate_property(Module:Head, imported_from(_)),
201 functor(Head, Name, Arity),
202 '$find_library'(Module, Name, Arity, _LoadModule, Library),
203 referenced(Module:Head, Module, _)
204 -> true
205 ).
206
207check_module_enabled(_, system) :- !.
208check_module_enabled(Module, _) :-
209 \+ import_module(Module, system).
210
214
215referenced(Term, Module, Ref) :-
216 Goal = Module:_Head,
217 current_predicate(_, Goal),
218 '$get_predicate_attribute'(Goal, system, 0),
219 \+ '$get_predicate_attribute'(Goal, imported, _),
220 nth_clause(Goal, _, Ref),
221 '$xr_member'(Ref, Term).
222
228
229list_redefined :-
230 setup_call_cleanup(
231 ( current_prolog_flag(access_level, OldLevel),
232 set_prolog_flag(access_level, system)
233 ),
234 list_redefined_,
235 set_prolog_flag(access_level, OldLevel)).
236
237list_redefined_ :-
238 current_module(Module),
239 Module \== system,
240 current_predicate(_, Module:Head),
241 \+ predicate_property(Module:Head, imported_from(_)),
242 ( global_module(Super),
243 Super \== Module,
244 '$c_current_predicate'(_, Super:Head),
245 \+ redefined_ok(Head),
246 '$syspreds':'$defined_predicate'(Super:Head),
247 \+ predicate_property(Super:Head, (dynamic)),
248 \+ predicate_property(Super:Head, imported_from(Module)),
249 functor(Head, Name, Arity)
250 -> print_message(informational,
251 check(redefined(Module, Super, Name/Arity)))
252 ),
253 fail.
254list_redefined_.
255
256redefined_ok('$mode'(_,_)).
257redefined_ok('$pldoc'(_,_,_,_)).
258redefined_ok('$pred_option'(_,_,_,_)).
259
260global_module(user).
261global_module(system).
262
266
267list_void_declarations :-
268 P = _:_,
269 ( predicate_property(P, undefined),
270 ( '$get_predicate_attribute'(P, meta_predicate, Pattern),
271 print_message(warning,
272 check(void_declaration(P, meta_predicate(Pattern))))
273 ; void_attribute(Attr),
274 '$get_predicate_attribute'(P, Attr, 1),
275 print_message(warning,
276 check(void_declaration(P, Attr)))
277 ),
278 fail
279 ; true
280 ).
281
282void_attribute(public).
283void_attribute(volatile).
284
295
296:- thread_local
297 trivial_fail/2.
298
299list_trivial_fails :-
300 list_trivial_fails([]).
301
302list_trivial_fails(Options) :-
303 merge_options(Options,
304 [ module_class([user]),
305 infer_meta_predicates(false),
306 autoload(false),
307 evaluate(false),
308 trace_reference(_),
309 on_trace(check_trivial_fail)
310 ],
311 WalkOptions),
312
313 prolog_walk_code([ source(false)
314 | WalkOptions
315 ]),
316 findall(CRef, retract(trivial_fail(clause(CRef), _)), Clauses),
317 ( Clauses == []
318 -> true
319 ; print_message(warning, check(trivial_failures)),
320 prolog_walk_code([ clauses(Clauses)
321 | WalkOptions
322 ]),
323 findall(Goal-From, retract(trivial_fail(From, Goal)), Pairs),
324 keysort(Pairs, Sorted),
325 group_pairs_by_key(Sorted, Grouped),
326 maplist(report_trivial_fail, Grouped)
327 ).
328
333
334trivial_fail_goal(pce_expansion:pce_class(_, _, template, _, _, _)).
335trivial_fail_goal(pce_host:property(system_source_prefix(_))).
336
337:- public
338 check_trivial_fail/3.
339
340check_trivial_fail(MGoal0, _Caller, From) :-
341 ( MGoal0 = M:Goal,
342 atom(M),
343 callable(Goal),
344 predicate_property(MGoal0, interpreted),
345 \+ predicate_property(MGoal0, dynamic),
346 \+ predicate_property(MGoal0, multifile),
347 \+ trivial_fail_goal(MGoal0)
348 -> ( predicate_property(MGoal0, meta_predicate(Meta))
349 -> qualify_meta_goal(MGoal0, Meta, MGoal)
350 ; MGoal = MGoal0
351 ),
352 ( clause(MGoal, _)
353 -> true
354 ; assertz(trivial_fail(From, MGoal))
355 )
356 ; true
357 ).
358
359report_trivial_fail(Goal-FromList) :-
360 print_message(warning, check(trivial_failure(Goal, FromList))).
361
365
366qualify_meta_goal(M:Goal0, Meta, M:Goal) :-
367 functor(Goal0, F, N),
368 functor(Goal, F, N),
369 qualify_meta_goal(1, M, Meta, Goal0, Goal).
370
371qualify_meta_goal(N, M, Meta, Goal0, Goal) :-
372 arg(N, Meta, ArgM),
373 !,
374 arg(N, Goal0, Arg0),
375 arg(N, Goal, Arg),
376 N1 is N + 1,
377 ( module_qualified(ArgM)
378 -> add_module(Arg0, M, Arg)
379 ; Arg = Arg0
380 ),
381 meta_goal(N1, Meta, Goal0, Goal).
382meta_goal(_, _, _, _).
383
384add_module(Arg, M, M:Arg) :-
385 var(Arg),
386 !.
387add_module(M:Arg, _, MArg) :-
388 !,
389 add_module(Arg, M, MArg).
390add_module(Arg, M, M:Arg).
391
392module_qualified(N) :- integer(N), !.
393module_qualified(:).
394module_qualified(^).
395
396
411
412list_strings :-
413 list_strings([module_class([user])]).
414
415list_strings(Options) :-
416 ( prolog_program_clause(ClauseRef, Options),
417 clause(Head, Body, ClauseRef),
418 \+ ( predicate_indicator(Head, PI),
419 string_predicate(PI)
420 ),
421 make_clause(Head, Body, Clause),
422 findall(T,
423 ( sub_term(T, Head),
424 string(T)
425 ; Head = M:_,
426 goal_in_body(Goal, M, Body),
427 ( valid_string_goal(Goal)
428 -> fail
429 ; sub_term(T, Goal),
430 string(T)
431 )
432 ), Ts0),
433 sort(Ts0, Ts),
434 member(T, Ts),
435 message_context(ClauseRef, T, Clause, Context),
436 print_message(warning,
437 check(string_in_clause(T, Context))),
438 fail
439 ; true
440 ).
441
442make_clause(Head, true, Head) :- !.
443make_clause(Head, Body, (Head:-Body)).
444
448
449goal_in_body(M:G, M, G) :-
450 var(G),
451 !.
452goal_in_body(G, _, M:G0) :-
453 atom(M),
454 !,
455 goal_in_body(G, M, G0).
456goal_in_body(G, M, Control) :-
457 nonvar(Control),
458 control(Control, Subs),
459 !,
460 member(Sub, Subs),
461 goal_in_body(G, M, Sub).
462goal_in_body(G, M, G0) :-
463 callable(G0),
464 ( atom(M)
465 -> TM = M
466 ; TM = system
467 ),
468 predicate_property(TM:G0, meta_predicate(Spec)),
469 !,
470 ( strip_goals(G0, Spec, G1),
471 simple_goal_in_body(G, M, G1)
472 ; arg(I, Spec, Meta),
473 arg(I, G0, G1),
474 extend(Meta, G1, G2),
475 goal_in_body(G, M, G2)
476 ).
477goal_in_body(G, M, G0) :-
478 simple_goal_in_body(G, M, G0).
479
480simple_goal_in_body(G, M, G0) :-
481 ( atom(M),
482 callable(G0),
483 predicate_property(M:G0, imported_from(M2))
484 -> G = M2:G0
485 ; G = M:G0
486 ).
487
488control((A,B), [A,B]).
489control((A;B), [A,B]).
490control((A->B), [A,B]).
491control((A*->B), [A,B]).
492control((\+A), [A]).
493
494strip_goals(G0, Spec, G) :-
495 functor(G0, Name, Arity),
496 functor(G, Name, Arity),
497 strip_goal_args(1, G0, Spec, G).
498
499strip_goal_args(I, G0, Spec, G) :-
500 arg(I, G0, A0),
501 !,
502 arg(I, Spec, M),
503 ( extend(M, A0, _)
504 -> arg(I, G, '<meta-goal>')
505 ; arg(I, G, A0)
506 ),
507 I2 is I + 1,
508 strip_goal_args(I2, G0, Spec, G).
509strip_goal_args(_, _, _, _).
510
511extend(I, G0, G) :-
512 callable(G0),
513 integer(I), I>0,
514 !,
515 length(L, I),
516 extend_list(G0, L, G).
517extend(0, G, G).
518extend(^, G, G).
519
520extend_list(M:G0, L, M:G) :-
521 !,
522 callable(G0),
523 extend_list(G0, L, G).
524extend_list(G0, L, G) :-
525 G0 =.. List,
526 append(List, L, All),
527 G =.. All.
528
529
530message_context(ClauseRef, String, Clause, file_term_position(File, StringPos)) :-
531 clause_info(ClauseRef, File, TermPos, _Vars),
532 prolog_codewalk:subterm_pos(String, Clause, ==, TermPos, StringPos),
533 !.
534message_context(ClauseRef, _String, _Clause, file(File, Line, -1, _)) :-
535 clause_property(ClauseRef, file(File)),
536 clause_property(ClauseRef, line_count(Line)),
537 !.
538message_context(ClauseRef, _String, _Clause, clause(ClauseRef)).
539
540
541:- meta_predicate
542 predicate_indicator(:, -).
543
544predicate_indicator(Module:Head, Module:Name/Arity) :-
545 functor(Head, Name, Arity).
546predicate_indicator(Module:Head, Module:Name//DCGArity) :-
547 functor(Head, Name, Arity),
548 DCGArity is Arity-2.
549
554
555string_predicate(_:'$pldoc'/4).
556string_predicate(pce_principal:send_implementation/3).
557string_predicate(pce_principal:pce_lazy_get_method/3).
558string_predicate(pce_principal:pce_lazy_send_method/3).
559string_predicate(pce_principal:pce_class/6).
560string_predicate(prolog_xref:pred_comment/4).
561string_predicate(prolog_xref:module_comment/3).
562string_predicate(pldoc_process:structured_comment//2).
563string_predicate(pldoc_process:structured_command_start/3).
564string_predicate(pldoc_process:separator_line//0).
565string_predicate(pldoc_register:mydoc/3).
566string_predicate(http_header:separators/1).
567
573
575valid_string_goal(system:format(S)) :- string(S).
576valid_string_goal(system:format(S,_)) :- string(S).
577valid_string_goal(system:format(_,S,_)) :- string(S).
578valid_string_goal(system:string_codes(S,_)) :- string(S).
579valid_string_goal(system:string_code(_,S,_)) :- string(S).
580valid_string_goal(system:throw(msg(S,_))) :- string(S).
581valid_string_goal('$dcg':phrase(S,_,_)) :- string(S).
582valid_string_goal('$dcg':phrase(S,_)) :- string(S).
583valid_string_goal(system: is(_,_)). 584valid_string_goal(system: =:=(_,_)).
585valid_string_goal(system: >(_,_)).
586valid_string_goal(system: <(_,_)).
587valid_string_goal(system: >=(_,_)).
588valid_string_goal(system: =<(_,_)).
590valid_string_goal(dcg_basics:string_without(S,_,_,_)) :- string(S).
591valid_string_goal(git:read_url(S,_,_)) :- string(S).
592valid_string_goal(tipc:tipc_subscribe(_,_,_,_,S)) :- string(S).
593valid_string_goal(charsio:format_to_chars(Format,_,_)) :- string(Format).
594valid_string_goal(charsio:format_to_chars(Format,_,_,_)) :- string(Format).
595valid_string_goal(codesio:format_to_codes(Format,_,_)) :- string(Format).
596valid_string_goal(codesio:format_to_codes(Format,_,_,_)) :- string(Format).
597
598
599 602
622
623checker(list_undefined, 'undefined predicates').
624checker(list_trivial_fails, 'trivial failures').
625checker(list_redefined, 'redefined system and global predicates').
626checker(list_void_declarations, 'predicates with declarations but without clauses').
627checker(list_autoload, 'predicates that need autoloading').
628
629
630 633
634:- multifile
635 prolog:message/3.
636
637prolog:message(check(pass(Comment))) -->
638 [ 'Checking ~w ...'-[Comment] ].
639prolog:message(check(find_references(Preds))) -->
640 { length(Preds, N)
641 },
642 [ 'Scanning for references to ~D possibly undefined predicates'-[N] ].
643prolog:message(check(undefined_predicates)) -->
644 [ 'The predicates below are not defined. If these are defined', nl,
645 'at runtime using assert/1, use :- dynamic Name/Arity.', nl, nl
646 ].
647prolog:message(check(undefined(Pred, Refs))) -->
648 { map_list_to_pairs(sort_reference_key, Refs, Keyed),
649 keysort(Keyed, KeySorted),
650 pairs_values(KeySorted, SortedRefs)
651 },
652 predicate(Pred),
653 [ ', which is referenced by', nl ],
654 referenced_by(SortedRefs).
655prolog:message(check(undefined_unreferenced_predicates)) -->
656 [ 'The predicates below are not defined, and are not', nl,
657 'referenced.', nl, nl
658 ].
659prolog:message(check(undefined_unreferenced(Pred))) -->
660 predicate(Pred).
661prolog:message(check(autoload(Module, Pairs))) -->
662 { module_property(Module, file(Path))
663 },
664 !,
665 [ 'Into module ~w ('-[Module] ],
666 short_filename(Path),
667 [ ')', nl ],
668 autoload(Pairs).
669prolog:message(check(autoload(Module, Pairs))) -->
670 [ 'Into module ~w'-[Module], nl ],
671 autoload(Pairs).
672prolog:message(check(redefined(In, From, Pred))) -->
673 predicate(In:Pred),
674 redefined(In, From).
675prolog:message(check(trivial_failures)) -->
676 [ 'The following goals fail because there are no matching clauses.' ].
677prolog:message(check(trivial_failure(Goal, Refs))) -->
678 { map_list_to_pairs(sort_reference_key, Refs, Keyed),
679 keysort(Keyed, KeySorted),
680 pairs_values(KeySorted, SortedRefs)
681 },
682 goal(Goal),
683 [ ', which is called from'-[], nl ],
684 referenced_by(SortedRefs).
685prolog:message(check(string_in_clause(String, Context))) -->
686 prolog:message_location(Context),
687 [ 'String ~q'-[String] ].
688prolog:message(check(void_declaration(P, Decl))) -->
689 predicate(P),
690 [ ' is declared as ~p, but has no clauses'-[Decl] ].
691
692
693redefined(user, system) -->
694 [ '~t~30| System predicate redefined globally' ].
695redefined(_, system) -->
696 [ '~t~30| Redefined system predicate' ].
697redefined(_, user) -->
698 [ '~t~30| Redefined global predicate' ].
699
700goal(user:Goal) -->
701 !,
702 [ '~p'-[Goal] ].
703goal(Goal) -->
704 !,
705 [ '~p'-[Goal] ].
706
707predicate(Module:Name/Arity) -->
708 { atom(Module),
709 atom(Name),
710 integer(Arity),
711 functor(Head, Name, Arity),
712 predicate_name(Module:Head, PName)
713 },
714 !,
715 [ '~w'-[PName] ].
716predicate(Module:Head) -->
717 { atom(Module),
718 callable(Head),
719 predicate_name(Module:Head, PName)
720 },
721 !,
722 [ '~w'-[PName] ].
723predicate(Name/Arity) -->
724 { atom(Name),
725 integer(Arity)
726 },
727 !,
728 predicate(user:Name/Arity).
729
730autoload([]) -->
731 [].
732autoload([Lib-Pred|T]) -->
733 [ ' ' ],
734 predicate(Pred),
735 [ '~t~24| from ' ],
736 short_filename(Lib),
737 [ nl ],
738 autoload(T).
739
743
744sort_reference_key(Term, key(M:Name/Arity, N, ClausePos)) :-
745 clause_ref(Term, ClauseRef, ClausePos),
746 !,
747 nth_clause(Pred, N, ClauseRef),
748 strip_module(Pred, M, Head),
749 functor(Head, Name, Arity).
750sort_reference_key(Term, Term).
751
752clause_ref(clause_term_position(ClauseRef, TermPos), ClauseRef, ClausePos) :-
753 arg(1, TermPos, ClausePos).
754clause_ref(clause(ClauseRef), ClauseRef, 0).
755
756
757referenced_by([]) -->
758 [].
759referenced_by([Ref|T]) -->
760 ['\t'], prolog:message_location(Ref),
761 predicate_indicator(Ref),
762 [ nl ],
763 referenced_by(T).
764
765predicate_indicator(clause_term_position(ClauseRef, _)) -->
766 { nonvar(ClauseRef) },
767 !,
768 predicate_indicator(clause(ClauseRef)).
769predicate_indicator(clause(ClauseRef)) -->
770 { clause_name(ClauseRef, Name) },
771 [ '~w'-[Name] ].
772predicate_indicator(file_term_position(_,_)) -->
773 [ '(initialization)' ].
774predicate_indicator(file(_,_,_,_)) -->
775 [ '(initialization)' ].
776
777
778short_filename(Path) -->
779 { short_filename(Path, Spec)
780 },
781 [ '~q'-[Spec] ].
782
783short_filename(Path, Spec) :-
784 absolute_file_name('', Here),
785 atom_concat(Here, Local0, Path),
786 !,
787 remove_leading_slash(Local0, Spec).
788short_filename(Path, Spec) :-
789 findall(LenAlias, aliased_path(Path, LenAlias), Keyed),
790 keysort(Keyed, [_-Spec|_]).
791short_filename(Path, Path).
792
793aliased_path(Path, Len-Spec) :-
794 setof(Alias, Spec^(user:file_search_path(Alias, Spec)), Aliases),
795 member(Alias, Aliases),
796 Term =.. [Alias, '.'],
797 absolute_file_name(Term,
798 [ file_type(directory),
799 file_errors(fail),
800 solutions(all)
801 ], Prefix),
802 atom_concat(Prefix, Local0, Path),
803 remove_leading_slash(Local0, Local),
804 atom_length(Local, Len),
805 Spec =.. [Alias, Local].
806
807remove_leading_slash(Path, Local) :-
808 atom_concat(/, Local, Path),
809 !.
810remove_leading_slash(Path, Path).