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