1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2018, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(check,
   38        [ check/0,                      % run all checks
   39          list_undefined/0,             % list undefined predicates
   40          list_undefined/1,             % +Options
   41          list_autoload/0,              % list predicates that need autoloading
   42          list_redefined/0,             % list redefinitions
   43          list_void_declarations/0,     % list declarations with no clauses
   44          list_trivial_fails/0,         % list goals that trivially fail
   45          list_trivial_fails/1,         % +Options
   46          list_strings/0,               % list string objects in clauses
   47          list_strings/1                % +Options
   48        ]).   49:- use_module(library(lists)).   50:- use_module(library(pairs)).   51:- use_module(library(option)).   52:- use_module(library(apply)).   53:- use_module(library(prolog_codewalk)).   54:- use_module(library(occurs)).   55
   56:- set_prolog_flag(generate_debug_info, false).   57
   58:- multifile
   59       trivial_fail_goal/1,
   60       string_predicate/1,
   61       valid_string_goal/1,
   62       checker/2.   63
   64:- dynamic checker/2.   65
   66
   67/** <module> Consistency checking
   68
   69This library provides some consistency  checks   for  the  loaded Prolog
   70program. The predicate make/0 runs   list_undefined/0  to find undefined
   71predicates in `user' modules.
   72
   73@see    gxref/0 provides a graphical cross referencer
   74@see    PceEmacs performs real time consistency checks while you edit
   75@see    library(prolog_xref) implements `offline' cross-referencing
   76@see    library(prolog_codewalk) implements `online' analysis
   77*/
   78
   79:- predicate_options(list_undefined/1, 1,
   80                     [ module_class(list(oneof([user,library])))
   81                     ]).   82
   83%!  check is det.
   84%
   85%   Run all consistency checks defined by checker/2. Checks enabled by
   86%   default are:
   87%
   88%     * list_undefined/0 reports undefined predicates
   89%     * list_trivial_fails/0 reports calls for which there is no
   90%       matching clause.
   91%     * list_redefined/0 reports predicates that have a local
   92%       definition and a global definition.  Note that these are
   93%       *not* errors.
   94%     * list_autoload/0 lists predicates that will be defined at
   95%       runtime using the autoloader.
   96
   97check :-
   98    checker(Checker, Message),
   99    print_message(informational,check(pass(Message))),
  100    catch(Checker,E,print_message(error,E)),
  101    fail.
  102check.
  103
  104%!  list_undefined is det.
  105%!  list_undefined(+Options) is det.
  106%
  107%   Report undefined predicates.  This   predicate  finds  undefined
  108%   predicates by decompiling and analyzing the body of all clauses.
  109%   Options:
  110%
  111%       * module_class(+Classes)
  112%       Process modules of the given Classes.  The default for
  113%       classes is =|[user]|=. For example, to include the
  114%       libraries into the examination, use =|[user,library]|=.
  115%
  116%   @see gxref/0 provides a graphical cross-referencer.
  117%   @see make/0 calls list_undefined/0
  118
  119:- thread_local
  120    undef/2.  121
  122list_undefined :-
  123    list_undefined([]).
  124
  125list_undefined(Options) :-
  126    merge_options(Options,
  127                  [ module_class([user])
  128                  ],
  129                  WalkOptions),
  130    call_cleanup(
  131        prolog_walk_code([ undefined(trace),
  132                           on_trace(found_undef)
  133                         | WalkOptions
  134                         ]),
  135        collect_undef(Grouped)),
  136    (   Grouped == []
  137    ->  true
  138    ;   print_message(warning, check(undefined_procedures, Grouped))
  139    ).
  140
  141% The following predicates are used from library(prolog_autoload).
  142
  143:- public
  144    found_undef/3,
  145    collect_undef/1.  146
  147collect_undef(Grouped) :-
  148    findall(PI-From, retract(undef(PI, From)), Pairs),
  149    keysort(Pairs, Sorted),
  150    group_pairs_by_key(Sorted, Grouped).
  151
  152found_undef(To, _Caller, From) :-
  153    goal_pi(To, PI),
  154    (   undef(PI, From)
  155    ->  true
  156    ;   compiled(PI)
  157    ->  true
  158    ;   not_always_present(PI)
  159    ->  true
  160    ;   assertz(undef(PI,From))
  161    ).
  162
  163compiled(system:'$call_cleanup'/0).     % compiled to VM instructions
  164compiled(system:'$catch'/0).
  165compiled(system:'$cut'/0).
  166compiled(system:'$reset'/0).
  167compiled(system:'$call_continuation'/1).
  168compiled(system:'$shift'/1).
  169compiled('$engines':'$yield'/0).
  170
  171%!  not_always_present(+PI) is semidet.
  172%
  173%   True when some predicate is known to be part of the state but is not
  174%   available in this version.
  175
  176not_always_present(_:win_folder/2) :-
  177    \+ current_prolog_flag(windows, true).
  178not_always_present(_:win_add_dll_directory/2) :-
  179    \+ current_prolog_flag(windows, true).
  180
  181
  182goal_pi(M:Head, M:Name/Arity) :-
  183    functor(Head, Name, Arity).
  184
  185%!  list_autoload is det.
  186%
  187%   Report predicates that may be  auto-loaded. These are predicates
  188%   that  are  not  defined,  but  will   be  loaded  on  demand  if
  189%   referenced.
  190%
  191%   @tbd    This predicate uses an older mechanism for finding
  192%           undefined predicates.  Should be synchronized with
  193%           list undefined.
  194%   @see    autoload/0
  195
  196list_autoload :-
  197    setup_call_cleanup(
  198        ( current_prolog_flag(access_level, OldLevel),
  199          current_prolog_flag(autoload, OldAutoLoad),
  200          set_prolog_flag(access_level, system),
  201          set_prolog_flag(autoload, false)
  202        ),
  203        list_autoload_(OldLevel),
  204        ( set_prolog_flag(access_level, OldLevel),
  205          set_prolog_flag(autoload, OldAutoLoad)
  206        )).
  207
  208list_autoload_(SystemMode) :-
  209    (   setof(Lib-Pred,
  210              autoload_predicate(Module, Lib, Pred, SystemMode),
  211              Pairs),
  212        print_message(informational,
  213                      check(autoload(Module, Pairs))),
  214        fail
  215    ;   true
  216    ).
  217
  218autoload_predicate(Module, Library, Name/Arity, SystemMode) :-
  219    predicate_property(Module:Head, undefined),
  220    check_module_enabled(Module, SystemMode),
  221    (   \+ predicate_property(Module:Head, imported_from(_)),
  222        functor(Head, Name, Arity),
  223        '$find_library'(Module, Name, Arity, _LoadModule, Library),
  224        referenced(Module:Head, Module, _)
  225    ->  true
  226    ).
  227
  228check_module_enabled(_, system) :- !.
  229check_module_enabled(Module, _) :-
  230    \+ import_module(Module, system).
  231
  232%!  referenced(+Predicate, ?Module, -ClauseRef) is nondet.
  233%
  234%   True if clause ClauseRef references Predicate.
  235
  236referenced(Term, Module, Ref) :-
  237    Goal = Module:_Head,
  238    current_predicate(_, Goal),
  239    '$get_predicate_attribute'(Goal, system, 0),
  240    \+ '$get_predicate_attribute'(Goal, imported, _),
  241    nth_clause(Goal, _, Ref),
  242    '$xr_member'(Ref, Term).
  243
  244%!  list_redefined
  245%
  246%   Lists predicates that are defined in the global module =user= as
  247%   well as in a normal module; that   is,  predicates for which the
  248%   local definition overrules the global default definition.
  249
  250list_redefined :-
  251    setup_call_cleanup(
  252        ( current_prolog_flag(access_level, OldLevel),
  253          set_prolog_flag(access_level, system)
  254        ),
  255        list_redefined_,
  256        set_prolog_flag(access_level, OldLevel)).
  257
  258list_redefined_ :-
  259    current_module(Module),
  260    Module \== system,
  261    current_predicate(_, Module:Head),
  262    \+ predicate_property(Module:Head, imported_from(_)),
  263    (   global_module(Super),
  264        Super \== Module,
  265        '$c_current_predicate'(_, Super:Head),
  266        \+ redefined_ok(Head),
  267        '$syspreds':'$defined_predicate'(Super:Head),
  268        \+ predicate_property(Super:Head, (dynamic)),
  269        \+ predicate_property(Super:Head, imported_from(Module)),
  270        functor(Head, Name, Arity)
  271    ->  print_message(informational,
  272                      check(redefined(Module, Super, Name/Arity)))
  273    ),
  274    fail.
  275list_redefined_.
  276
  277redefined_ok('$mode'(_,_)).
  278redefined_ok('$pldoc'(_,_,_,_)).
  279redefined_ok('$pred_option'(_,_,_,_)).
  280
  281global_module(user).
  282global_module(system).
  283
  284%!  list_void_declarations is det.
  285%
  286%   List predicates that have declared attributes, but no clauses.
  287
  288list_void_declarations :-
  289    P = _:_,
  290    (   predicate_property(P, undefined),
  291        (   '$get_predicate_attribute'(P, meta_predicate, Pattern),
  292            print_message(warning,
  293                          check(void_declaration(P, meta_predicate(Pattern))))
  294        ;   void_attribute(Attr),
  295            '$get_predicate_attribute'(P, Attr, 1),
  296            print_message(warning,
  297                          check(void_declaration(P, Attr)))
  298        ),
  299        fail
  300    ;   true
  301    ).
  302
  303void_attribute(public).
  304void_attribute(volatile).
  305
  306%!  list_trivial_fails is det.
  307%!  list_trivial_fails(+Options) is det.
  308%
  309%   List goals that trivially fail  because   there  is  no matching
  310%   clause.  Options:
  311%
  312%     * module_class(+Classes)
  313%       Process modules of the given Classes.  The default for
  314%       classes is =|[user]|=. For example, to include the
  315%       libraries into the examination, use =|[user,library]|=.
  316
  317:- thread_local
  318    trivial_fail/2.  319
  320list_trivial_fails :-
  321    list_trivial_fails([]).
  322
  323list_trivial_fails(Options) :-
  324    merge_options(Options,
  325                  [ module_class([user]),
  326                    infer_meta_predicates(false),
  327                    autoload(false),
  328                    evaluate(false),
  329                    trace_reference(_),
  330                    on_trace(check_trivial_fail)
  331                  ],
  332                  WalkOptions),
  333
  334    prolog_walk_code([ source(false)
  335                     | WalkOptions
  336                     ]),
  337    findall(CRef, retract(trivial_fail(clause(CRef), _)), Clauses),
  338    (   Clauses == []
  339    ->  true
  340    ;   print_message(warning, check(trivial_failures)),
  341        prolog_walk_code([ clauses(Clauses)
  342                         | WalkOptions
  343                         ]),
  344        findall(Goal-From, retract(trivial_fail(From, Goal)), Pairs),
  345        keysort(Pairs, Sorted),
  346        group_pairs_by_key(Sorted, Grouped),
  347        maplist(report_trivial_fail, Grouped)
  348    ).
  349
  350%!  trivial_fail_goal(:Goal)
  351%
  352%   Multifile hook that tells list_trivial_fails/0 to accept Goal as
  353%   valid.
  354
  355trivial_fail_goal(pce_expansion:pce_class(_, _, template, _, _, _)).
  356trivial_fail_goal(pce_host:property(system_source_prefix(_))).
  357
  358:- public
  359    check_trivial_fail/3.  360
  361check_trivial_fail(MGoal0, _Caller, From) :-
  362    (   MGoal0 = M:Goal,
  363        atom(M),
  364        callable(Goal),
  365        predicate_property(MGoal0, interpreted),
  366        \+ predicate_property(MGoal0, dynamic),
  367        \+ predicate_property(MGoal0, multifile),
  368        \+ trivial_fail_goal(MGoal0)
  369    ->  (   predicate_property(MGoal0, meta_predicate(Meta))
  370        ->  qualify_meta_goal(MGoal0, Meta, MGoal)
  371        ;   MGoal = MGoal0
  372        ),
  373        (   clause(MGoal, _)
  374        ->  true
  375        ;   assertz(trivial_fail(From, MGoal))
  376        )
  377    ;   true
  378    ).
  379
  380report_trivial_fail(Goal-FromList) :-
  381    print_message(warning, check(trivial_failure(Goal, FromList))).
  382
  383%!  qualify_meta_goal(+Module, +MetaSpec, +Goal, -QualifiedGoal)
  384%
  385%   Qualify a goal if the goal calls a meta predicate
  386
  387qualify_meta_goal(M:Goal0, Meta, M:Goal) :-
  388    functor(Goal0, F, N),
  389    functor(Goal, F, N),
  390    qualify_meta_goal(1, M, Meta, Goal0, Goal).
  391
  392qualify_meta_goal(N, M, Meta, Goal0, Goal) :-
  393    arg(N, Meta,  ArgM),
  394    !,
  395    arg(N, Goal0, Arg0),
  396    arg(N, Goal,  Arg),
  397    N1 is N + 1,
  398    (   module_qualified(ArgM)
  399    ->  add_module(Arg0, M, Arg)
  400    ;   Arg = Arg0
  401    ),
  402    meta_goal(N1, Meta, Goal0, Goal).
  403meta_goal(_, _, _, _).
  404
  405add_module(Arg, M, M:Arg) :-
  406    var(Arg),
  407    !.
  408add_module(M:Arg, _, MArg) :-
  409    !,
  410    add_module(Arg, M, MArg).
  411add_module(Arg, M, M:Arg).
  412
  413module_qualified(N) :- integer(N), !.
  414module_qualified(:).
  415module_qualified(^).
  416
  417
  418%!  list_strings is det.
  419%!  list_strings(+Options) is det.
  420%
  421%   List strings that appear in clauses.   This predicate is used to
  422%   find  portability  issues  for   changing    the   Prolog   flag
  423%   =double_quotes= from =codes= to =string=, creating packed string
  424%   objects.  Warnings  may  be  suppressed    using  the  following
  425%   multifile hooks:
  426%
  427%     - string_predicate/1 to stop checking certain predicates
  428%     - valid_string_goal/1 to tell the checker that a goal is
  429%       safe.
  430%
  431%   @see Prolog flag =double_quotes=.
  432
  433list_strings :-
  434    list_strings([module_class([user])]).
  435
  436list_strings(Options) :-
  437    (   prolog_program_clause(ClauseRef, Options),
  438        clause(Head, Body, ClauseRef),
  439        \+ ( predicate_indicator(Head, PI),
  440             string_predicate(PI)
  441           ),
  442        make_clause(Head, Body, Clause),
  443        findall(T,
  444                (   sub_term(T, Head),
  445                    string(T)
  446                ;   Head = M:_,
  447                    goal_in_body(Goal, M, Body),
  448                    (   valid_string_goal(Goal)
  449                    ->  fail
  450                    ;   sub_term(T, Goal),
  451                        string(T)
  452                    )
  453                ), Ts0),
  454        sort(Ts0, Ts),
  455        member(T, Ts),
  456        message_context(ClauseRef, T, Clause, Context),
  457        print_message(warning,
  458                      check(string_in_clause(T, Context))),
  459        fail
  460    ;   true
  461    ).
  462
  463make_clause(Head, true, Head) :- !.
  464make_clause(Head, Body, (Head:-Body)).
  465
  466%!  goal_in_body(-G, +M, +Body) is nondet.
  467%
  468%   True when G is a goal called from Body.
  469
  470goal_in_body(M:G, M, G) :-
  471    var(G),
  472    !.
  473goal_in_body(G, _, M:G0) :-
  474    atom(M),
  475    !,
  476    goal_in_body(G, M, G0).
  477goal_in_body(G, M, Control) :-
  478    nonvar(Control),
  479    control(Control, Subs),
  480    !,
  481    member(Sub, Subs),
  482    goal_in_body(G, M, Sub).
  483goal_in_body(G, M, G0) :-
  484    callable(G0),
  485    (   atom(M)
  486    ->  TM = M
  487    ;   TM = system
  488    ),
  489    predicate_property(TM:G0, meta_predicate(Spec)),
  490    !,
  491    (   strip_goals(G0, Spec, G1),
  492        simple_goal_in_body(G, M, G1)
  493    ;   arg(I, Spec, Meta),
  494        arg(I, G0, G1),
  495        extend(Meta, G1, G2),
  496        goal_in_body(G, M, G2)
  497    ).
  498goal_in_body(G, M, G0) :-
  499    simple_goal_in_body(G, M, G0).
  500
  501simple_goal_in_body(G, M, G0) :-
  502    (   atom(M),
  503        callable(G0),
  504        predicate_property(M:G0, imported_from(M2))
  505    ->  G = M2:G0
  506    ;   G = M:G0
  507    ).
  508
  509control((A,B), [A,B]).
  510control((A;B), [A,B]).
  511control((A->B), [A,B]).
  512control((A*->B), [A,B]).
  513control((\+A), [A]).
  514
  515strip_goals(G0, Spec, G) :-
  516    functor(G0, Name, Arity),
  517    functor(G,  Name, Arity),
  518    strip_goal_args(1, G0, Spec, G).
  519
  520strip_goal_args(I, G0, Spec, G) :-
  521    arg(I, G0, A0),
  522    !,
  523    arg(I, Spec, M),
  524    (   extend(M, A0, _)
  525    ->  arg(I, G, '<meta-goal>')
  526    ;   arg(I, G, A0)
  527    ),
  528    I2 is I + 1,
  529    strip_goal_args(I2, G0, Spec, G).
  530strip_goal_args(_, _, _, _).
  531
  532extend(I, G0, G) :-
  533    callable(G0),
  534    integer(I), I>0,
  535    !,
  536    length(L, I),
  537    extend_list(G0, L, G).
  538extend(0, G, G).
  539extend(^, G, G).
  540
  541extend_list(M:G0, L, M:G) :-
  542    !,
  543    callable(G0),
  544    extend_list(G0, L, G).
  545extend_list(G0, L, G) :-
  546    G0 =.. List,
  547    append(List, L, All),
  548    G =.. All.
  549
  550
  551message_context(ClauseRef, String, Clause, file_term_position(File, StringPos)) :-
  552    clause_info(ClauseRef, File, TermPos, _Vars),
  553    prolog_codewalk:subterm_pos(String, Clause, ==, TermPos, StringPos),
  554    !.
  555message_context(ClauseRef, _String, _Clause, file(File, Line, -1, _)) :-
  556    clause_property(ClauseRef, file(File)),
  557    clause_property(ClauseRef, line_count(Line)),
  558    !.
  559message_context(ClauseRef, _String, _Clause, clause(ClauseRef)).
  560
  561
  562:- meta_predicate
  563    predicate_indicator(:, -).  564
  565predicate_indicator(Module:Head, Module:Name/Arity) :-
  566    functor(Head, Name, Arity).
  567predicate_indicator(Module:Head, Module:Name//DCGArity) :-
  568    functor(Head, Name, Arity),
  569    DCGArity is Arity-2.
  570
  571%!  string_predicate(:PredicateIndicator)
  572%
  573%   Multifile hook to disable list_strings/0 on the given predicate.
  574%   This is typically used for facts that store strings.
  575
  576string_predicate(_:'$pldoc'/4).
  577string_predicate(pce_principal:send_implementation/3).
  578string_predicate(pce_principal:pce_lazy_get_method/3).
  579string_predicate(pce_principal:pce_lazy_send_method/3).
  580string_predicate(pce_principal:pce_class/6).
  581string_predicate(prolog_xref:pred_comment/4).
  582string_predicate(prolog_xref:module_comment/3).
  583string_predicate(pldoc_process:structured_comment//2).
  584string_predicate(pldoc_process:structured_command_start/3).
  585string_predicate(pldoc_process:separator_line//0).
  586string_predicate(pldoc_register:mydoc/3).
  587string_predicate(http_header:separators/1).
  588
  589%!  valid_string_goal(+Goal) is semidet.
  590%
  591%   Multifile hook that qualifies Goal  as valid for list_strings/0.
  592%   For example, format("Hello world~n") is considered proper use of
  593%   string constants.
  594
  595% system predicates
  596valid_string_goal(system:format(S)) :- string(S).
  597valid_string_goal(system:format(S,_)) :- string(S).
  598valid_string_goal(system:format(_,S,_)) :- string(S).
  599valid_string_goal(system:string_codes(S,_)) :- string(S).
  600valid_string_goal(system:string_code(_,S,_)) :- string(S).
  601valid_string_goal(system:throw(msg(S,_))) :- string(S).
  602valid_string_goal('$dcg':phrase(S,_,_)) :- string(S).
  603valid_string_goal('$dcg':phrase(S,_)) :- string(S).
  604valid_string_goal(system: is(_,_)).     % arithmetic allows for "x"
  605valid_string_goal(system: =:=(_,_)).
  606valid_string_goal(system: >(_,_)).
  607valid_string_goal(system: <(_,_)).
  608valid_string_goal(system: >=(_,_)).
  609valid_string_goal(system: =<(_,_)).
  610% library stuff
  611valid_string_goal(dcg_basics:string_without(S,_,_,_)) :- string(S).
  612valid_string_goal(git:read_url(S,_,_)) :- string(S).
  613valid_string_goal(tipc:tipc_subscribe(_,_,_,_,S)) :- string(S).
  614valid_string_goal(charsio:format_to_chars(Format,_,_)) :- string(Format).
  615valid_string_goal(charsio:format_to_chars(Format,_,_,_)) :- string(Format).
  616valid_string_goal(codesio:format_to_codes(Format,_,_)) :- string(Format).
  617valid_string_goal(codesio:format_to_codes(Format,_,_,_)) :- string(Format).
  618
  619
  620                 /*******************************
  621                 *        EXTENSION HOOKS       *
  622                 *******************************/
  623
  624%!  checker(:Goal, +Message:text)
  625%
  626%   Register code validation routines. Each   clause  defines a Goal
  627%   which performs a consistency check  executed by check/0. Message
  628%   is a short description of the   check. For example, assuming the
  629%   `my_checks` module defines a predicate list_format_mistakes/0:
  630%
  631%      ==
  632%      :- multifile check:checker/2.
  633%      check:checker(my_checks:list_format_mistakes,
  634%                    "errors with format/2 arguments").
  635%      ==
  636%
  637%   The predicate is dynamic, so you can disable checks with retract/1.
  638%   For example, to stop reporting redefined predicates:
  639%
  640%      ==
  641%      retract(check:checker(list_redefined,_)).
  642%      ==
  643
  644checker(list_undefined,         'undefined predicates').
  645checker(list_trivial_fails,     'trivial failures').
  646checker(list_redefined,         'redefined system and global predicates').
  647checker(list_void_declarations, 'predicates with declarations but without clauses').
  648checker(list_autoload,          'predicates that need autoloading').
  649
  650
  651                 /*******************************
  652                 *            MESSAGES          *
  653                 *******************************/
  654
  655:- multifile
  656    prolog:message/3.  657
  658prolog:message(check(pass(Comment))) -->
  659    [ 'Checking ~w ...'-[Comment] ].
  660prolog:message(check(find_references(Preds))) -->
  661    { length(Preds, N)
  662    },
  663    [ 'Scanning for references to ~D possibly undefined predicates'-[N] ].
  664prolog:message(check(undefined_procedures, Grouped)) -->
  665    [ 'The predicates below are not defined. If these are defined', nl,
  666      'at runtime using assert/1, use :- dynamic Name/Arity.', nl, nl
  667    ],
  668    undefined_procedures(Grouped).
  669prolog:message(check(undefined_unreferenced_predicates)) -->
  670    [ 'The predicates below are not defined, and are not', nl,
  671      'referenced.', nl, nl
  672    ].
  673prolog:message(check(undefined_unreferenced(Pred))) -->
  674    predicate(Pred).
  675prolog:message(check(autoload(Module, Pairs))) -->
  676    { module_property(Module, file(Path))
  677    },
  678    !,
  679    [ 'Into module ~w ('-[Module] ],
  680    short_filename(Path),
  681    [ ')', nl ],
  682    autoload(Pairs).
  683prolog:message(check(autoload(Module, Pairs))) -->
  684    [ 'Into module ~w'-[Module], nl ],
  685    autoload(Pairs).
  686prolog:message(check(redefined(In, From, Pred))) -->
  687    predicate(In:Pred),
  688    redefined(In, From).
  689prolog:message(check(trivial_failures)) -->
  690    [ 'The following goals fail because there are no matching clauses.' ].
  691prolog:message(check(trivial_failure(Goal, Refs))) -->
  692    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
  693      keysort(Keyed, KeySorted),
  694      pairs_values(KeySorted, SortedRefs)
  695    },
  696    goal(Goal),
  697    [ ', which is called from'-[], nl ],
  698    referenced_by(SortedRefs).
  699prolog:message(check(string_in_clause(String, Context))) -->
  700    prolog:message_location(Context),
  701    [ 'String ~q'-[String] ].
  702prolog:message(check(void_declaration(P, Decl))) -->
  703    predicate(P),
  704    [ ' is declared as ~p, but has no clauses'-[Decl] ].
  705
  706undefined_procedures([]) -->
  707    [].
  708undefined_procedures([H|T]) -->
  709    undefined_procedure(H),
  710    undefined_procedures(T).
  711
  712undefined_procedure(Pred-Refs) -->
  713    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
  714      keysort(Keyed, KeySorted),
  715      pairs_values(KeySorted, SortedRefs)
  716    },
  717    predicate(Pred),
  718    [ ', which is referenced by', nl ],
  719    referenced_by(SortedRefs).
  720
  721redefined(user, system) -->
  722    [ '~t~30| System predicate redefined globally' ].
  723redefined(_, system) -->
  724    [ '~t~30| Redefined system predicate' ].
  725redefined(_, user) -->
  726    [ '~t~30| Redefined global predicate' ].
  727
  728goal(user:Goal) -->
  729    !,
  730    [ '~p'-[Goal] ].
  731goal(Goal) -->
  732    !,
  733    [ '~p'-[Goal] ].
  734
  735predicate(Module:Name/Arity) -->
  736    { atom(Module),
  737      atom(Name),
  738      integer(Arity),
  739      functor(Head, Name, Arity),
  740      predicate_name(Module:Head, PName)
  741    },
  742    !,
  743    [ '~w'-[PName] ].
  744predicate(Module:Head) -->
  745    { atom(Module),
  746      callable(Head),
  747      predicate_name(Module:Head, PName)
  748    },
  749    !,
  750    [ '~w'-[PName] ].
  751predicate(Name/Arity) -->
  752    { atom(Name),
  753      integer(Arity)
  754    },
  755    !,
  756    predicate(user:Name/Arity).
  757
  758autoload([]) -->
  759    [].
  760autoload([Lib-Pred|T]) -->
  761    [ '    ' ],
  762    predicate(Pred),
  763    [ '~t~24| from ' ],
  764    short_filename(Lib),
  765    [ nl ],
  766    autoload(T).
  767
  768%!  sort_reference_key(+Reference, -Key) is det.
  769%
  770%   Create a stable key for sorting references to predicates.
  771
  772sort_reference_key(Term, key(M:Name/Arity, N, ClausePos)) :-
  773    clause_ref(Term, ClauseRef, ClausePos),
  774    !,
  775    nth_clause(Pred, N, ClauseRef),
  776    strip_module(Pred, M, Head),
  777    functor(Head, Name, Arity).
  778sort_reference_key(Term, Term).
  779
  780clause_ref(clause_term_position(ClauseRef, TermPos), ClauseRef, ClausePos) :-
  781    arg(1, TermPos, ClausePos).
  782clause_ref(clause(ClauseRef), ClauseRef, 0).
  783
  784
  785referenced_by([]) -->
  786    [].
  787referenced_by([Ref|T]) -->
  788    ['\t'], prolog:message_location(Ref),
  789            predicate_indicator(Ref),
  790    [ nl ],
  791    referenced_by(T).
  792
  793predicate_indicator(clause_term_position(ClauseRef, _)) -->
  794    { nonvar(ClauseRef) },
  795    !,
  796    predicate_indicator(clause(ClauseRef)).
  797predicate_indicator(clause(ClauseRef)) -->
  798    { clause_name(ClauseRef, Name) },
  799    [ '~w'-[Name] ].
  800predicate_indicator(file_term_position(_,_)) -->
  801    [ '(initialization)' ].
  802predicate_indicator(file(_,_,_,_)) -->
  803    [ '(initialization)' ].
  804
  805
  806short_filename(Path) -->
  807    { short_filename(Path, Spec)
  808    },
  809    [ '~q'-[Spec] ].
  810
  811short_filename(Path, Spec) :-
  812    absolute_file_name('', Here),
  813    atom_concat(Here, Local0, Path),
  814    !,
  815    remove_leading_slash(Local0, Spec).
  816short_filename(Path, Spec) :-
  817    findall(LenAlias, aliased_path(Path, LenAlias), Keyed),
  818    keysort(Keyed, [_-Spec|_]).
  819short_filename(Path, Path).
  820
  821aliased_path(Path, Len-Spec) :-
  822    setof(Alias, Spec^(user:file_search_path(Alias, Spec)), Aliases),
  823    member(Alias, Aliases),
  824    Term =.. [Alias, '.'],
  825    absolute_file_name(Term,
  826                       [ file_type(directory),
  827                         file_errors(fail),
  828                         solutions(all)
  829                       ], Prefix),
  830    atom_concat(Prefix, Local0, Path),
  831    remove_leading_slash(Local0, Local),
  832    atom_length(Local, Len),
  833    Spec =.. [Alias, Local].
  834
  835remove_leading_slash(Path, Local) :-
  836    atom_concat(/, Local, Path),
  837    !.
  838remove_leading_slash(Path, Path)