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