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-2023, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(check,
   39        [ check/0,                      % run all checks
   40          list_undefined/0,             % list undefined predicates
   41          list_undefined/1,             % +Options
   42          list_autoload/0,              % list predicates that need autoloading
   43          list_redefined/0,             % list redefinitions
   44          list_cross_module_calls/0,	% List Module:Goal usage
   45          list_cross_module_calls/1,    % +Options
   46          list_void_declarations/0,     % list declarations with no clauses
   47          list_trivial_fails/0,         % list goals that trivially fail
   48          list_trivial_fails/1,         % +Options
   49          list_format_errors/0,         % list calls to format with wrong args
   50          list_format_errors/1,		% +Options
   51          list_strings/0,               % list string objects in clauses
   52          list_strings/1,               % +Options
   53          list_rationals/0,		% list rational objects in clauses
   54          list_rationals/1              % +Options
   55        ]).   56:- autoload(library(apply),[maplist/2]).   57:- autoload(library(lists),[member/2,append/3]).   58:- autoload(library(occurs),[sub_term/2]).   59:- autoload(library(option),[merge_options/3,option/3]).   60:- autoload(library(pairs),
   61	    [group_pairs_by_key/2,map_list_to_pairs/3,pairs_values/2]).   62:- autoload(library(prolog_clause),
   63	    [clause_info/4,predicate_name/2,clause_name/2]).   64:- autoload(library(prolog_code),[pi_head/2]).   65:- autoload(library(prolog_codewalk),
   66	    [prolog_walk_code/1,prolog_program_clause/2]).   67:- autoload(library(prolog_format),[format_types/2]).   68:- autoload(library(predicate_options), [check_predicate_options/0]).   69
   70:- set_prolog_flag(generate_debug_info, false).   71
   72:- multifile
   73       trivial_fail_goal/1,
   74       string_predicate/1,
   75       valid_string_goal/1,
   76       checker/2.   77
   78:- dynamic checker/2.   79
   80
   81/** <module> Consistency checking
   82
   83This library provides some consistency  checks   for  the  loaded Prolog
   84program. The predicate make/0 runs   list_undefined/0  to find undefined
   85predicates in `user' modules.
   86
   87@see    gxref/0 provides a graphical cross referencer
   88@see    PceEmacs performs real time consistency checks while you edit
   89@see    library(prolog_xref) implements `offline' cross-referencing
   90@see    library(prolog_codewalk) implements `online' analysis
   91*/
   92
   93:- predicate_options(list_undefined/1, 1,
   94                     [ module_class(list(oneof([user,library,system])))
   95                     ]).   96
   97%!  check is det.
   98%
   99%   Run all consistency checks defined by checker/2. Checks enabled by
  100%   default are:
  101%
  102%     * list_undefined/0 reports undefined predicates
  103%     * list_trivial_fails/0 reports calls for which there is no
  104%       matching clause.
  105%     * list_format_errors/0 reports mismatches in format/2,3
  106%       templates and the list of arguments.
  107%     * list_redefined/0 reports predicates that have a local
  108%       definition and a global definition.  Note that these are
  109%       __not__ errors.
  110%     * list_void_declarations/0 reports on predicates with defined
  111%       properties, but no clauses.
  112%     * list_autoload/0 lists predicates that will be defined at
  113%       runtime using the autoloader.
  114%     * check_predicate_options/0 tests for options passed to
  115%       predicates such as open/4 that are unknown or are used
  116%       with an invalid argument.
  117%
  118%    The checker can be expanded or  restricted by modifying the dynamic
  119%    multifile hook checker/2.
  120%
  121%    The checker may be used in batch, e.g., for CI workflows by calling
  122%    SWI-Prolog as below. Note that by using ``-l`` to load the program,
  123%    the program is not started  if   it  used  initialization/2 of type
  124%    `main` to start the program.
  125%
  126%
  127%    ```
  128%    swipl -q --on-warning=status --on-error=status \
  129%          -g check -t halt -l myprogram.pl
  130%    ```
  131
  132check :-
  133    checker(Checker, Message),
  134    print_message(informational,check(pass(Message))),
  135    catch(Checker,E,print_message(error,E)),
  136    fail.
  137check.
  138
  139%!  list_undefined is det.
  140%!  list_undefined(+Options) is det.
  141%
  142%   Report undefined predicates.  This   predicate  finds  undefined
  143%   predicates by decompiling and analyzing the body of all clauses.
  144%   Options:
  145%
  146%       * module_class(+Classes)
  147%       Process modules of the given Classes.  The default for
  148%       classes is =|[user]|=. For example, to include the
  149%       libraries into the examination, use =|[user,library]|=.
  150%
  151%   @see gxref/0 provides a graphical cross-referencer.
  152%   @see make/0 calls list_undefined/0
  153
  154:- thread_local
  155    undef/2.  156
  157list_undefined :-
  158    list_undefined([]).
  159
  160list_undefined(Options) :-
  161    merge_options(Options,
  162                  [ module_class([user])
  163                  ],
  164                  WalkOptions),
  165    call_cleanup(
  166        prolog_walk_code([ undefined(trace),
  167                           on_trace(found_undef)
  168                         | WalkOptions
  169                         ]),
  170        collect_undef(Grouped)),
  171    (   Grouped == []
  172    ->  true
  173    ;   print_message(warning, check(undefined_procedures, Grouped))
  174    ).
  175
  176% The following predicates are used from library(prolog_autoload).
  177
  178:- public
  179    found_undef/3,
  180    collect_undef/1.  181
  182collect_undef(Grouped) :-
  183    findall(PI-From, retract(undef(PI, From)), Pairs),
  184    keysort(Pairs, Sorted),
  185    group_pairs_by_key(Sorted, Grouped).
  186
  187found_undef(To, _Caller, From) :-
  188    goal_pi(To, PI),
  189    (   undef(PI, From)
  190    ->  true
  191    ;   compiled(PI)
  192    ->  true
  193    ;   not_always_present(PI)
  194    ->  true
  195    ;   assertz(undef(PI,From))
  196    ).
  197
  198compiled(system:'$call_cleanup'/0).     % compiled to VM instructions
  199compiled(system:'$catch'/0).
  200compiled(system:'$cut'/0).
  201compiled(system:'$reset'/0).
  202compiled(system:'$call_continuation'/1).
  203compiled(system:'$shift'/1).
  204compiled(system:'$shift_for_copy'/1).
  205compiled('$engines':'$yield'/0).
  206
  207%!  not_always_present(+PI) is semidet.
  208%
  209%   True when some predicate is known to be part of the state but is not
  210%   available in this version.
  211
  212not_always_present(_:win_folder/2) :-
  213    \+ current_prolog_flag(windows, true).
  214not_always_present(_:win_add_dll_directory/2) :-
  215    \+ current_prolog_flag(windows, true).
  216not_always_present(_:opt_help/2).
  217not_always_present(_:opt_type/3).
  218not_always_present(_:opt_meta/2).
  219
  220goal_pi(M:Head, M:Name/Arity) :-
  221    functor(Head, Name, Arity).
  222
  223%!  list_autoload is det.
  224%
  225%   Report predicates that may be  auto-loaded. These are predicates
  226%   that  are  not  defined,  but  will   be  loaded  on  demand  if
  227%   referenced.
  228%
  229%   @tbd    This predicate uses an older mechanism for finding
  230%           undefined predicates.  Should be synchronized with
  231%           list undefined.
  232%   @see    autoload/0
  233
  234list_autoload :-
  235    setup_call_cleanup(
  236        ( current_prolog_flag(access_level, OldLevel),
  237          current_prolog_flag(autoload, OldAutoLoad),
  238          set_prolog_flag(access_level, system),
  239          set_prolog_flag(autoload, false)
  240        ),
  241        list_autoload_(OldLevel),
  242        ( set_prolog_flag(access_level, OldLevel),
  243          set_prolog_flag(autoload, OldAutoLoad)
  244        )).
  245
  246list_autoload_(SystemMode) :-
  247    (   setof(Lib-Pred,
  248              autoload_predicate(Module, Lib, Pred, SystemMode),
  249              Pairs),
  250        print_message(informational,
  251                      check(autoload(Module, Pairs))),
  252        fail
  253    ;   true
  254    ).
  255
  256autoload_predicate(Module, Library, Name/Arity, SystemMode) :-
  257    predicate_property(Module:Head, undefined),
  258    check_module_enabled(Module, SystemMode),
  259    (   \+ predicate_property(Module:Head, imported_from(_)),
  260        functor(Head, Name, Arity),
  261        '$find_library'(Module, Name, Arity, _LoadModule, Library),
  262        referenced(Module:Head, Module, _)
  263    ->  true
  264    ).
  265
  266check_module_enabled(_, system) :- !.
  267check_module_enabled(Module, _) :-
  268    \+ import_module(Module, system).
  269
  270%!  referenced(+Predicate, ?Module, -ClauseRef) is nondet.
  271%
  272%   True if clause ClauseRef references Predicate.
  273
  274referenced(Term, Module, Ref) :-
  275    Goal = Module:_Head,
  276    current_predicate(_, Goal),
  277    '$get_predicate_attribute'(Goal, system, 0),
  278    \+ '$get_predicate_attribute'(Goal, imported, _),
  279    nth_clause(Goal, _, Ref),
  280    '$xr_member'(Ref, Term).
  281
  282%!  list_redefined
  283%
  284%   Lists predicates that are defined in the global module =user= as
  285%   well as in a normal module; that   is,  predicates for which the
  286%   local definition overrules the global default definition.
  287
  288list_redefined :-
  289    setup_call_cleanup(
  290        ( current_prolog_flag(access_level, OldLevel),
  291          set_prolog_flag(access_level, system)
  292        ),
  293        list_redefined_,
  294        set_prolog_flag(access_level, OldLevel)).
  295
  296list_redefined_ :-
  297    current_module(Module),
  298    Module \== system,
  299    current_predicate(_, Module:Head),
  300    \+ predicate_property(Module:Head, imported_from(_)),
  301    (   global_module(Super),
  302        Super \== Module,
  303        '$c_current_predicate'(_, Super:Head),
  304        \+ redefined_ok(Head),
  305        '$syspreds':'$defined_predicate'(Super:Head),
  306        \+ predicate_property(Super:Head, (dynamic)),
  307        \+ predicate_property(Super:Head, imported_from(Module)),
  308        functor(Head, Name, Arity)
  309    ->  print_message(informational,
  310                      check(redefined(Module, Super, Name/Arity)))
  311    ),
  312    fail.
  313list_redefined_.
  314
  315redefined_ok('$mode'(_,_)).
  316redefined_ok('$pldoc'(_,_,_,_)).
  317redefined_ok('$pred_option'(_,_,_,_)).
  318redefined_ok('$table_mode'(_,_,_)).
  319redefined_ok('$tabled'(_,_)).
  320redefined_ok('$exported_op'(_,_,_)).
  321redefined_ok('$autoload'(_,_,_)).
  322
  323global_module(user).
  324global_module(system).
  325
  326%!  list_cross_module_calls is det.
  327%
  328%   List calls from one module to   another  using Module:Goal where the
  329%   callee is not defined exported, public or multifile, i.e., where the
  330%   callee should be considered _private_.
  331
  332list_cross_module_calls :-
  333    list_cross_module_calls([]).
  334
  335list_cross_module_calls(Options) :-
  336    call_cleanup(
  337        list_cross_module_calls_guarded(Options),
  338        retractall(cross_module_call(_,_,_))).
  339
  340list_cross_module_calls_guarded(Options) :-
  341    merge_options(Options,
  342                  [ module_class([user])
  343                  ],
  344                  WalkOptions),
  345    prolog_walk_code([ trace_reference(_),
  346                       trace_condition(cross_module_call),
  347                       on_trace(write_call)
  348                     | WalkOptions
  349                     ]).
  350
  351:- thread_local
  352    cross_module_call/3.  353
  354:- public
  355    cross_module_call/2,
  356    write_call/3.  357
  358cross_module_call(Callee, Context) :-
  359    \+ same_module_call(Callee, Context).
  360
  361same_module_call(Callee, Context) :-
  362    caller_module(Context, MCaller),
  363    Callee = (MCallee:_),
  364    (   (   MCaller = MCallee
  365        ;   predicate_property(Callee, exported)
  366        ;   predicate_property(Callee, built_in)
  367        ;   predicate_property(Callee, public)
  368        ;   clause_property(Context.get(clause), module(MCallee))
  369        ;   predicate_property(Callee, multifile)
  370        )
  371    ->  true
  372    ).
  373
  374caller_module(Context, MCaller) :-
  375    Caller = Context.caller,
  376    (   Caller = (MCaller:_)
  377    ->  true
  378    ;   Caller == '<initialization>',
  379        MCaller = Context.module
  380    ).
  381
  382write_call(Callee, Caller, Position) :-
  383    cross_module_call(Callee, Caller, Position),
  384    !.
  385write_call(Callee, Caller, Position) :-
  386    (   cross_module_call(_,_,_)
  387    ->  true
  388    ;   print_message(warning, check(cross_module_calls))
  389    ),
  390    asserta(cross_module_call(Callee, Caller, Position)),
  391    print_message(warning,
  392                  check(cross_module_call(Callee, Caller, Position))).
  393
  394%!  list_void_declarations is det.
  395%
  396%   List predicates that have declared attributes, but no clauses.
  397
  398list_void_declarations :-
  399    P = _:_,
  400    (   predicate_property(P, undefined),
  401        (   '$get_predicate_attribute'(P, meta_predicate, Pattern),
  402            (   '$get_predicate_attribute'(P, transparent, 1)
  403            ->   print_message(warning,
  404                               check(void_declaration(P, meta_predicate(Pattern))))
  405            ;    print_message(warning,
  406                               check(void_declaration(P, mode(Pattern))))
  407            )
  408        ;   void_attribute(Attr),
  409            '$get_predicate_attribute'(P, Attr, 1),
  410            print_message(warning,
  411                          check(void_declaration(P, Attr)))
  412        ),
  413        fail
  414    ;   predicate_property(P, discontiguous),
  415        \+ (predicate_property(P, number_of_clauses(N)), N > 0),
  416        print_message(warning,
  417                      check(void_declaration(P, discontiguous))),
  418        fail
  419    ;   true
  420    ).
  421
  422void_attribute(public).
  423void_attribute(volatile).
  424void_attribute(det).
  425
  426%!  list_trivial_fails is det.
  427%!  list_trivial_fails(+Options) is det.
  428%
  429%   List goals that trivially fail  because   there  is  no matching
  430%   clause.  Options:
  431%
  432%     * module_class(+Classes)
  433%       Process modules of the given Classes.  The default for
  434%       classes is =|[user]|=. For example, to include the
  435%       libraries into the examination, use =|[user,library]|=.
  436
  437:- thread_local
  438    trivial_fail/2.  439
  440list_trivial_fails :-
  441    list_trivial_fails([]).
  442
  443list_trivial_fails(Options) :-
  444    merge_options(Options,
  445                  [ module_class([user]),
  446                    infer_meta_predicates(false),
  447                    autoload(false),
  448                    evaluate(false),
  449                    trace_reference(_),
  450                    on_trace(check_trivial_fail)
  451                  ],
  452                  WalkOptions),
  453
  454    prolog_walk_code([ source(false)
  455                     | WalkOptions
  456                     ]),
  457    findall(CRef, retract(trivial_fail(clause(CRef), _)), Clauses),
  458    (   Clauses == []
  459    ->  true
  460    ;   print_message(warning, check(trivial_failures)),
  461        prolog_walk_code([ clauses(Clauses)
  462                         | WalkOptions
  463                         ]),
  464        findall(Goal-From, retract(trivial_fail(From, Goal)), Pairs),
  465        keysort(Pairs, Sorted),
  466        group_pairs_by_key(Sorted, Grouped),
  467        maplist(report_trivial_fail, Grouped)
  468    ).
  469
  470%!  trivial_fail_goal(:Goal)
  471%
  472%   Multifile hook that tells list_trivial_fails/0 to accept Goal as
  473%   valid.
  474
  475trivial_fail_goal(pce_expansion:pce_class(_, _, template, _, _, _)).
  476trivial_fail_goal(pce_host:property(system_source_prefix(_))).
  477
  478:- public
  479    check_trivial_fail/3.  480
  481check_trivial_fail(MGoal0, _Caller, From) :-
  482    (   MGoal0 = M:Goal,
  483        atom(M),
  484        callable(Goal),
  485        predicate_property(MGoal0, interpreted),
  486        \+ predicate_property(MGoal0, dynamic),
  487        \+ predicate_property(MGoal0, multifile),
  488        \+ trivial_fail_goal(MGoal0)
  489    ->  (   predicate_property(MGoal0, meta_predicate(Meta))
  490        ->  qualify_meta_goal(MGoal0, Meta, MGoal)
  491        ;   MGoal = MGoal0
  492        ),
  493        (   clause(MGoal, _)
  494        ->  true
  495        ;   assertz(trivial_fail(From, MGoal))
  496        )
  497    ;   true
  498    ).
  499
  500report_trivial_fail(Goal-FromList) :-
  501    print_message(warning, check(trivial_failure(Goal, FromList))).
  502
  503%!  qualify_meta_goal(+Module, +MetaSpec, +Goal, -QualifiedGoal)
  504%
  505%   Qualify a goal if the goal calls a meta predicate
  506
  507qualify_meta_goal(M:Goal0, Meta, M:Goal) :-
  508    functor(Goal0, F, N),
  509    functor(Goal, F, N),
  510    qualify_meta_goal(1, M, Meta, Goal0, Goal).
  511
  512qualify_meta_goal(N, M, Meta, Goal0, Goal) :-
  513    arg(N, Meta,  ArgM),
  514    !,
  515    arg(N, Goal0, Arg0),
  516    arg(N, Goal,  Arg),
  517    N1 is N + 1,
  518    (   module_qualified(ArgM)
  519    ->  add_module(Arg0, M, Arg)
  520    ;   Arg = Arg0
  521    ),
  522    meta_goal(N1, Meta, Goal0, Goal).
  523meta_goal(_, _, _, _).
  524
  525add_module(Arg, M, M:Arg) :-
  526    var(Arg),
  527    !.
  528add_module(M:Arg, _, MArg) :-
  529    !,
  530    add_module(Arg, M, MArg).
  531add_module(Arg, M, M:Arg).
  532
  533module_qualified(N) :- integer(N), !.
  534module_qualified(:).
  535module_qualified(^).
  536
  537
  538%!  list_strings is det.
  539%!  list_strings(+Options) is det.
  540%
  541%   List strings that appear in clauses.   This predicate is used to
  542%   find  portability  issues  for   changing    the   Prolog   flag
  543%   =double_quotes= from =codes= to =string=, creating packed string
  544%   objects.  Warnings  may  be  suppressed    using  the  following
  545%   multifile hooks:
  546%
  547%     - string_predicate/1 to stop checking certain predicates
  548%     - valid_string_goal/1 to tell the checker that a goal is
  549%       safe.
  550%
  551%   @see Prolog flag =double_quotes=.
  552
  553list_strings :-
  554    list_strings([module_class([user])]).
  555
  556list_strings(Options) :-
  557    (   prolog_program_clause(ClauseRef, Options),
  558        clause(Head, Body, ClauseRef),
  559        \+ ( predicate_indicator(Head, PI),
  560             string_predicate(PI)
  561           ),
  562        make_clause(Head, Body, Clause),
  563        findall(T,
  564                (   sub_term(T, Head),
  565                    string(T)
  566                ;   Head = M:_,
  567                    goal_in_body(Goal, M, Body),
  568                    (   valid_string_goal(Goal)
  569                    ->  fail
  570                    ;   sub_term(T, Goal),
  571                        string(T)
  572                    )
  573                ), Ts0),
  574        sort(Ts0, Ts),
  575        member(T, Ts),
  576        message_context(ClauseRef, T, Clause, Context),
  577        print_message(warning,
  578                      check(string_in_clause(T, Context))),
  579        fail
  580    ;   true
  581    ).
  582
  583make_clause(Head, true, Head) :- !.
  584make_clause(Head, Body, (Head:-Body)).
  585
  586%!  list_rationals is det.
  587%!  list_rationals(+Options) is det.
  588%
  589%   List rational numbers that appear in clauses. This predicate is used
  590%   to  find  portability  issues   for    changing   the   Prolog  flag
  591%   `rational_syntax`  to  `natural`,  creating  rational  numbers  from
  592%   <integer>/<nonneg>. Options:
  593%
  594%      - module_class(+Classes)
  595%        Determines the modules classes processed.  By default only
  596%        user code is processed.  See prolog_program_clause/2.
  597%      - arithmetic(+Bool)
  598%        If `true` (default `false`) also warn on rationals appearing
  599%        in arithmetic expressions.
  600%
  601%   @see Prolog flag `rational_syntax` and `prefer_rationals`.
  602
  603list_rationals :-
  604    list_rationals([module_class([user])]).
  605
  606list_rationals(Options) :-
  607    (   option(arithmetic(DoArith), Options, false),
  608        prolog_program_clause(ClauseRef, Options),
  609        clause(Head, Body, ClauseRef),
  610        make_clause(Head, Body, Clause),
  611        findall(T,
  612                (   sub_term(T, Head),
  613                    rational(T),
  614                    \+ integer(T)
  615                ;   Head = M:_,
  616                    goal_in_body(Goal, M, Body),
  617                    nonvar(Goal),
  618                    (   DoArith == false,
  619                        valid_rational_goal(Goal)
  620                    ->  fail
  621                    ;   sub_term(T, Goal),
  622                        rational(T),
  623                        \+ integer(T)
  624                    )
  625                ), Ts0),
  626        sort(Ts0, Ts),
  627        member(T, Ts),
  628        message_context(ClauseRef, T, Clause, Context),
  629        print_message(warning,
  630                      check(rational_in_clause(T, Context))),
  631        fail
  632    ;   true
  633    ).
  634
  635
  636valid_rational_goal(_ is _).
  637valid_rational_goal(_ =:= _).
  638valid_rational_goal(_ < _).
  639valid_rational_goal(_ > _).
  640valid_rational_goal(_ =< _).
  641valid_rational_goal(_ >= _).
  642
  643
  644%!  list_format_errors is det.
  645%!  list_format_errors(+Options) is det.
  646%
  647%   List argument errors for format/2,3.
  648
  649list_format_errors :-
  650    list_format_errors([module_class([user])]).
  651
  652list_format_errors(Options) :-
  653    (   prolog_program_clause(ClauseRef, Options),
  654        clause(Head, Body, ClauseRef),
  655        make_clause(Head, Body, Clause),
  656        Head = M:_,
  657        goal_in_body(Goal, M, Body),
  658        format_warning(Goal, Msg),
  659        message_context(ClauseRef, Goal, Clause, Context),
  660        print_message(warning, check(Msg, Goal, Context)),
  661        fail
  662    ;   true
  663    ).
  664
  665format_warning(system:format(Format, Args), Msg) :-
  666    nonvar(Format),
  667    nonvar(Args),
  668    \+ is_list(Args),
  669    Msg = format_argv(Args).
  670format_warning(system:format(Format, Args), Msg) :-
  671    ground(Format),
  672    (   is_list(Args)
  673    ->  length(Args, ArgC)
  674    ;   nonvar(Args)
  675    ->  ArgC = 1
  676    ),
  677    E = error(Formal,_),
  678    catch(format_types(Format, Types), E, true),
  679    (   var(Formal)
  680    ->  length(Types, TypeC),
  681        TypeC =\= ArgC,
  682        Msg = format_argc(TypeC, ArgC)
  683    ;   Msg = format_template(Formal)
  684    ).
  685format_warning(system:format(_Stream, Format, Args), Msg) :-
  686    format_warning(system:format(Format, Args), Msg).
  687format_warning(prolog_debug:debug(_Channel, Format, Args), Msg) :-
  688    format_warning(system:format(Format, Args), Msg).
  689
  690
  691%!  goal_in_body(-G, +M, +Body) is nondet.
  692%
  693%   True when G is a goal called from Body.
  694
  695goal_in_body(M:G, M, G) :-
  696    var(G),
  697    !.
  698goal_in_body(G, _, M:G0) :-
  699    atom(M),
  700    !,
  701    goal_in_body(G, M, G0).
  702goal_in_body(G, M, Control) :-
  703    nonvar(Control),
  704    control(Control, Subs),
  705    !,
  706    member(Sub, Subs),
  707    goal_in_body(G, M, Sub).
  708goal_in_body(G, M, G0) :-
  709    callable(G0),
  710    (   atom(M)
  711    ->  TM = M
  712    ;   TM = system
  713    ),
  714    predicate_property(TM:G0, meta_predicate(Spec)),
  715    !,
  716    (   strip_goals(G0, Spec, G1),
  717        simple_goal_in_body(G, M, G1)
  718    ;   arg(I, Spec, Meta),
  719        arg(I, G0, G1),
  720        extend(Meta, G1, G2),
  721        goal_in_body(G, M, G2)
  722    ).
  723goal_in_body(G, M, G0) :-
  724    simple_goal_in_body(G, M, G0).
  725
  726simple_goal_in_body(G, M, G0) :-
  727    (   atom(M),
  728        callable(G0),
  729        predicate_property(M:G0, imported_from(M2))
  730    ->  G = M2:G0
  731    ;   G = M:G0
  732    ).
  733
  734control((A,B), [A,B]).
  735control((A;B), [A,B]).
  736control((A->B), [A,B]).
  737control((A*->B), [A,B]).
  738control((\+A), [A]).
  739
  740strip_goals(G0, Spec, G) :-
  741    functor(G0, Name, Arity),
  742    functor(G,  Name, Arity),
  743    strip_goal_args(1, G0, Spec, G).
  744
  745strip_goal_args(I, G0, Spec, G) :-
  746    arg(I, G0, A0),
  747    !,
  748    arg(I, Spec, M),
  749    (   extend(M, A0, _)
  750    ->  arg(I, G, '<meta-goal>')
  751    ;   arg(I, G, A0)
  752    ),
  753    I2 is I + 1,
  754    strip_goal_args(I2, G0, Spec, G).
  755strip_goal_args(_, _, _, _).
  756
  757extend(I, G0, G) :-
  758    callable(G0),
  759    integer(I), I>0,
  760    !,
  761    length(L, I),
  762    extend_list(G0, L, G).
  763extend(0, G, G).
  764extend(^, G, G).
  765
  766extend_list(M:G0, L, M:G) :-
  767    !,
  768    callable(G0),
  769    extend_list(G0, L, G).
  770extend_list(G0, L, G) :-
  771    G0 =.. List,
  772    append(List, L, All),
  773    G =.. All.
  774
  775
  776%!  message_context(+ClauseRef, +Term, +Clause, -Pos) is det.
  777%
  778%   Find an as accurate as possible location for Term in Clause.
  779
  780message_context(ClauseRef, Term, Clause, file_term_position(File, TermPos)) :-
  781    clause_info(ClauseRef, File, Layout, _Vars),
  782    (   Term = _:Goal,
  783        prolog_codewalk:subterm_pos(Goal, Clause, ==, Layout, TermPos)
  784    ;   prolog_codewalk:subterm_pos(Term, Clause, ==, Layout, TermPos)
  785    ),
  786    !.
  787message_context(ClauseRef, _String, _Clause, file(File, Line, -1, _)) :-
  788    clause_property(ClauseRef, file(File)),
  789    clause_property(ClauseRef, line_count(Line)),
  790    !.
  791message_context(ClauseRef, _String, _Clause, clause(ClauseRef)).
  792
  793
  794:- meta_predicate
  795    predicate_indicator(:, -).  796
  797predicate_indicator(Module:Head, Module:Name/Arity) :-
  798    functor(Head, Name, Arity).
  799predicate_indicator(Module:Head, Module:Name//DCGArity) :-
  800    functor(Head, Name, Arity),
  801    DCGArity is Arity-2.
  802
  803%!  string_predicate(:PredicateIndicator)
  804%
  805%   Multifile hook to disable list_strings/0 on the given predicate.
  806%   This is typically used for facts that store strings.
  807
  808string_predicate(_:'$pldoc'/4).
  809string_predicate(pce_principal:send_implementation/3).
  810string_predicate(pce_principal:pce_lazy_get_method/3).
  811string_predicate(pce_principal:pce_lazy_send_method/3).
  812string_predicate(pce_principal:pce_class/6).
  813string_predicate(prolog_xref:pred_comment/4).
  814string_predicate(prolog_xref:module_comment/3).
  815string_predicate(pldoc_process:structured_comment//2).
  816string_predicate(pldoc_process:structured_command_start/3).
  817string_predicate(pldoc_process:separator_line//0).
  818string_predicate(pldoc_register:mydoc/3).
  819string_predicate(http_header:separators/1).
  820
  821%!  valid_string_goal(+Goal) is semidet.
  822%
  823%   Multifile hook that qualifies Goal  as valid for list_strings/0.
  824%   For example, format("Hello world~n") is considered proper use of
  825%   string constants.
  826
  827% system predicates
  828valid_string_goal(system:format(S)) :- string(S).
  829valid_string_goal(system:format(S,_)) :- string(S).
  830valid_string_goal(system:format(_,S,_)) :- string(S).
  831valid_string_goal(system:string_codes(S,_)) :- string(S).
  832valid_string_goal(system:string_code(_,S,_)) :- string(S).
  833valid_string_goal(system:throw(msg(S,_))) :- string(S).
  834valid_string_goal('$dcg':phrase(S,_,_)) :- string(S).
  835valid_string_goal('$dcg':phrase(S,_)) :- string(S).
  836valid_string_goal(system: is(_,_)).     % arithmetic allows for "x"
  837valid_string_goal(system: =:=(_,_)).
  838valid_string_goal(system: >(_,_)).
  839valid_string_goal(system: <(_,_)).
  840valid_string_goal(system: >=(_,_)).
  841valid_string_goal(system: =<(_,_)).
  842% library stuff
  843valid_string_goal(dcg_basics:string_without(S,_,_,_)) :- string(S).
  844valid_string_goal(git:read_url(S,_,_)) :- string(S).
  845valid_string_goal(tipc:tipc_subscribe(_,_,_,_,S)) :- string(S).
  846valid_string_goal(charsio:format_to_chars(Format,_,_)) :- string(Format).
  847valid_string_goal(charsio:format_to_chars(Format,_,_,_)) :- string(Format).
  848valid_string_goal(codesio:format_to_codes(Format,_,_)) :- string(Format).
  849valid_string_goal(codesio:format_to_codes(Format,_,_,_)) :- string(Format).
  850
  851
  852                 /*******************************
  853                 *        EXTENSION HOOKS       *
  854                 *******************************/
  855
  856%!  checker(:Goal, +Message:text) is nondet.
  857%
  858%   Register code validation routines. Each clause  defines a Goal which
  859%   performs a consistency check executed by check/0. Message is a short
  860%   description of the check.  For   example,  assuming  the `my_checks`
  861%   module defines a predicate list_format_mistakes/0:
  862%
  863%      ```
  864%      :- multifile check:checker/2.
  865%      check:checker(my_checks:list_format_mistakes,
  866%                    "errors with format/2 arguments").
  867%      ```
  868%
  869%   The predicate is dynamic, so you  can disable checks with retract/1.
  870%   For example, to stop reporting redefined predicates:
  871%
  872%      ```
  873%      retract(check:checker(list_redefined,_)).
  874%      ```
  875
  876checker(list_undefined,          'undefined predicates').
  877checker(list_trivial_fails,      'trivial failures').
  878checker(list_format_errors,      'format/2,3 and debug/3 templates').
  879checker(list_redefined,          'redefined system and global predicates').
  880checker(list_void_declarations,  'predicates with declarations but without clauses').
  881checker(list_autoload,           'predicates that need autoloading').
  882checker(check_predicate_options, 'predicate options lists').
  883
  884
  885                 /*******************************
  886                 *            MESSAGES          *
  887                 *******************************/
  888
  889:- multifile
  890    prolog:message/3.  891
  892prolog:message(check(pass(Comment))) -->
  893    [ 'Checking ~w ...'-[Comment] ].
  894prolog:message(check(find_references(Preds))) -->
  895    { length(Preds, N)
  896    },
  897    [ 'Scanning for references to ~D possibly undefined predicates'-[N] ].
  898prolog:message(check(undefined_procedures, Grouped)) -->
  899    [ 'The predicates below are not defined. If these are defined', nl,
  900      'at runtime using assert/1, use :- dynamic Name/Arity.', nl, nl
  901    ],
  902    undefined_procedures(Grouped).
  903prolog:message(check(undefined_unreferenced_predicates)) -->
  904    [ 'The predicates below are not defined, and are not', nl,
  905      'referenced.', nl, nl
  906    ].
  907prolog:message(check(undefined_unreferenced(Pred))) -->
  908    predicate(Pred).
  909prolog:message(check(autoload(Module, Pairs))) -->
  910    { module_property(Module, file(Path))
  911    },
  912    !,
  913    [ 'Into module ~w ('-[Module] ],
  914    short_filename(Path),
  915    [ ')', nl ],
  916    autoload(Pairs).
  917prolog:message(check(autoload(Module, Pairs))) -->
  918    [ 'Into module ~w'-[Module], nl ],
  919    autoload(Pairs).
  920prolog:message(check(redefined(In, From, Pred))) -->
  921    predicate(In:Pred),
  922    redefined(In, From).
  923prolog:message(check(cross_module_calls)) -->
  924    [ 'Qualified calls to private predicates'-[] ].
  925prolog:message(check(cross_module_call(Callee, _Caller, Location))) -->
  926    { pi_head(PI, Callee) },
  927    [ '  '-[] ],
  928    '$messages':swi_location(Location),
  929    [ 'Cross-module call to ~p'-[PI] ].
  930prolog:message(check(trivial_failures)) -->
  931    [ 'The following goals fail because there are no matching clauses.' ].
  932prolog:message(check(trivial_failure(Goal, Refs))) -->
  933    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
  934      keysort(Keyed, KeySorted),
  935      pairs_values(KeySorted, SortedRefs)
  936    },
  937    goal(Goal),
  938    [ ', which is called from'-[], nl ],
  939    referenced_by(SortedRefs).
  940prolog:message(check(string_in_clause(String, Context))) -->
  941    '$messages':swi_location(Context),
  942    [ 'String ~q'-[String] ].
  943prolog:message(check(rational_in_clause(String, Context))) -->
  944    '$messages':swi_location(Context),
  945    [ 'Rational ~q'-[String] ].
  946prolog:message(check(Msg, Goal, Context)) -->
  947    '$messages':swi_location(Context),
  948    { pi_head(PI, Goal) },
  949    [ nl, '    '-[] ],
  950    predicate(PI),
  951    [ ': '-[] ],
  952    check_message(Msg).
  953prolog:message(check(void_declaration(P, Decl))) -->
  954    predicate(P),
  955    [ ' is declared with ', ansi(code, '~p', [Decl]), ' but has no clauses' ].
  956
  957undefined_procedures([]) -->
  958    [].
  959undefined_procedures([H|T]) -->
  960    undefined_procedure(H),
  961    undefined_procedures(T).
  962
  963undefined_procedure(Pred-Refs) -->
  964    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
  965      keysort(Keyed, KeySorted),
  966      pairs_values(KeySorted, SortedRefs)
  967    },
  968    predicate(Pred),
  969    [ ', which is referenced by', nl ],
  970    referenced_by(SortedRefs).
  971
  972redefined(user, system) -->
  973    [ '~t~30| System predicate redefined globally' ].
  974redefined(_, system) -->
  975    [ '~t~30| Redefined system predicate' ].
  976redefined(_, user) -->
  977    [ '~t~30| Redefined global predicate' ].
  978
  979goal(user:Goal) -->
  980    !,
  981    [ '~p'-[Goal] ].
  982goal(Goal) -->
  983    !,
  984    [ '~p'-[Goal] ].
  985
  986predicate(Module:Name/Arity) -->
  987    { atom(Module),
  988      atom(Name),
  989      integer(Arity),
  990      functor(Head, Name, Arity),
  991      predicate_name(Module:Head, PName)
  992    },
  993    !,
  994    [ ansi(code, '~w', [PName]) ].
  995predicate(Module:Head) -->
  996    { atom(Module),
  997      callable(Head),
  998      predicate_name(Module:Head, PName)
  999    },
 1000    !,
 1001    [ ansi(code, '~w', [PName]) ].
 1002predicate(Name/Arity) -->
 1003    { atom(Name),
 1004      integer(Arity)
 1005    },
 1006    !,
 1007    predicate(user:Name/Arity).
 1008
 1009autoload([]) -->
 1010    [].
 1011autoload([Lib-Pred|T]) -->
 1012    [ '    ' ],
 1013    predicate(Pred),
 1014    [ '~t~24| from ' ],
 1015    short_filename(Lib),
 1016    [ nl ],
 1017    autoload(T).
 1018
 1019%!  sort_reference_key(+Reference, -Key) is det.
 1020%
 1021%   Create a stable key for sorting references to predicates.
 1022
 1023sort_reference_key(Term, key(M:Name/Arity, N, ClausePos)) :-
 1024    clause_ref(Term, ClauseRef, ClausePos),
 1025    !,
 1026    nth_clause(Pred, N, ClauseRef),
 1027    strip_module(Pred, M, Head),
 1028    functor(Head, Name, Arity).
 1029sort_reference_key(Term, Term).
 1030
 1031clause_ref(clause_term_position(ClauseRef, TermPos), ClauseRef, ClausePos) :-
 1032    arg(1, TermPos, ClausePos).
 1033clause_ref(clause(ClauseRef), ClauseRef, 0).
 1034
 1035
 1036referenced_by([]) -->
 1037    [].
 1038referenced_by([Ref|T]) -->
 1039    ['\t'], prolog:message_location(Ref),
 1040            predicate_indicator(Ref),
 1041    [ nl ],
 1042    referenced_by(T).
 1043
 1044predicate_indicator(clause_term_position(ClauseRef, _)) -->
 1045    { nonvar(ClauseRef) },
 1046    !,
 1047    predicate_indicator(clause(ClauseRef)).
 1048predicate_indicator(clause(ClauseRef)) -->
 1049    { clause_name(ClauseRef, Name) },
 1050    [ '~w'-[Name] ].
 1051predicate_indicator(file_term_position(_,_)) -->
 1052    [ '(initialization)' ].
 1053predicate_indicator(file(_,_,_,_)) -->
 1054    [ '(initialization)' ].
 1055
 1056
 1057short_filename(Path) -->
 1058    { short_filename(Path, Spec)
 1059    },
 1060    [ '~q'-[Spec] ].
 1061
 1062short_filename(Path, Spec) :-
 1063    absolute_file_name('', Here),
 1064    atom_concat(Here, Local0, Path),
 1065    !,
 1066    remove_leading_slash(Local0, Spec).
 1067short_filename(Path, Spec) :-
 1068    findall(LenAlias, aliased_path(Path, LenAlias), Keyed),
 1069    keysort(Keyed, [_-Spec|_]).
 1070short_filename(Path, Path).
 1071
 1072aliased_path(Path, Len-Spec) :-
 1073    setof(Alias, Spec^(user:file_search_path(Alias, Spec)), Aliases),
 1074    member(Alias, Aliases),
 1075    Term =.. [Alias, '.'],
 1076    absolute_file_name(Term,
 1077                       [ file_type(directory),
 1078                         file_errors(fail),
 1079                         solutions(all)
 1080                       ], Prefix),
 1081    atom_concat(Prefix, Local0, Path),
 1082    remove_leading_slash(Local0, Local),
 1083    atom_length(Local, Len),
 1084    Spec =.. [Alias, Local].
 1085
 1086remove_leading_slash(Path, Local) :-
 1087    atom_concat(/, Local, Path),
 1088    !.
 1089remove_leading_slash(Path, Path).
 1090
 1091check_message(format_argc(Expected, InList)) -->
 1092    [ 'Template requires ~w arguments, got ~w'-[Expected, InList] ].
 1093check_message(format_template(Formal)) -->
 1094    { message_to_string(error(Formal, _), Msg) },
 1095    [ 'Invalid template: ~s'-[Msg] ].
 1096check_message(format_argv(Args)) -->
 1097    [ 'Arguments are not in a list (deprecated): ~p'-[Args] ]