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            print_message(warning,
  403                          check(void_declaration(P, meta_predicate(Pattern))))
  404        ;   void_attribute(Attr),
  405            '$get_predicate_attribute'(P, Attr, 1),
  406            print_message(warning,
  407                          check(void_declaration(P, Attr)))
  408        ),
  409        fail
  410    ;   predicate_property(P, discontiguous),
  411        \+ (predicate_property(P, number_of_clauses(N)), N > 0),
  412        print_message(warning,
  413                      check(void_declaration(P, discontiguous))),
  414        fail
  415    ;   true
  416    ).
  417
  418void_attribute(public).
  419void_attribute(volatile).
  420void_attribute(det).
  421
  422%!  list_trivial_fails is det.
  423%!  list_trivial_fails(+Options) is det.
  424%
  425%   List goals that trivially fail  because   there  is  no matching
  426%   clause.  Options:
  427%
  428%     * module_class(+Classes)
  429%       Process modules of the given Classes.  The default for
  430%       classes is =|[user]|=. For example, to include the
  431%       libraries into the examination, use =|[user,library]|=.
  432
  433:- thread_local
  434    trivial_fail/2.  435
  436list_trivial_fails :-
  437    list_trivial_fails([]).
  438
  439list_trivial_fails(Options) :-
  440    merge_options(Options,
  441                  [ module_class([user]),
  442                    infer_meta_predicates(false),
  443                    autoload(false),
  444                    evaluate(false),
  445                    trace_reference(_),
  446                    on_trace(check_trivial_fail)
  447                  ],
  448                  WalkOptions),
  449
  450    prolog_walk_code([ source(false)
  451                     | WalkOptions
  452                     ]),
  453    findall(CRef, retract(trivial_fail(clause(CRef), _)), Clauses),
  454    (   Clauses == []
  455    ->  true
  456    ;   print_message(warning, check(trivial_failures)),
  457        prolog_walk_code([ clauses(Clauses)
  458                         | WalkOptions
  459                         ]),
  460        findall(Goal-From, retract(trivial_fail(From, Goal)), Pairs),
  461        keysort(Pairs, Sorted),
  462        group_pairs_by_key(Sorted, Grouped),
  463        maplist(report_trivial_fail, Grouped)
  464    ).
  465
  466%!  trivial_fail_goal(:Goal)
  467%
  468%   Multifile hook that tells list_trivial_fails/0 to accept Goal as
  469%   valid.
  470
  471trivial_fail_goal(pce_expansion:pce_class(_, _, template, _, _, _)).
  472trivial_fail_goal(pce_host:property(system_source_prefix(_))).
  473
  474:- public
  475    check_trivial_fail/3.  476
  477check_trivial_fail(MGoal0, _Caller, From) :-
  478    (   MGoal0 = M:Goal,
  479        atom(M),
  480        callable(Goal),
  481        predicate_property(MGoal0, interpreted),
  482        \+ predicate_property(MGoal0, dynamic),
  483        \+ predicate_property(MGoal0, multifile),
  484        \+ trivial_fail_goal(MGoal0)
  485    ->  (   predicate_property(MGoal0, meta_predicate(Meta))
  486        ->  qualify_meta_goal(MGoal0, Meta, MGoal)
  487        ;   MGoal = MGoal0
  488        ),
  489        (   clause(MGoal, _)
  490        ->  true
  491        ;   assertz(trivial_fail(From, MGoal))
  492        )
  493    ;   true
  494    ).
  495
  496report_trivial_fail(Goal-FromList) :-
  497    print_message(warning, check(trivial_failure(Goal, FromList))).
  498
  499%!  qualify_meta_goal(+Module, +MetaSpec, +Goal, -QualifiedGoal)
  500%
  501%   Qualify a goal if the goal calls a meta predicate
  502
  503qualify_meta_goal(M:Goal0, Meta, M:Goal) :-
  504    functor(Goal0, F, N),
  505    functor(Goal, F, N),
  506    qualify_meta_goal(1, M, Meta, Goal0, Goal).
  507
  508qualify_meta_goal(N, M, Meta, Goal0, Goal) :-
  509    arg(N, Meta,  ArgM),
  510    !,
  511    arg(N, Goal0, Arg0),
  512    arg(N, Goal,  Arg),
  513    N1 is N + 1,
  514    (   module_qualified(ArgM)
  515    ->  add_module(Arg0, M, Arg)
  516    ;   Arg = Arg0
  517    ),
  518    meta_goal(N1, Meta, Goal0, Goal).
  519meta_goal(_, _, _, _).
  520
  521add_module(Arg, M, M:Arg) :-
  522    var(Arg),
  523    !.
  524add_module(M:Arg, _, MArg) :-
  525    !,
  526    add_module(Arg, M, MArg).
  527add_module(Arg, M, M:Arg).
  528
  529module_qualified(N) :- integer(N), !.
  530module_qualified(:).
  531module_qualified(^).
  532
  533
  534%!  list_strings is det.
  535%!  list_strings(+Options) is det.
  536%
  537%   List strings that appear in clauses.   This predicate is used to
  538%   find  portability  issues  for   changing    the   Prolog   flag
  539%   =double_quotes= from =codes= to =string=, creating packed string
  540%   objects.  Warnings  may  be  suppressed    using  the  following
  541%   multifile hooks:
  542%
  543%     - string_predicate/1 to stop checking certain predicates
  544%     - valid_string_goal/1 to tell the checker that a goal is
  545%       safe.
  546%
  547%   @see Prolog flag =double_quotes=.
  548
  549list_strings :-
  550    list_strings([module_class([user])]).
  551
  552list_strings(Options) :-
  553    (   prolog_program_clause(ClauseRef, Options),
  554        clause(Head, Body, ClauseRef),
  555        \+ ( predicate_indicator(Head, PI),
  556             string_predicate(PI)
  557           ),
  558        make_clause(Head, Body, Clause),
  559        findall(T,
  560                (   sub_term(T, Head),
  561                    string(T)
  562                ;   Head = M:_,
  563                    goal_in_body(Goal, M, Body),
  564                    (   valid_string_goal(Goal)
  565                    ->  fail
  566                    ;   sub_term(T, Goal),
  567                        string(T)
  568                    )
  569                ), Ts0),
  570        sort(Ts0, Ts),
  571        member(T, Ts),
  572        message_context(ClauseRef, T, Clause, Context),
  573        print_message(warning,
  574                      check(string_in_clause(T, Context))),
  575        fail
  576    ;   true
  577    ).
  578
  579make_clause(Head, true, Head) :- !.
  580make_clause(Head, Body, (Head:-Body)).
  581
  582%!  list_rationals is det.
  583%!  list_rationals(+Options) is det.
  584%
  585%   List rational numbers that appear in clauses. This predicate is used
  586%   to  find  portability  issues   for    changing   the   Prolog  flag
  587%   `rational_syntax`  to  `natural`,  creating  rational  numbers  from
  588%   <integer>/<nonneg>. Options:
  589%
  590%      - module_class(+Classes)
  591%        Determines the modules classes processed.  By default only
  592%        user code is processed.  See prolog_program_clause/2.
  593%      - arithmetic(+Bool)
  594%        If `true` (default `false`) also warn on rationals appearing
  595%        in arithmetic expressions.
  596%
  597%   @see Prolog flag `rational_syntax` and `prefer_rationals`.
  598
  599list_rationals :-
  600    list_rationals([module_class([user])]).
  601
  602list_rationals(Options) :-
  603    (   option(arithmetic(DoArith), Options, false),
  604        prolog_program_clause(ClauseRef, Options),
  605        clause(Head, Body, ClauseRef),
  606        make_clause(Head, Body, Clause),
  607        findall(T,
  608                (   sub_term(T, Head),
  609                    rational(T),
  610                    \+ integer(T)
  611                ;   Head = M:_,
  612                    goal_in_body(Goal, M, Body),
  613                    nonvar(Goal),
  614                    (   DoArith == false,
  615                        valid_rational_goal(Goal)
  616                    ->  fail
  617                    ;   sub_term(T, Goal),
  618                        rational(T),
  619                        \+ integer(T)
  620                    )
  621                ), Ts0),
  622        sort(Ts0, Ts),
  623        member(T, Ts),
  624        message_context(ClauseRef, T, Clause, Context),
  625        print_message(warning,
  626                      check(rational_in_clause(T, Context))),
  627        fail
  628    ;   true
  629    ).
  630
  631
  632valid_rational_goal(_ is _).
  633valid_rational_goal(_ =:= _).
  634valid_rational_goal(_ < _).
  635valid_rational_goal(_ > _).
  636valid_rational_goal(_ =< _).
  637valid_rational_goal(_ >= _).
  638
  639
  640%!  list_format_errors is det.
  641%!  list_format_errors(+Options) is det.
  642%
  643%   List argument errors for format/2,3.
  644
  645list_format_errors :-
  646    list_format_errors([module_class([user])]).
  647
  648list_format_errors(Options) :-
  649    (   prolog_program_clause(ClauseRef, Options),
  650        clause(Head, Body, ClauseRef),
  651        make_clause(Head, Body, Clause),
  652        Head = M:_,
  653        goal_in_body(Goal, M, Body),
  654        format_warning(Goal, Msg),
  655        message_context(ClauseRef, Goal, Clause, Context),
  656        print_message(warning, check(Msg, Goal, Context)),
  657        fail
  658    ;   true
  659    ).
  660
  661format_warning(system:format(Format, Args), Msg) :-
  662    nonvar(Format),
  663    nonvar(Args),
  664    \+ is_list(Args),
  665    Msg = format_argv(Args).
  666format_warning(system:format(Format, Args), Msg) :-
  667    ground(Format),
  668    (   is_list(Args)
  669    ->  length(Args, ArgC)
  670    ;   nonvar(Args)
  671    ->  ArgC = 1
  672    ),
  673    E = error(Formal,_),
  674    catch(format_types(Format, Types), E, true),
  675    (   var(Formal)
  676    ->  length(Types, TypeC),
  677        TypeC =\= ArgC,
  678        Msg = format_argc(TypeC, ArgC)
  679    ;   Msg = format_template(Formal)
  680    ).
  681format_warning(system:format(_Stream, Format, Args), Msg) :-
  682    format_warning(system:format(Format, Args), Msg).
  683format_warning(prolog_debug:debug(_Channel, Format, Args), Msg) :-
  684    format_warning(system:format(Format, Args), Msg).
  685
  686
  687%!  goal_in_body(-G, +M, +Body) is nondet.
  688%
  689%   True when G is a goal called from Body.
  690
  691goal_in_body(M:G, M, G) :-
  692    var(G),
  693    !.
  694goal_in_body(G, _, M:G0) :-
  695    atom(M),
  696    !,
  697    goal_in_body(G, M, G0).
  698goal_in_body(G, M, Control) :-
  699    nonvar(Control),
  700    control(Control, Subs),
  701    !,
  702    member(Sub, Subs),
  703    goal_in_body(G, M, Sub).
  704goal_in_body(G, M, G0) :-
  705    callable(G0),
  706    (   atom(M)
  707    ->  TM = M
  708    ;   TM = system
  709    ),
  710    predicate_property(TM:G0, meta_predicate(Spec)),
  711    !,
  712    (   strip_goals(G0, Spec, G1),
  713        simple_goal_in_body(G, M, G1)
  714    ;   arg(I, Spec, Meta),
  715        arg(I, G0, G1),
  716        extend(Meta, G1, G2),
  717        goal_in_body(G, M, G2)
  718    ).
  719goal_in_body(G, M, G0) :-
  720    simple_goal_in_body(G, M, G0).
  721
  722simple_goal_in_body(G, M, G0) :-
  723    (   atom(M),
  724        callable(G0),
  725        predicate_property(M:G0, imported_from(M2))
  726    ->  G = M2:G0
  727    ;   G = M:G0
  728    ).
  729
  730control((A,B), [A,B]).
  731control((A;B), [A,B]).
  732control((A->B), [A,B]).
  733control((A*->B), [A,B]).
  734control((\+A), [A]).
  735
  736strip_goals(G0, Spec, G) :-
  737    functor(G0, Name, Arity),
  738    functor(G,  Name, Arity),
  739    strip_goal_args(1, G0, Spec, G).
  740
  741strip_goal_args(I, G0, Spec, G) :-
  742    arg(I, G0, A0),
  743    !,
  744    arg(I, Spec, M),
  745    (   extend(M, A0, _)
  746    ->  arg(I, G, '<meta-goal>')
  747    ;   arg(I, G, A0)
  748    ),
  749    I2 is I + 1,
  750    strip_goal_args(I2, G0, Spec, G).
  751strip_goal_args(_, _, _, _).
  752
  753extend(I, G0, G) :-
  754    callable(G0),
  755    integer(I), I>0,
  756    !,
  757    length(L, I),
  758    extend_list(G0, L, G).
  759extend(0, G, G).
  760extend(^, G, G).
  761
  762extend_list(M:G0, L, M:G) :-
  763    !,
  764    callable(G0),
  765    extend_list(G0, L, G).
  766extend_list(G0, L, G) :-
  767    G0 =.. List,
  768    append(List, L, All),
  769    G =.. All.
  770
  771
  772%!  message_context(+ClauseRef, +Term, +Clause, -Pos) is det.
  773%
  774%   Find an as accurate as possible location for Term in Clause.
  775
  776message_context(ClauseRef, Term, Clause, file_term_position(File, TermPos)) :-
  777    clause_info(ClauseRef, File, Layout, _Vars),
  778    (   Term = _:Goal,
  779        prolog_codewalk:subterm_pos(Goal, Clause, ==, Layout, TermPos)
  780    ;   prolog_codewalk:subterm_pos(Term, Clause, ==, Layout, TermPos)
  781    ),
  782    !.
  783message_context(ClauseRef, _String, _Clause, file(File, Line, -1, _)) :-
  784    clause_property(ClauseRef, file(File)),
  785    clause_property(ClauseRef, line_count(Line)),
  786    !.
  787message_context(ClauseRef, _String, _Clause, clause(ClauseRef)).
  788
  789
  790:- meta_predicate
  791    predicate_indicator(:, -).  792
  793predicate_indicator(Module:Head, Module:Name/Arity) :-
  794    functor(Head, Name, Arity).
  795predicate_indicator(Module:Head, Module:Name//DCGArity) :-
  796    functor(Head, Name, Arity),
  797    DCGArity is Arity-2.
  798
  799%!  string_predicate(:PredicateIndicator)
  800%
  801%   Multifile hook to disable list_strings/0 on the given predicate.
  802%   This is typically used for facts that store strings.
  803
  804string_predicate(_:'$pldoc'/4).
  805string_predicate(pce_principal:send_implementation/3).
  806string_predicate(pce_principal:pce_lazy_get_method/3).
  807string_predicate(pce_principal:pce_lazy_send_method/3).
  808string_predicate(pce_principal:pce_class/6).
  809string_predicate(prolog_xref:pred_comment/4).
  810string_predicate(prolog_xref:module_comment/3).
  811string_predicate(pldoc_process:structured_comment//2).
  812string_predicate(pldoc_process:structured_command_start/3).
  813string_predicate(pldoc_process:separator_line//0).
  814string_predicate(pldoc_register:mydoc/3).
  815string_predicate(http_header:separators/1).
  816
  817%!  valid_string_goal(+Goal) is semidet.
  818%
  819%   Multifile hook that qualifies Goal  as valid for list_strings/0.
  820%   For example, format("Hello world~n") is considered proper use of
  821%   string constants.
  822
  823% system predicates
  824valid_string_goal(system:format(S)) :- string(S).
  825valid_string_goal(system:format(S,_)) :- string(S).
  826valid_string_goal(system:format(_,S,_)) :- string(S).
  827valid_string_goal(system:string_codes(S,_)) :- string(S).
  828valid_string_goal(system:string_code(_,S,_)) :- string(S).
  829valid_string_goal(system:throw(msg(S,_))) :- string(S).
  830valid_string_goal('$dcg':phrase(S,_,_)) :- string(S).
  831valid_string_goal('$dcg':phrase(S,_)) :- string(S).
  832valid_string_goal(system: is(_,_)).     % arithmetic allows for "x"
  833valid_string_goal(system: =:=(_,_)).
  834valid_string_goal(system: >(_,_)).
  835valid_string_goal(system: <(_,_)).
  836valid_string_goal(system: >=(_,_)).
  837valid_string_goal(system: =<(_,_)).
  838% library stuff
  839valid_string_goal(dcg_basics:string_without(S,_,_,_)) :- string(S).
  840valid_string_goal(git:read_url(S,_,_)) :- string(S).
  841valid_string_goal(tipc:tipc_subscribe(_,_,_,_,S)) :- string(S).
  842valid_string_goal(charsio:format_to_chars(Format,_,_)) :- string(Format).
  843valid_string_goal(charsio:format_to_chars(Format,_,_,_)) :- string(Format).
  844valid_string_goal(codesio:format_to_codes(Format,_,_)) :- string(Format).
  845valid_string_goal(codesio:format_to_codes(Format,_,_,_)) :- string(Format).
  846
  847
  848                 /*******************************
  849                 *        EXTENSION HOOKS       *
  850                 *******************************/
  851
  852%!  checker(:Goal, +Message:text) is nondet.
  853%
  854%   Register code validation routines. Each clause  defines a Goal which
  855%   performs a consistency check executed by check/0. Message is a short
  856%   description of the check.  For   example,  assuming  the `my_checks`
  857%   module defines a predicate list_format_mistakes/0:
  858%
  859%      ```
  860%      :- multifile check:checker/2.
  861%      check:checker(my_checks:list_format_mistakes,
  862%                    "errors with format/2 arguments").
  863%      ```
  864%
  865%   The predicate is dynamic, so you  can disable checks with retract/1.
  866%   For example, to stop reporting redefined predicates:
  867%
  868%      ```
  869%      retract(check:checker(list_redefined,_)).
  870%      ```
  871
  872checker(list_undefined,          'undefined predicates').
  873checker(list_trivial_fails,      'trivial failures').
  874checker(list_format_errors,      'format/2,3 and debug/3 templates').
  875checker(list_redefined,          'redefined system and global predicates').
  876checker(list_void_declarations,  'predicates with declarations but without clauses').
  877checker(list_autoload,           'predicates that need autoloading').
  878checker(check_predicate_options, 'predicate options lists').
  879
  880
  881                 /*******************************
  882                 *            MESSAGES          *
  883                 *******************************/
  884
  885:- multifile
  886    prolog:message/3.  887
  888prolog:message(check(pass(Comment))) -->
  889    [ 'Checking ~w ...'-[Comment] ].
  890prolog:message(check(find_references(Preds))) -->
  891    { length(Preds, N)
  892    },
  893    [ 'Scanning for references to ~D possibly undefined predicates'-[N] ].
  894prolog:message(check(undefined_procedures, Grouped)) -->
  895    [ 'The predicates below are not defined. If these are defined', nl,
  896      'at runtime using assert/1, use :- dynamic Name/Arity.', nl, nl
  897    ],
  898    undefined_procedures(Grouped).
  899prolog:message(check(undefined_unreferenced_predicates)) -->
  900    [ 'The predicates below are not defined, and are not', nl,
  901      'referenced.', nl, nl
  902    ].
  903prolog:message(check(undefined_unreferenced(Pred))) -->
  904    predicate(Pred).
  905prolog:message(check(autoload(Module, Pairs))) -->
  906    { module_property(Module, file(Path))
  907    },
  908    !,
  909    [ 'Into module ~w ('-[Module] ],
  910    short_filename(Path),
  911    [ ')', nl ],
  912    autoload(Pairs).
  913prolog:message(check(autoload(Module, Pairs))) -->
  914    [ 'Into module ~w'-[Module], nl ],
  915    autoload(Pairs).
  916prolog:message(check(redefined(In, From, Pred))) -->
  917    predicate(In:Pred),
  918    redefined(In, From).
  919prolog:message(check(cross_module_calls)) -->
  920    [ 'Qualified calls to private predicates'-[] ].
  921prolog:message(check(cross_module_call(Callee, _Caller, Location))) -->
  922    { pi_head(PI, Callee) },
  923    [ '  '-[] ],
  924    '$messages':swi_location(Location),
  925    [ 'Cross-module call to ~p'-[PI] ].
  926prolog:message(check(trivial_failures)) -->
  927    [ 'The following goals fail because there are no matching clauses.' ].
  928prolog:message(check(trivial_failure(Goal, Refs))) -->
  929    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
  930      keysort(Keyed, KeySorted),
  931      pairs_values(KeySorted, SortedRefs)
  932    },
  933    goal(Goal),
  934    [ ', which is called from'-[], nl ],
  935    referenced_by(SortedRefs).
  936prolog:message(check(string_in_clause(String, Context))) -->
  937    '$messages':swi_location(Context),
  938    [ 'String ~q'-[String] ].
  939prolog:message(check(rational_in_clause(String, Context))) -->
  940    '$messages':swi_location(Context),
  941    [ 'Rational ~q'-[String] ].
  942prolog:message(check(Msg, Goal, Context)) -->
  943    '$messages':swi_location(Context),
  944    { pi_head(PI, Goal) },
  945    [ nl, '    '-[] ],
  946    predicate(PI),
  947    [ ': '-[] ],
  948    check_message(Msg).
  949prolog:message(check(void_declaration(P, Decl))) -->
  950    predicate(P),
  951    [ ' is declared as ~p, but has no clauses'-[Decl] ].
  952
  953undefined_procedures([]) -->
  954    [].
  955undefined_procedures([H|T]) -->
  956    undefined_procedure(H),
  957    undefined_procedures(T).
  958
  959undefined_procedure(Pred-Refs) -->
  960    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
  961      keysort(Keyed, KeySorted),
  962      pairs_values(KeySorted, SortedRefs)
  963    },
  964    predicate(Pred),
  965    [ ', which is referenced by', nl ],
  966    referenced_by(SortedRefs).
  967
  968redefined(user, system) -->
  969    [ '~t~30| System predicate redefined globally' ].
  970redefined(_, system) -->
  971    [ '~t~30| Redefined system predicate' ].
  972redefined(_, user) -->
  973    [ '~t~30| Redefined global predicate' ].
  974
  975goal(user:Goal) -->
  976    !,
  977    [ '~p'-[Goal] ].
  978goal(Goal) -->
  979    !,
  980    [ '~p'-[Goal] ].
  981
  982predicate(Module:Name/Arity) -->
  983    { atom(Module),
  984      atom(Name),
  985      integer(Arity),
  986      functor(Head, Name, Arity),
  987      predicate_name(Module:Head, PName)
  988    },
  989    !,
  990    [ '~w'-[PName] ].
  991predicate(Module:Head) -->
  992    { atom(Module),
  993      callable(Head),
  994      predicate_name(Module:Head, PName)
  995    },
  996    !,
  997    [ '~w'-[PName] ].
  998predicate(Name/Arity) -->
  999    { atom(Name),
 1000      integer(Arity)
 1001    },
 1002    !,
 1003    predicate(user:Name/Arity).
 1004
 1005autoload([]) -->
 1006    [].
 1007autoload([Lib-Pred|T]) -->
 1008    [ '    ' ],
 1009    predicate(Pred),
 1010    [ '~t~24| from ' ],
 1011    short_filename(Lib),
 1012    [ nl ],
 1013    autoload(T).
 1014
 1015%!  sort_reference_key(+Reference, -Key) is det.
 1016%
 1017%   Create a stable key for sorting references to predicates.
 1018
 1019sort_reference_key(Term, key(M:Name/Arity, N, ClausePos)) :-
 1020    clause_ref(Term, ClauseRef, ClausePos),
 1021    !,
 1022    nth_clause(Pred, N, ClauseRef),
 1023    strip_module(Pred, M, Head),
 1024    functor(Head, Name, Arity).
 1025sort_reference_key(Term, Term).
 1026
 1027clause_ref(clause_term_position(ClauseRef, TermPos), ClauseRef, ClausePos) :-
 1028    arg(1, TermPos, ClausePos).
 1029clause_ref(clause(ClauseRef), ClauseRef, 0).
 1030
 1031
 1032referenced_by([]) -->
 1033    [].
 1034referenced_by([Ref|T]) -->
 1035    ['\t'], prolog:message_location(Ref),
 1036            predicate_indicator(Ref),
 1037    [ nl ],
 1038    referenced_by(T).
 1039
 1040predicate_indicator(clause_term_position(ClauseRef, _)) -->
 1041    { nonvar(ClauseRef) },
 1042    !,
 1043    predicate_indicator(clause(ClauseRef)).
 1044predicate_indicator(clause(ClauseRef)) -->
 1045    { clause_name(ClauseRef, Name) },
 1046    [ '~w'-[Name] ].
 1047predicate_indicator(file_term_position(_,_)) -->
 1048    [ '(initialization)' ].
 1049predicate_indicator(file(_,_,_,_)) -->
 1050    [ '(initialization)' ].
 1051
 1052
 1053short_filename(Path) -->
 1054    { short_filename(Path, Spec)
 1055    },
 1056    [ '~q'-[Spec] ].
 1057
 1058short_filename(Path, Spec) :-
 1059    absolute_file_name('', Here),
 1060    atom_concat(Here, Local0, Path),
 1061    !,
 1062    remove_leading_slash(Local0, Spec).
 1063short_filename(Path, Spec) :-
 1064    findall(LenAlias, aliased_path(Path, LenAlias), Keyed),
 1065    keysort(Keyed, [_-Spec|_]).
 1066short_filename(Path, Path).
 1067
 1068aliased_path(Path, Len-Spec) :-
 1069    setof(Alias, Spec^(user:file_search_path(Alias, Spec)), Aliases),
 1070    member(Alias, Aliases),
 1071    Term =.. [Alias, '.'],
 1072    absolute_file_name(Term,
 1073                       [ file_type(directory),
 1074                         file_errors(fail),
 1075                         solutions(all)
 1076                       ], Prefix),
 1077    atom_concat(Prefix, Local0, Path),
 1078    remove_leading_slash(Local0, Local),
 1079    atom_length(Local, Len),
 1080    Spec =.. [Alias, Local].
 1081
 1082remove_leading_slash(Path, Local) :-
 1083    atom_concat(/, Local, Path),
 1084    !.
 1085remove_leading_slash(Path, Path).
 1086
 1087check_message(format_argc(Expected, InList)) -->
 1088    [ 'Template requires ~w arguments, got ~w'-[Expected, InList] ].
 1089check_message(format_template(Formal)) -->
 1090    { message_to_string(error(Formal, _), Msg) },
 1091    [ 'Invalid template: ~s'-[Msg] ].
 1092check_message(format_argv(Args)) -->
 1093    [ 'Arguments are not in a list (deprecated): ~p'-[Args] ]