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