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