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