1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (c)  1985-2026, 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_keys/2,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		 *  UTS #39 confusable atoms	*
  887		 *******************************/
  888
  889%   library(unicode_security) lives in packages/utf8proc and is only
  890%   present when that package is built.  We expose the linter on systems
  891%   where it is available; on other builds the predicate simply does
  892%   not exist and the checker is not registered.
  893
  894:- if(exists_source(library(unicode_security))).  895
  896:- export(list_confusable_identifiers/0).  897:- export(list_confusable_identifiers/1).  898:- autoload(library(unicode_security),
  899            [unicode_skeleton/2, unicode_restriction_level/2]).  900
  901checker(list_confusable_identifiers,
  902        'confusable identifier names (UTS #39)').
  903
  904%!  list_confusable_identifiers is det.
  905%!  list_confusable_identifiers(+Options) is det.
  906%
  907%   Walk every clause in the modules selected by `module_class`
  908%   (default `[user]`) and warn on atoms whose written form is a
  909%   possible UTS #39 spoof.  Two issues are reported:
  910%
  911%   * an atom whose unicode_restriction_level/2 is not safe (worse
  912%     than `single_script`), reported at the first source location
  913%     where it occurs;
  914%   * groups of distinct atoms with equal unicode_skeleton/2 — two
  915%     identifiers in the same program that look the same.
  916%
  917%   Only atoms whose written form does not require quotes are
  918%   considered (see '$needs_quotes'/1).  Loaded via the multifile
  919%   check:checker/2 hook, so a plain check/0 runs this check too.
  920
  921:- thread_local
  922    seen_confusable_atom/3.    % Atom, Skeleton, Context
  923
  924list_confusable_identifiers :-
  925    list_confusable_identifiers([module_class([user])]).
  926
  927list_confusable_identifiers(Options) :-
  928    setup_call_cleanup(
  929        true,
  930        ( walk_confusable_atoms(Options),
  931          report_mixed_script_atoms,
  932          report_confusable_collisions ),
  933        retractall(seen_confusable_atom(_,_,_))).
  934
  935walk_confusable_atoms(Options) :-
  936    (   prolog_program_clause(ClauseRef, Options),
  937        clause(Head, Body, ClauseRef),
  938        make_clause(Head, Body, Clause),
  939        forall(clause_identifier_atom(Clause, Atom),
  940               note_confusable_atom(Atom, ClauseRef, Clause)),
  941        fail
  942    ;   true
  943    ).
  944
  945%   Enumerate every atom appearing in Clause whose written form is an
  946%   unquoted **identifier** atom (starts with a Prolog atom-start
  947%   char, doesn't need quotes).  Symbolic atoms (`=`, `+`, etc.) are
  948%   not candidates for spoofing.  sub_term/2 walks the term
  949%   structure; we also yield the functor name of every compound
  950%   subterm, since sub_term/2 itself does not visit functors.
  951clause_identifier_atom(Clause, Atom) :-
  952    sub_term(Sub, Clause),
  953    (   atom(Sub)
  954    ->  Atom = Sub
  955    ;   compound(Sub),
  956        compound_name_arity(Sub, Atom, _)
  957    ),
  958    atom_identifier_form(Atom).
  959
  960atom_identifier_form(Atom) :-
  961    \+ '$needs_quotes'(Atom),
  962    sub_atom(Atom, 0, 1, _, Start),
  963    char_type(Start, prolog_atom_start).
  964
  965note_confusable_atom(Atom, ClauseRef, Clause) :-
  966    (   seen_confusable_atom(Atom, _, _)
  967    ->  true
  968    ;   message_context(ClauseRef, Atom, Clause, Context),
  969        unicode_skeleton(Atom, Skel),
  970        assertz(seen_confusable_atom(Atom, Skel, Context))
  971    ).
  972
  973report_mixed_script_atoms :-
  974    forall(( seen_confusable_atom(Atom, _, Context),
  975             unicode_restriction_level(Atom, Level),
  976             \+ safe_restriction_level(Level) ),
  977           print_message(warning,
  978                         check(mixed_script_identifier(Atom, Level, Context)))).
  979
  980safe_restriction_level(ascii_only).
  981safe_restriction_level(single_script).
  982
  983report_confusable_collisions :-
  984    findall(Skel-(Atom-Context),
  985            seen_confusable_atom(Atom, Skel, Context),
  986            Pairs0),
  987    keysort(Pairs0, Pairs),
  988    group_pairs_by_key(Pairs, Grouped),
  989    forall(member(Skel-Members, Grouped),
  990           report_collision_group(Skel, Members)).
  991
  992report_collision_group(Skel, Members) :-
  993    pairs_keys(Members, As),
  994    sort(As, [_,_|_]),
  995    !,
  996    print_message(warning,
  997                  check(confusable_identifier_collision(Skel, Members))).
  998report_collision_group(_, _).
  999
 1000prolog:message(check(mixed_script_identifier(Atom, Level, Context))) -->
 1001    '$messages':swi_location(Context),
 1002    [ 'Mixed-script identifier ~q (~w)'-[Atom, Level] ].
 1003
 1004prolog:message(check(confusable_identifier_collision(Skel, Members))) -->
 1005    [ 'Distinct identifiers with the same UTS #39 skeleton ~q:'-[Skel],
 1006      nl
 1007    ],
 1008    confusable_collision_members(Members).
 1009
 1010confusable_collision_members([]) --> [].
 1011confusable_collision_members([Atom-Context | T]) -->
 1012    [ '    '-[] ],
 1013    '$messages':swi_location(Context),
 1014    [ '~q'-[Atom], nl ],
 1015    confusable_collision_members(T).
 1016
 1017:- endif. 1018
 1019
 1020                 /*******************************
 1021                 *            MESSAGES          *
 1022                 *******************************/
 1023
 1024:- multifile
 1025    prolog:message/3. 1026
 1027prolog:message(check(pass(Comment))) -->
 1028    [ 'Checking ~w ...'-[Comment] ].
 1029prolog:message(check(find_references(Preds))) -->
 1030    { length(Preds, N)
 1031    },
 1032    [ 'Scanning for references to ~D possibly undefined predicates'-[N] ].
 1033prolog:message(check(undefined_procedures, Grouped)) -->
 1034    [ 'The predicates below are not defined. If these are defined', nl,
 1035      'at runtime using assert/1, use :- dynamic Name/Arity.', nl, nl
 1036    ],
 1037    undefined_procedures(Grouped).
 1038prolog:message(check(undefined_unreferenced_predicates)) -->
 1039    [ 'The predicates below are not defined, and are not', nl,
 1040      'referenced.', nl, nl
 1041    ].
 1042prolog:message(check(undefined_unreferenced(Pred))) -->
 1043    predicate(Pred).
 1044prolog:message(check(autoload(Module, Pairs))) -->
 1045    { module_property(Module, file(Path))
 1046    },
 1047    !,
 1048    [ 'Into module ~w ('-[Module] ],
 1049    short_filename(Path),
 1050    [ ')', nl ],
 1051    autoload(Pairs).
 1052prolog:message(check(autoload(Module, Pairs))) -->
 1053    [ 'Into module ~w'-[Module], nl ],
 1054    autoload(Pairs).
 1055prolog:message(check(redefined(In, From, Pred))) -->
 1056    predicate(In:Pred),
 1057    redefined(In, From).
 1058prolog:message(check(cross_module_calls)) -->
 1059    [ 'Qualified calls to private predicates'-[] ].
 1060prolog:message(check(cross_module_call(Callee, _Caller, Location))) -->
 1061    { pi_head(PI, Callee) },
 1062    [ '  '-[] ],
 1063    '$messages':swi_location(Location),
 1064    [ 'Cross-module call to ~p'-[PI] ].
 1065prolog:message(check(trivial_failures)) -->
 1066    [ 'The following goals fail because there are no matching clauses.' ].
 1067prolog:message(check(trivial_failure(Goal, Refs))) -->
 1068    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
 1069      keysort(Keyed, KeySorted),
 1070      pairs_values(KeySorted, SortedRefs)
 1071    },
 1072    goal(Goal),
 1073    [ ', which is called from'-[], nl ],
 1074    referenced_by(SortedRefs).
 1075prolog:message(check(string_in_clause(String, Context))) -->
 1076    '$messages':swi_location(Context),
 1077    [ 'String ~q'-[String] ].
 1078prolog:message(check(rational_in_clause(String, Context))) -->
 1079    '$messages':swi_location(Context),
 1080    [ 'Rational ~q'-[String] ].
 1081prolog:message(check(Msg, Goal, Context)) -->
 1082    '$messages':swi_location(Context),
 1083    { pi_head(PI, Goal) },
 1084    [ nl, '    '-[] ],
 1085    predicate(PI),
 1086    [ ': '-[] ],
 1087    check_message(Msg).
 1088prolog:message(check(void_declaration(P, Decl))) -->
 1089    predicate(P),
 1090    [ ' is declared with ', ansi(code, '~p', [Decl]), ' but has no clauses' ].
 1091
 1092undefined_procedures([]) -->
 1093    [].
 1094undefined_procedures([H|T]) -->
 1095    undefined_procedure(H),
 1096    undefined_procedures(T).
 1097
 1098undefined_procedure(Pred-Refs) -->
 1099    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
 1100      keysort(Keyed, KeySorted),
 1101      pairs_values(KeySorted, SortedRefs)
 1102    },
 1103    predicate(Pred),
 1104    [ ', which is referenced by', nl ],
 1105    referenced_by(SortedRefs).
 1106
 1107redefined(user, system) -->
 1108    [ '~t~30| System predicate redefined globally' ].
 1109redefined(_, system) -->
 1110    [ '~t~30| Redefined system predicate' ].
 1111redefined(_, user) -->
 1112    [ '~t~30| Redefined global predicate' ].
 1113
 1114goal(user:Goal) -->
 1115    !,
 1116    [ '~p'-[Goal] ].
 1117goal(Goal) -->
 1118    !,
 1119    [ '~p'-[Goal] ].
 1120
 1121predicate(Module:Name/Arity) -->
 1122    { atom(Module),
 1123      atom(Name),
 1124      integer(Arity),
 1125      functor(Head, Name, Arity),
 1126      predicate_name(Module:Head, PName)
 1127    },
 1128    !,
 1129    [ ansi(code, '~w', [PName]) ].
 1130predicate(Module:Head) -->
 1131    { atom(Module),
 1132      callable(Head),
 1133      predicate_name(Module:Head, PName)
 1134    },
 1135    !,
 1136    [ ansi(code, '~w', [PName]) ].
 1137predicate(Name/Arity) -->
 1138    { atom(Name),
 1139      integer(Arity)
 1140    },
 1141    !,
 1142    predicate(user:Name/Arity).
 1143
 1144autoload([]) -->
 1145    [].
 1146autoload([Lib-Pred|T]) -->
 1147    [ '    ' ],
 1148    predicate(Pred),
 1149    [ '~t~24| from ' ],
 1150    short_filename(Lib),
 1151    [ nl ],
 1152    autoload(T).
 1153
 1154%!  sort_reference_key(+Reference, -Key) is det.
 1155%
 1156%   Create a stable key for sorting references to predicates.
 1157
 1158sort_reference_key(Term, key(M:Name/Arity, N, ClausePos)) :-
 1159    clause_ref(Term, ClauseRef, ClausePos),
 1160    !,
 1161    nth_clause(Pred, N, ClauseRef),
 1162    strip_module(Pred, M, Head),
 1163    functor(Head, Name, Arity).
 1164sort_reference_key(Term, Term).
 1165
 1166clause_ref(clause_term_position(ClauseRef, TermPos), ClauseRef, ClausePos) :-
 1167    arg(1, TermPos, ClausePos).
 1168clause_ref(clause(ClauseRef), ClauseRef, 0).
 1169
 1170
 1171referenced_by([]) -->
 1172    [].
 1173referenced_by([Ref|T]) -->
 1174    ['\t'], prolog:message_location(Ref),
 1175            predicate_indicator(Ref),
 1176    [ nl ],
 1177    referenced_by(T).
 1178
 1179predicate_indicator(clause_term_position(ClauseRef, _)) -->
 1180    { nonvar(ClauseRef) },
 1181    !,
 1182    predicate_indicator(clause(ClauseRef)).
 1183predicate_indicator(clause(ClauseRef)) -->
 1184    { clause_name(ClauseRef, Name) },
 1185    [ '~w'-[Name] ].
 1186predicate_indicator(file_term_position(_,_)) -->
 1187    [ '(initialization)' ].
 1188predicate_indicator(file(_,_,_,_)) -->
 1189    [ '(initialization)' ].
 1190
 1191
 1192short_filename(Path) -->
 1193    { short_filename(Path, Spec)
 1194    },
 1195    [ '~q'-[Spec] ].
 1196
 1197short_filename(Path, Spec) :-
 1198    absolute_file_name('', Here),
 1199    atom_concat(Here, Local0, Path),
 1200    !,
 1201    remove_leading_slash(Local0, Spec).
 1202short_filename(Path, Spec) :-
 1203    findall(LenAlias, aliased_path(Path, LenAlias), Keyed),
 1204    keysort(Keyed, [_-Spec|_]).
 1205short_filename(Path, Path).
 1206
 1207aliased_path(Path, Len-Spec) :-
 1208    setof(Alias, Spec^(user:file_search_path(Alias, Spec)), Aliases),
 1209    member(Alias, Aliases),
 1210    Term =.. [Alias, '.'],
 1211    absolute_file_name(Term,
 1212                       [ file_type(directory),
 1213                         file_errors(fail),
 1214                         solutions(all)
 1215                       ], Prefix),
 1216    atom_concat(Prefix, Local0, Path),
 1217    remove_leading_slash(Local0, Local),
 1218    atom_length(Local, Len),
 1219    Spec =.. [Alias, Local].
 1220
 1221remove_leading_slash(Path, Local) :-
 1222    atom_concat(/, Local, Path),
 1223    !.
 1224remove_leading_slash(Path, Path).
 1225
 1226check_message(format_argc(Expected, InList)) -->
 1227    [ 'Template requires ~w arguments, got ~w'-[Expected, InList] ].
 1228check_message(format_template(Formal)) -->
 1229    { message_to_string(error(Formal, _), Msg) },
 1230    [ 'Invalid template: ~s'-[Msg] ].
 1231check_message(format_argv(Args)) -->
 1232    [ 'Arguments are not in a list (deprecated): ~p'-[Args] ]