1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (c)  2006-2026, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(prolog_xref,
   39          [ xref_source/1,              % +Source
   40            xref_source/2,              % +Source, +Options
   41            xref_called/3,              % ?Source, ?Callable, ?By
   42            xref_called/4,              % ?Source, ?Callable, ?By, ?Cond
   43            xref_called/5,              % ?Source, ?Callable, ?By, ?Cond, ?Line
   44            xref_defined/3,             % ?Source. ?Callable, -How
   45            xref_definition_line/2,     % +How, -Line
   46            xref_exported/2,            % ?Source, ?Callable
   47            xref_module/2,              % ?Source, ?Module
   48            xref_uses_file/3,           % ?Source, ?Spec, ?Path
   49            xref_op/2,                  % ?Source, ?Op
   50            xref_prolog_flag/4,         % ?Source, ?Flag, ?Value, ?Line
   51            xref_comment/3,             % ?Source, ?Title, ?Comment
   52            xref_comment/4,             % ?Source, ?Head, ?Summary, ?Comment
   53            xref_object_comment/4,      % ?Source, ?Object, ?Summary, ?Comment
   54            xref_object_signature/3,    % ?Source, ?Object, ?Signature
   55            xref_mode/3,                % ?Source, ?Mode, ?Det
   56            xref_option/2,              % ?Source, ?Option
   57            xref_clean/1,               % +Source
   58            xref_current_source/1,      % ?Source
   59            xref_done/2,                % +Source, -When
   60            xref_built_in/1,            % ?Callable
   61            xref_source_file/3,         % +Spec, -Path, +Source
   62            xref_source_file/4,         % +Spec, -Path, +Source, +Options
   63            xref_public_list/3,         % +File, +Src, +Options
   64            xref_public_list/4,         % +File, -Path, -Export, +Src
   65            xref_public_list/6,         % +File, -Path, -Module, -Export, -Meta, +Src
   66            xref_public_list/7,         % +File, -Path, -Module, -Export, -Public, -Meta, +Src
   67            xref_meta/3,                % +Source, +Goal, -Called
   68            xref_meta/2,                % +Goal, -Called
   69            xref_hook/1,                % ?Callable
   70                                        % XPCE class references
   71            xref_used_class/2,          % ?Source, ?ClassName
   72            xref_defined_class/3        % ?Source, ?ClassName, -How
   73          ]).   74:- autoload(library(apply),[maplist/2,partition/4,maplist/3]).   75:- use_module(library(debug),[debug/3]).   76:- autoload(library(dialect),[expects_dialect/1]).   77:- autoload(library(error),[must_be/2,instantiation_error/1]).   78:- autoload(library(lists),[member/2,append/2,append/3,select/3]).   79:- autoload(library(operators),[push_op/3]).   80:- autoload(library(option),[option/2,option/3]).   81:- autoload(library(ordsets),[ord_intersect/2,ord_intersection/3]).   82:- autoload(library(prolog_code), [pi_head/2]).   83:- autoload(library(prolog_source),
   84	    [ prolog_canonical_source/2,
   85	      prolog_open_source/2,
   86	      prolog_close_source/1,
   87	      prolog_read_source_term/4,
   88              prolog_file_directives/3
   89	    ]).   90
   91:- if(exists_source(library(shlib))).   92:- autoload(library(shlib),[current_foreign_library/2]).   93:- endif.   94:- autoload(library(solution_sequences),[distinct/2,limit/2]).   95
   96:- if(exists_source(library(pldoc))).   97:- use_module(library(pldoc), []).      % Must be loaded before doc_process
   98:- use_module(library(pldoc/doc_process)).   99
  100:- endif.  101
  102:- predicate_options(xref_source/2, 2,
  103                     [ silent(boolean),
  104                       module(atom),
  105                       register_called(oneof([all,non_iso,non_built_in])),
  106                       comments(oneof([store,collect,ignore])),
  107                       process_include(boolean),
  108                       stream(stream)
  109                     ]).  110
  111
  112:- dynamic
  113    called/5,                       % Head, Src, From, Cond, Line
  114    (dynamic)/3,                    % Head, Src, Line
  115    (thread_local)/3,               % Head, Src, Line
  116    (multifile)/3,                  % Head, Src, Line
  117    (public)/3,                     % Head, Src, Line
  118    (declared)/4,	            % Head, How, Src, Line
  119    defined/3,                      % Head, Src, Line
  120    meta_goal/3,                    % Head, Called, Src
  121    foreign/3,                      % Head, Src, Line
  122    constraint/3,                   % Head, Src, Line
  123    imported/3,                     % Head, Src, From
  124    exported/2,                     % Head, Src
  125    xmodule/2,                      % Module, Src
  126    uses_file/3,                    % Spec, Src, Path
  127    xop/2,                          % Src, Op
  128    source/2,                       % Src, Time
  129    used_class/2,                   % Name, Src
  130    defined_class/5,                % Name, Super, Summary, Src, Line
  131    (mode)/2,                       % Mode, Src
  132    xoption/2,                      % Src, Option
  133    xflag/4,                        % Name, Value, Src, Line
  134    grammar_rule/2,                 % Head, Src
  135    module_comment/3,               % Src, Title, Comment
  136    pred_comment/4,                 % Head, Src, Summary, Comment
  137    pred_comment_link/3,            % Head, Src, HeadTo
  138    pred_mode/3,                    % Head, Src, Det
  139    object_comment/4,               % Object, Src, Summary, Comment
  140    object_signature/3.             % Object, Src, Signature
  141
  142:- create_prolog_flag(xref, false, [type(boolean)]).  143
  144/** <module> Prolog cross-referencer data collection
  145
  146This library collects information on defined and used objects in Prolog
  147source files. Typically these are predicates, but we expect the library
  148to deal with other types of objects in the future. The library is a
  149building block for tools doing dependency tracking in applications.
  150Dependency tracking is useful to reveal the structure of an unknown
  151program or detect missing components at compile time, but also for
  152program transformation or minimising a program saved state by only
  153saving the reachable objects.
  154
  155The library is exploited by two graphical tools in the SWI-Prolog
  156environment: the XPCE front-end started by gxref/0, and
  157library(prolog_colour), which exploits this library for its syntax
  158highlighting.
  159
  160For all predicates described below, `Source` is the source that is
  161processed. This is normally a filename in any notation acceptable to the
  162file loading predicates (see load_files/2). Input handling is done by
  163the library(prolog_source), which may be hooked to process any source
  164that can be translated into a Prolog stream holding Prolog source text.
  165`Callable` is a callable term (see callable/1). Callables do not
  166carry a module qualifier unless the referred predicate is not in the
  167module defined by `Source`.
  168
  169@bug    meta_predicate/1 declarations take the module into consideration.
  170        Predicates that are both available as meta-predicate and normal
  171        (in different modules) are handled as meta-predicate in all
  172        places.
  173@see	Where this library analyses _source text_, library(prolog_codewalk)
  174	may be used to analyse _loaded code_.  The library(check) exploits
  175        library(prolog_codewalk) to report on e.g., undefined
  176        predicates.
  177*/
  178
  179:- predicate_options(xref_source_file/4, 4,
  180                     [ file_type(oneof([txt,prolog,directory])),
  181                       silent(boolean)
  182                     ]).  183:- predicate_options(xref_public_list/3, 3,
  184                     [ path(-atom),
  185                       module(-atom),
  186                       exports(-list(any)),
  187                       public(-list(any)),
  188                       meta(-list(any)),
  189                       silent(boolean)
  190                     ]).  191
  192
  193                 /*******************************
  194                 *            HOOKS             *
  195                 *******************************/
  196
  197%!  prolog:called_by(+Goal, +Module, +Context, -Called) is semidet.
  198%
  199%   True when Called is a list of callable terms called from Goal,
  200%   handled by the predicate Module:Goal and executed in the context
  201%   of the module Context.  Elements of Called may be qualified.  If
  202%   not, they are called in the context of the module Context.
  203
  204%!  prolog:called_by(+Goal, -ListOfCalled)
  205%
  206%   If this succeeds, the cross-referencer assumes Goal may call any
  207%   of the goals in  ListOfCalled.  If   this  call  fails,  default
  208%   meta-goal analysis is used to determine additional called goals.
  209%
  210%   @deprecated     New code should use prolog:called_by/4
  211
  212%!  prolog:meta_goal(+Goal, -Pattern)
  213%
  214%   Define meta-predicates. See  the  examples   in  this  file  for
  215%   details.
  216
  217%!  prolog:hook(Goal)
  218%
  219%   True if Goal is a hook that  is called spontaneously (e.g., from
  220%   foreign code).
  221
  222:- multifile
  223    prolog:called_by/4,             % +Goal, +Module, +Context, -Called
  224    prolog:called_by/2,             % +Goal, -Called
  225    prolog:meta_goal/2,             % +Goal, -Pattern
  226    prolog:hook/1,                  % +Callable
  227    prolog:generated_predicate/1,   % :PI
  228    prolog:no_autoload_module/1,    % Module is not suitable for autoloading.
  229    prolog:xref_source_time/2.      % +Source, =Modified
  230
  231:- meta_predicate
  232    prolog:generated_predicate(:).  233
  234:- meta_predicate
  235    process_predicates(2, +, +).  236
  237                 /*******************************
  238                 *           BUILT-INS          *
  239                 *******************************/
  240
  241%!  hide_called(:Callable, +Src) is semidet.
  242%
  243%   True when the cross-referencer should   not  include Callable as
  244%   being   called.   This   is    determined     by    the   option
  245%   `register_called`.
  246
  247hide_called(Callable, Src) :-
  248    xoption(Src, register_called(Which)),
  249    !,
  250    mode_hide_called(Which, Callable).
  251hide_called(Callable, _) :-
  252    mode_hide_called(non_built_in, Callable).
  253
  254mode_hide_called(all, _) :- !, fail.
  255mode_hide_called(non_iso, _:Goal) :-
  256    goal_name_arity(Goal, Name, Arity),
  257    current_predicate(system:Name/Arity),
  258    predicate_property(system:Goal, iso).
  259mode_hide_called(non_built_in, _:Goal) :-
  260    goal_name_arity(Goal, Name, Arity),
  261    current_predicate(system:Name/Arity),
  262    predicate_property(system:Goal, built_in).
  263mode_hide_called(non_built_in, M:Goal) :-
  264    goal_name_arity(Goal, Name, Arity),
  265    current_predicate(M:Name/Arity),
  266    predicate_property(M:Goal, built_in).
  267
  268%!  built_in_predicate(+Callable)
  269%
  270%   True if Callable is a built-in
  271
  272system_predicate(Goal) :-
  273    goal_name_arity(Goal, Name, Arity),
  274    current_predicate(system:Name/Arity),   % avoid autoloading
  275    predicate_property(system:Goal, built_in),
  276    !.
  277
  278
  279                /********************************
  280                *            TOPLEVEL           *
  281                ********************************/
  282
  283verbose(Src) :-
  284    \+ xoption(Src, silent(true)).
  285
  286:- thread_local
  287    xref_input/2.                   % File, Stream
  288
  289
  290%!  xref_source(+Source) is det.
  291%!  xref_source(+Source, +Options) is det.
  292%
  293%   Generate the cross-reference data  for   Source  if  not already
  294%   done and the source is not modified.  Checking for modifications
  295%   is only done for files.  Options processed:
  296%
  297%     - silent(+Boolean)
  298%       If `true` (default `false`), emit warning messages.
  299%     - module(+Module)
  300%       Define the initial context module to work in.
  301%     - register_called(+Which)
  302%       Determines which calls are registerd.  Which is one of
  303%       `all`, `non_iso` or `non_built_in` (default).
  304%     - comments(+CommentHandling)
  305%       How to handle comments. If `store`, comments are stored into the
  306%       database as if the file was compiled. If `collect`, comments are
  307%       entered  to  the  xref  database   and  made  available  through
  308%       xref_mode/2 and xref_comment/4. If `ignore`, comments are simply
  309%       ignored. Default is to `collect` comments.
  310%     - process_include(+Boolean)
  311%       Process the content of included files (default is `true`).
  312%     - stream(+Stream)
  313%       Process the input from Stream rather than opening Source.
  314%
  315%   @arg Source   File specification or XPCE buffer
  316
  317xref_source(Source) :-
  318    xref_source(Source, []).
  319
  320xref_source(Source, Options) :-
  321    prolog_canonical_source(Source, Src),
  322    (   last_modified(Source, Modified)
  323    ->  (   source(Src, Modified)
  324        ->  true
  325        ;   xref_clean(Src),
  326            assert(source(Src, Modified)),
  327            do_xref(Src, Options)
  328        )
  329    ;   xref_clean(Src),
  330        get_time(Now),
  331        assert(source(Src, Now)),
  332        do_xref(Src, Options)
  333    ).
  334
  335do_xref(Src, Options) :-
  336    must_be(list, Options),
  337    setup_call_cleanup(
  338        xref_setup(Src, In, Options, State),
  339        collect(Src, Src, In, Options),
  340        xref_cleanup(State)).
  341
  342last_modified(Source, Modified) :-
  343    prolog:xref_source_time(Source, Modified),
  344    !.
  345last_modified(Source, Modified) :-
  346    atom(Source),
  347    \+ is_global_url(Source),
  348    exists_file(Source),
  349    time_file(Source, Modified).
  350
  351is_global_url(File) :-
  352    sub_atom(File, B, _, _, '://'),
  353    !,
  354    B > 1,
  355    sub_atom(File, 0, B, _, Scheme),
  356    atom_codes(Scheme, Codes),
  357    maplist(between(0'a, 0'z), Codes).
  358
  359xref_setup(Src, In, Options, state(CleanIn, Dialect, Xref, [SRef|HRefs])) :-
  360    maplist(assert_option(Src), Options),
  361    assert_default_options(Src),
  362    current_prolog_flag(emulated_dialect, Dialect),
  363    (   option(stream(Stream), Options)
  364    ->  In = Stream,
  365        CleanIn = true
  366    ;   prolog_open_source(Src, In),
  367        CleanIn = prolog_close_source(In)
  368    ),
  369    set_initial_mode(In, Options),
  370    asserta(xref_input(Src, In), SRef),
  371    set_xref(Xref),
  372    (   verbose(Src)
  373    ->  HRefs = []
  374    ;   asserta((user:thread_message_hook(_,Level,_) :-
  375                     hide_message(Level)),
  376                Ref),
  377        HRefs = [Ref]
  378    ).
  379
  380hide_message(warning).
  381hide_message(error).
  382hide_message(informational).
  383
  384assert_option(_, Var) :-
  385    var(Var),
  386    !,
  387    instantiation_error(Var).
  388assert_option(Src, silent(Boolean)) :-
  389    !,
  390    must_be(boolean, Boolean),
  391    assert(xoption(Src, silent(Boolean))).
  392assert_option(Src, register_called(Which)) :-
  393    !,
  394    must_be(oneof([all,non_iso,non_built_in]), Which),
  395    assert(xoption(Src, register_called(Which))).
  396assert_option(Src, comments(CommentHandling)) :-
  397    !,
  398    must_be(oneof([store,collect,ignore]), CommentHandling),
  399    assert(xoption(Src, comments(CommentHandling))).
  400assert_option(Src, module(Module)) :-
  401    !,
  402    must_be(atom, Module),
  403    assert(xoption(Src, module(Module))).
  404assert_option(Src, process_include(Boolean)) :-
  405    !,
  406    must_be(boolean, Boolean),
  407    assert(xoption(Src, process_include(Boolean))).
  408assert_option(_, _).
  409
  410assert_default_options(Src) :-
  411    (   xref_option_default(Opt),
  412        generalise_term(Opt, Gen),
  413        (   xoption(Src, Gen)
  414        ->  true
  415        ;   assertz(xoption(Src, Opt))
  416        ),
  417        fail
  418    ;   true
  419    ).
  420
  421xref_option_default(silent(false)).
  422xref_option_default(register_called(non_built_in)).
  423xref_option_default(comments(collect)).
  424xref_option_default(process_include(true)).
  425
  426%!  xref_cleanup(+State) is det.
  427%
  428%   Restore processing state according to the saved State.
  429
  430xref_cleanup(state(CleanIn, Dialect, Xref, Refs)) :-
  431    call(CleanIn),
  432    set_prolog_flag(emulated_dialect, Dialect),
  433    set_prolog_flag(xref, Xref),
  434    maplist(erase, Refs).
  435
  436set_xref(Xref) :-
  437    current_prolog_flag(xref, Xref),
  438    set_prolog_flag(xref, true).
  439
  440:- meta_predicate
  441    with_xref(0).  442
  443with_xref(Goal) :-
  444    setup_call_cleanup(
  445        push_prolog_flag(xref, true),
  446        Goal,
  447        pop_prolog_flag(xref)).
  448
  449
  450%!  set_initial_mode(+Stream, +Options) is det.
  451%
  452%   Set  the  initial  mode  for  processing    this   file  in  the
  453%   cross-referencer. If the file is loaded, we use information from
  454%   the previous load context, setting   the  appropriate module and
  455%   dialect.
  456
  457set_initial_mode(_Stream, Options) :-
  458    option(module(Module), Options),
  459    !,
  460    '$set_source_module'(Module).
  461set_initial_mode(Stream, _) :-
  462    stream_property(Stream, file_name(Path)),
  463    source_file_property(Path, load_context(M, _, Opts)),
  464    !,
  465    '$set_source_module'(M),
  466    (   option(dialect(Dialect), Opts)
  467    ->  expects_dialect(Dialect)
  468    ;   true
  469    ).
  470set_initial_mode(_, _) :-
  471    '$set_source_module'(user).
  472
  473%!  xref_input_stream(-Stream) is det.
  474%
  475%   Current input stream for cross-referencer.
  476
  477xref_input_stream(Stream) :-
  478    xref_input(_, Var),
  479    !,
  480    Stream = Var.
  481
  482%!  xref_push_op(Source, +Prec, +Type, :Name)
  483%
  484%   Define operators into the default source module and register
  485%   them to be undone by pop_operators/0.
  486
  487xref_push_op(Src, P, T, N0) :-
  488    '$current_source_module'(M0),
  489    strip_module(M0:N0, M, N),
  490    (   is_list(N),
  491        N \== []
  492    ->  maplist(push_op(Src, P, T, M), N)
  493    ;   push_op(Src, P, T, M, N)
  494    ).
  495
  496push_op(Src, P, T, M0, N0) :-
  497    strip_module(M0:N0, M, N),
  498    Name = M:N,
  499    valid_op(op(P,T,Name)),
  500    push_op(P, T, Name),
  501    assert_op(Src, op(P,T,Name)),
  502    debug(xref(op), ':- ~w.', [op(P,T,Name)]).
  503
  504valid_op(op(P,T,M:N)) :-
  505    atom(M),
  506    valid_op_name(N),
  507    integer(P),
  508    between(0, 1200, P),
  509    atom(T),
  510    op_type(T).
  511
  512valid_op_name(N) :-
  513    atom(N),
  514    !.
  515valid_op_name(N) :-
  516    N == [].
  517
  518op_type(xf).
  519op_type(yf).
  520op_type(fx).
  521op_type(fy).
  522op_type(xfx).
  523op_type(xfy).
  524op_type(yfx).
  525
  526%!  xref_set_prolog_flag(+Flag, +Value, +Src, +Line)
  527%
  528%   Called when a directive sets a Prolog flag.
  529
  530xref_set_prolog_flag(Flag, Value, Src, Line) :-
  531    atom(Flag),
  532    !,
  533    assertz(xflag(Flag, Value, Src, Line)).
  534xref_set_prolog_flag(_, _, _, _).
  535
  536%!  xref_clean(+Source) is det.
  537%
  538%   Reset the database for the given source.
  539
  540xref_clean(Source) :-
  541    prolog_canonical_source(Source, Src),
  542    retractall(called(_, Src, _Origin, _Cond, _Line)),
  543    retractall(dynamic(_, Src, Line)),
  544    retractall(multifile(_, Src, Line)),
  545    retractall(public(_, Src, Line)),
  546    retractall(declared(_, _, Src, Line)),
  547    retractall(defined(_, Src, Line)),
  548    retractall(meta_goal(_, _, Src)),
  549    retractall(foreign(_, Src, Line)),
  550    retractall(constraint(_, Src, Line)),
  551    retractall(imported(_, Src, _From)),
  552    retractall(exported(_, Src)),
  553    retractall(uses_file(_, Src, _)),
  554    retractall(xmodule(_, Src)),
  555    retractall(xop(Src, _)),
  556    retractall(grammar_rule(_, Src)),
  557    retractall(xoption(Src, _)),
  558    retractall(xflag(_Name, _Value, Src, Line)),
  559    retractall(source(Src, _)),
  560    retractall(used_class(_, Src)),
  561    retractall(defined_class(_, _, _, Src, _)),
  562    retractall(mode(_, Src)),
  563    retractall(module_comment(Src, _, _)),
  564    retractall(pred_comment(_, Src, _, _)),
  565    retractall(pred_comment_link(_, Src, _)),
  566    retractall(pred_mode(_, Src, _)),
  567    retractall(object_comment(_, Src, _, _)),
  568    retractall(object_signature(_, Src, _)).
  569
  570
  571                 /*******************************
  572                 *          READ RESULTS        *
  573                 *******************************/
  574
  575%!  xref_current_source(?Source)
  576%
  577%   Check what sources have been analysed.
  578
  579xref_current_source(Source) :-
  580    source(Source, _Time).
  581
  582
  583%!  xref_done(+Source, -Time) is det.
  584%
  585%   Cross-reference executed at Time
  586
  587xref_done(Source, Time) :-
  588    prolog_canonical_source(Source, Src),
  589    source(Src, Time).
  590
  591
  592%!  xref_called(?Source, ?Called, ?By) is nondet.
  593%!  xref_called(?Source, ?Called, ?By, ?Cond) is nondet.
  594%!  xref_called(?Source, ?Called, ?By, ?Cond, ?Line) is nondet.
  595%
  596%   True  when  By  is  called  from    Called   in  Source.  Note  that
  597%   xref_called/3  and  xref_called/4  use  distinct/2  to  return  only
  598%   distinct `Called-By` pairs. The  xref_called/5   version  may return
  599%   duplicate `Called-By` if Called is called   from multiple clauses in
  600%   By, but at most one call per clause.
  601%
  602%   @arg By is a head term or one of the reserved terms
  603%   `'<directive>'(Line)` or `'<public>'(Line)`, indicating the call
  604%   is from an (often initialization/1) directive or there is a public/1
  605%   directive that claims the predicate is called from in some
  606%   untractable way.
  607%   @arg Cond is the (accumulated) condition as defined by
  608%   ``:- if(Cond)`` under which the calling code is compiled.
  609%   @arg Line is the _start line_ of the calling clause.
  610
  611xref_called(Source, Called, By) :-
  612    xref_called(Source, Called, By, _).
  613
  614xref_called(Source, Called, By, Cond) :-
  615    canonical_source(Source, Src),
  616    distinct(Called-By, called(Called, Src, By, Cond, _)).
  617
  618xref_called(Source, Called, By, Cond, Line) :-
  619    canonical_source(Source, Src),
  620    called(Called, Src, By, Cond, Line).
  621
  622%!  xref_defined(?Source, +Goal, ?How) is nondet.
  623%
  624%   Test if Goal is accessible in Source.   If this is the case, How
  625%   specifies the reason why the predicate  is accessible. Note that
  626%   this predicate does not deal with built-in or global predicates,
  627%   just locally defined and imported ones.  How   is  one of of the
  628%   terms below. Location is one of Line (an integer) or File:Line
  629%   if the definition comes from an included (using :-
  630%   include(File)) directive.
  631%
  632%     * dynamic(Location)
  633%     * thread_local(Location)
  634%     * multifile(Location)
  635%     * public(Location)
  636%     * local(Location)
  637%     * foreign(Location)
  638%     * constraint(Location)
  639%     * imported(From)
  640%     * dcg
  641
  642xref_defined(Source, Called, How) :-
  643    nonvar(Source),
  644    !,
  645    canonical_source(Source, Src),
  646    xref_defined2(How, Src, Called).
  647xref_defined(Source, Called, How) :-
  648    xref_defined2(How, Src, Called),
  649    canonical_source(Source, Src).
  650
  651xref_defined2(dynamic(Line), Src, Called) :-
  652    dynamic(Called, Src, Line).
  653xref_defined2(thread_local(Line), Src, Called) :-
  654    thread_local(Called, Src, Line).
  655xref_defined2(multifile(Line), Src, Called) :-
  656    multifile(Called, Src, Line).
  657xref_defined2(public(Line), Src, Called) :-
  658    public(Called, Src, Line).
  659xref_defined2(local(Line), Src, Called) :-
  660    defined(Called, Src, Line).
  661xref_defined2(foreign(Line), Src, Called) :-
  662    foreign(Called, Src, Line).
  663xref_defined2(constraint(Line), Src, Called) :-
  664    (   constraint(Called, Src, Line)
  665    ->  true
  666    ;   declared(Called, chr_constraint, Src, Line)
  667    ).
  668xref_defined2(imported(From), Src, Called) :-
  669    imported(Called, Src, From).
  670xref_defined2(dcg, Src, Called) :-
  671    grammar_rule(Called, Src).
  672
  673
  674%!  xref_definition_line(+How, -Line)
  675%
  676%   If the 3th argument of xref_defined contains line info, return
  677%   this in Line.
  678
  679xref_definition_line(local(Line),        Line).
  680xref_definition_line(dynamic(Line),      Line).
  681xref_definition_line(thread_local(Line), Line).
  682xref_definition_line(multifile(Line),    Line).
  683xref_definition_line(public(Line),       Line).
  684xref_definition_line(constraint(Line),   Line).
  685xref_definition_line(foreign(Line),      Line).
  686
  687
  688%!  xref_exported(?Source, ?Head) is nondet.
  689%
  690%   True when Source exports Head.
  691
  692xref_exported(Source, Called) :-
  693    prolog_canonical_source(Source, Src),
  694    exported(Called, Src).
  695
  696%!  xref_module(?Source, ?Module) is nondet.
  697%
  698%   True if Module is defined in Source.
  699
  700xref_module(Source, Module) :-
  701    nonvar(Source),
  702    !,
  703    prolog_canonical_source(Source, Src),
  704    xmodule(Module, Src).
  705xref_module(Source, Module) :-
  706    xmodule(Module, Src),
  707    prolog_canonical_source(Source, Src).
  708
  709%!  xref_uses_file(?Source, ?Spec, ?Path) is nondet.
  710%
  711%   True when Source tries to load a file using Spec.
  712%
  713%   @param Spec is a specification for absolute_file_name/3
  714%   @param Path is either an absolute file name of the target
  715%          file or the atom =|<not_found>|=.
  716
  717xref_uses_file(Source, Spec, Path) :-
  718    prolog_canonical_source(Source, Src),
  719    uses_file(Spec, Src, Path).
  720
  721%!  xref_op(?Source, Op) is nondet.
  722%
  723%   Give the operators active inside the module. This is intended to
  724%   setup the environment for incremental parsing of a term from the
  725%   source-file.
  726%
  727%   @param Op       Term of the form op(Priority, Type, Name)
  728
  729xref_op(Source, Op) :-
  730    prolog_canonical_source(Source, Src),
  731    xop(Src, Op).
  732
  733%!  xref_prolog_flag(?Source, ?Flag, ?Value, ?Line) is nondet.
  734%
  735%   True when Flag is set  to  Value   at  Line  in  Source. This is
  736%   intended to support incremental  parsing  of   a  term  from the
  737%   source-file.
  738
  739xref_prolog_flag(Source, Flag, Value, Line) :-
  740    prolog_canonical_source(Source, Src),
  741    xflag(Flag, Value, Src, Line).
  742
  743xref_built_in(Head) :-
  744    system_predicate(Head).
  745
  746xref_used_class(Source, Class) :-
  747    prolog_canonical_source(Source, Src),
  748    used_class(Class, Src).
  749
  750xref_defined_class(Source, Class, local(Line, Super, Summary)) :-
  751    prolog_canonical_source(Source, Src),
  752    defined_class(Class, Super, Summary, Src, Line),
  753    integer(Line),
  754    !.
  755xref_defined_class(Source, Class, file(File)) :-
  756    prolog_canonical_source(Source, Src),
  757    defined_class(Class, _, _, Src, file(File)).
  758
  759:- thread_local
  760    current_cond/1,
  761    source_line/1,
  762    current_test_unit/2.  763
  764current_source_line(Line) :-
  765    source_line(Var),
  766    !,
  767    Line = Var.
  768
  769%!  collect(+Source, +File, +Stream, +Options)
  770%
  771%   Process data from Source. If File  \== Source, we are processing
  772%   an included file. Stream is the stream   from  which we read the
  773%   program.
  774
  775collect(Src, File, In, Options) :-
  776    (   Src == File
  777    ->  SrcSpec = Line
  778    ;   SrcSpec = (File:Line)
  779    ),
  780    (   current_prolog_flag(xref_store_comments, OldStore)
  781    ->  true
  782    ;   OldStore = false
  783    ),
  784    option(comments(CommentHandling), Options, collect),
  785    (   CommentHandling == ignore
  786    ->  CommentOptions = [],
  787        Comments = []
  788    ;   CommentHandling == store
  789    ->  CommentOptions = [ process_comment(true) ],
  790        Comments = [],
  791	set_prolog_flag(xref_store_comments, true)
  792    ;   CommentOptions = [ comments(Comments) ]
  793    ),
  794    repeat,
  795        E = error(_,_),
  796        catch(prolog_read_source_term(
  797                  In, Term, Expanded,
  798                  [ term_position(TermPos),
  799                    variable_names(VarNames)
  800                  | CommentOptions
  801                  ]),
  802              E, report_syntax_error(E, Src, [])),
  803        update_condition(Term),
  804        stream_position_data(line_count, TermPos, Line),
  805        setup_call_cleanup(
  806            asserta(source_line(SrcSpec), Ref),
  807            catch(process(Expanded, Comments, Term, VarNames, TermPos,
  808                          Src, EOF),
  809                  E, print_message(error, E)),
  810            erase(Ref)),
  811        EOF == true,
  812    !,
  813    set_prolog_flag(xref_store_comments, OldStore).
  814
  815report_syntax_error(_, _, Options) :-
  816    option(silent(true), Options),
  817    !,
  818    fail.
  819report_syntax_error(E, Src, _Options) :-
  820    (   verbose(Src)
  821    ->  print_message(error, E)
  822    ;   true
  823    ),
  824    fail.
  825
  826%!  update_condition(+Term) is det.
  827%
  828%   Update the condition under which the current code is compiled.
  829
  830update_condition((:-Directive)) :-
  831    !,
  832    update_cond(Directive).
  833update_condition(_).
  834
  835update_cond(if(Cond)) :-
  836    !,
  837    asserta(current_cond(Cond)).
  838update_cond(else) :-
  839    retract(current_cond(C0)),
  840    !,
  841    assert(current_cond(\+C0)).
  842update_cond(elif(Cond)) :-
  843    retract(current_cond(C0)),
  844    !,
  845    assert(current_cond((\+C0,Cond))).
  846update_cond(endif) :-
  847    retract(current_cond(_)),
  848    !.
  849update_cond(_).
  850
  851%!  current_condition(-Condition) is det.
  852%
  853%   Condition is the current compilation condition as defined by the
  854%   :- if/1 directive and friends.
  855
  856current_condition(Condition) :-
  857    \+ current_cond(_),
  858    !,
  859    Condition = true.
  860current_condition(Condition) :-
  861    findall(C, current_cond(C), List),
  862    list_to_conj(List, Condition).
  863
  864list_to_conj([], true).
  865list_to_conj([C], C) :- !.
  866list_to_conj([H|T], (H,C)) :-
  867    list_to_conj(T, C).
  868
  869
  870                 /*******************************
  871                 *           PROCESS            *
  872                 *******************************/
  873
  874%!  process(+Expanded, +Comments, +Term, +VarNames, +TermPos, +Src,
  875%!          -EOF) is det.
  876%
  877%   Process a source term that has  been   subject  to term expansion as
  878%   well as its optional leading structured comments.
  879%
  880%   @arg VarNames is a list Name=Var for the variables of Term.  It is
  881%   passed to the comment processing.
  882%   @arg TermPos is the term position that describes the start of the
  883%   term.  We need this to find _leading_ comments.
  884%   @arg EOF is unified with a boolean to indicate whether or not
  885%   processing was stopped because `end_of_file` was processed.
  886
  887process(Expanded, Comments, Term0, VarNames, TermPos, Src, EOF) :-
  888    is_list(Expanded),                          % term_expansion into list.
  889    !,
  890    (   member(Term, Expanded),
  891        process(Term, Term0, Src),
  892        Term == end_of_file
  893    ->  EOF = true
  894    ;   EOF = false
  895    ),
  896    xref_comments(Comments, TermPos, Term0, VarNames, Src).
  897process(end_of_file, _, _, _, _, _, true) :-
  898    !.
  899process(Term, Comments, Term0, VarNames, TermPos, Src, false) :-
  900    process(Term, Term0, Src),
  901    xref_comments(Comments, TermPos, Term0, VarNames, Src).
  902
  903%!  process(+Term, +Term0, +Src) is det.
  904
  905process(_, Term0, _) :-
  906    ignore_raw_term(Term0),
  907    !.
  908process(Head :- Body, Head0 --> _, Src) :-
  909    pi_head(F/A, Head),
  910    pi_head(F/A0, Head0),
  911    A =:= A0 + 2,
  912    !,
  913    assert_grammar_rule(Src, Head),
  914    process((Head :- Body), Src).
  915process(Term, _Term0, Src) :-
  916    process(Term, Src).
  917
  918ignore_raw_term((:- predicate_options(_,_,_))).
  919
  920%!  process(+Term, +Src) is det.
  921
  922process(Var, _) :-
  923    var(Var),
  924    !.                    % Warn?
  925process(end_of_file, _) :- !.
  926process((:- Directive), Src) :-
  927    !,
  928    process_directive(Directive, Src),
  929    !.
  930process((?- Directive), Src) :-
  931    !,
  932    process_directive(Directive, Src),
  933    !.
  934process((Head :- Body), Src) :-
  935    !,
  936    assert_defined(Src, Head),
  937    process_body(Body, Head, Src).
  938process((Left => Body), Src) :-
  939    !,
  940    (   nonvar(Left),
  941        Left = (Head, Guard)
  942    ->  assert_defined(Src, Head),
  943        process_body(Guard, Head, Src),
  944        process_body(Body, Head, Src)
  945    ;   assert_defined(Src, Left),
  946        process_body(Body, Left, Src)
  947    ).
  948process(?=>(Head, Body), Src) :-
  949    !,
  950    assert_defined(Src, Head),
  951    process_body(Body, Head, Src).
  952process('$source_location'(_File, _Line):Clause, Src) :-
  953    !,
  954    process(Clause, Src).
  955process(Term, Src) :-
  956    process_chr(Term, Src),
  957    !.
  958process(M:(Head :- Body), Src) :-
  959    !,
  960    process((M:Head :- M:Body), Src).
  961process(Head, Src) :-
  962    assert_defined(Src, Head).
  963
  964
  965                 /*******************************
  966                 *            COMMENTS          *
  967                 *******************************/
  968
  969%!  xref_comments(+Comments, +FilePos, +Term, +VarNames, +Src) is det.
  970%
  971%   Process the structured comments before Term.  The last comment
  972%   before Term is parsed with Term and VarNames, a list Name=Var for
  973%   the variables of Term.
  974
  975xref_comments([], _Pos, _Term, _VarNames, _Src).
  976:- if(current_predicate(parse_comment/5)).  977xref_comments([Pos-Comment|T], TermPos, Term, VarNames, Src) :-
  978    (   Pos @> TermPos              % comments inside term
  979    ->  true
  980    ;   stream_position_data(line_count, Pos, Line),
  981        FilePos = Src:Line,
  982        (   last_comment(T, TermPos)
  983        ->  CTerm = Term
  984        ;   true
  985        ),
  986        (   parse_comment(Comment, FilePos, CTerm, VarNames, Parsed)
  987        ->  assert_comments(Parsed, Src)
  988        ;   true
  989        ),
  990        xref_comments(T, TermPos, Term, VarNames, Src)
  991    ).
  992
  993last_comment([], _).
  994last_comment([Pos-_|_], TermPos) :-
  995    Pos @> TermPos.
  996
  997assert_comments([], _).
  998assert_comments([H|T], Src) :-
  999    assert_comment(H, Src),
 1000    assert_comments(T, Src).
 1001
 1002assert_comment(section(Id, Title, Comment), Src) :-
 1003    (   Id = module(_)
 1004    ->  assertz(module_comment(Src, Title, Comment))
 1005    ;   true
 1006    ).
 1007assert_comment(predicate(PI, Summary, Comment), Src) :-
 1008    pi_to_head(PI, Src, Head),
 1009    assertz(pred_comment(Head, Src, Summary, Comment)).
 1010assert_comment(link(PI, PITo), Src) :-
 1011    pi_to_head(PI, Src, Head),
 1012    pi_to_head(PITo, Src, HeadTo),
 1013    assertz(pred_comment_link(Head, Src, HeadTo)).
 1014assert_comment(mode(Head, Det), Src) :-
 1015    assertz(pred_mode(Head, Src, Det)).
 1016assert_comment(object(Object, Summary, Comment), Src) :-
 1017    assertz(object_comment(Object, Src, Summary, Comment)).
 1018assert_comment(signature(Object, Signature), Src) :-
 1019    assertz(object_signature(Object, Src, Signature)).
 1020
 1021pi_to_head(PI, Src, Head) :-
 1022    pi_to_head(PI, Head0),
 1023    (   Head0 = _:_
 1024    ->  strip_module(Head0, M, Plain),
 1025        (   xmodule(M, Src)
 1026        ->  Head = Plain
 1027        ;   Head = M:Plain
 1028        )
 1029    ;   Head = Head0
 1030    ).
 1031:- endif. 1032
 1033%!  xref_comment(?Source, ?Title, ?Comment) is nondet.
 1034%
 1035%   Is true when Source has a section comment with Title and Comment
 1036
 1037xref_comment(Source, Title, Comment) :-
 1038    canonical_source(Source, Src),
 1039    module_comment(Src, Title, Comment).
 1040
 1041%!  xref_comment(?Source, ?Head, ?Summary, ?Comment) is nondet.
 1042%
 1043%   Is true when Head in Source has the given PlDoc comment.
 1044
 1045xref_comment(Source, Head, Summary, Comment) :-
 1046    canonical_source(Source, Src),
 1047    (   pred_comment(Head, Src, Summary, Comment)
 1048    ;   pred_comment_link(Head, Src, HeadTo),
 1049        pred_comment(HeadTo, Src, Summary, Comment)
 1050    ).
 1051
 1052%!  xref_object_comment(?Source, ?Object, ?Summary, ?Comment) is nondet.
 1053%
 1054%   Is true when Object in Source has   the given PlDoc comment.  Such
 1055%   objects are created by the  hook prolog:doc_compile_comment/5,
 1056%   e.g., xpce(Class, Kind, Name) for the members of xpce classes.
 1057
 1058xref_object_comment(Source, Object, Summary, Comment) :-
 1059    canonical_source(Source, Src),
 1060    object_comment(Object, Src, Summary, Comment).
 1061
 1062%!  xref_object_signature(?Source, ?Object, ?Signature) is nondet.
 1063%
 1064%   Is true when Object in Source has Signature as provided by the
 1065%   hook prolog:doc_compile_comment/5.
 1066
 1067xref_object_signature(Source, Object, Signature) :-
 1068    canonical_source(Source, Src),
 1069    object_signature(Object, Src, Signature).
 1070
 1071%!  xref_mode(?Source, ?Mode, ?Det) is nondet.
 1072%
 1073%   Is  true  when  Source  provides  a   predicate  with  Mode  and
 1074%   determinism.
 1075
 1076xref_mode(Source, Mode, Det) :-
 1077    canonical_source(Source, Src),
 1078    pred_mode(Mode, Src, Det).
 1079
 1080%!  xref_option(?Source, ?Option) is nondet.
 1081%
 1082%   True when Source was processed using Option. Options are defined
 1083%   with xref_source/2.
 1084
 1085xref_option(Source, Option) :-
 1086    canonical_source(Source, Src),
 1087    xoption(Src, Option).
 1088
 1089
 1090                 /********************************
 1091                 *           DIRECTIVES         *
 1092                 ********************************/
 1093
 1094process_directive(Var, _) :-
 1095    var(Var),
 1096    !.                    % error, but that isn't our business
 1097process_directive(Dir, _Src) :-
 1098    debug(xref(directive), 'Processing :- ~q', [Dir]),
 1099    fail.
 1100process_directive((A,B), Src) :-       % TBD: what about other control
 1101    !,
 1102    process_directive(A, Src),      % structures?
 1103    process_directive(B, Src).
 1104process_directive(List, Src) :-
 1105    is_list(List),
 1106    !,
 1107    process_directive(consult(List), Src).
 1108process_directive(use_module(File, Import), Src) :-
 1109    process_use_module2(File, Import, Src, false).
 1110process_directive(autoload(File, Import), Src) :-
 1111    process_use_module2(File, Import, Src, false).
 1112process_directive(require(Import), Src) :-
 1113    process_requires(Import, Src).
 1114process_directive(expects_dialect(Dialect), Src) :-
 1115    process_directive(use_module(library(dialect/Dialect)), Src),
 1116    expects_dialect(Dialect).
 1117process_directive(reexport(File, Import), Src) :-
 1118    process_use_module2(File, Import, Src, true).
 1119process_directive(reexport(Modules), Src) :-
 1120    process_use_module(Modules, Src, true).
 1121process_directive(autoload(Modules), Src) :-
 1122    process_use_module(Modules, Src, false).
 1123process_directive(use_module(Modules), Src) :-
 1124    process_use_module(Modules, Src, false).
 1125process_directive(consult(Modules), Src) :-
 1126    process_use_module(Modules, Src, false).
 1127process_directive(ensure_loaded(Modules), Src) :-
 1128    process_use_module(Modules, Src, false).
 1129process_directive(load_files(Files, _Options), Src) :-
 1130    process_use_module(Files, Src, false).
 1131process_directive(include(Files), Src) :-
 1132    process_include(Files, Src).
 1133process_directive(dynamic(Dynamic), Src) :-
 1134    process_predicates(assert_dynamic, Dynamic, Src).
 1135process_directive(dynamic(Dynamic, _Options), Src) :-
 1136    process_predicates(assert_dynamic, Dynamic, Src).
 1137process_directive(thread_local(Dynamic), Src) :-
 1138    process_predicates(assert_thread_local, Dynamic, Src).
 1139process_directive(multifile(Dynamic), Src) :-
 1140    process_predicates(assert_multifile, Dynamic, Src).
 1141process_directive(public(Public), Src) :-
 1142    process_predicates(assert_public, Public, Src).
 1143process_directive(export(Export), Src) :-
 1144    process_predicates(assert_export, Export, Src).
 1145process_directive(import(Import), Src) :-
 1146    process_import(Import, Src).
 1147process_directive(module(Module, Export), Src) :-
 1148    assert_module(Src, Module),
 1149    assert_module_export(Src, Export).
 1150process_directive(module(Module, Export, Import), Src) :-
 1151    assert_module(Src, Module),
 1152    assert_module_export(Src, Export),
 1153    assert_module3(Import, Src).
 1154process_directive(begin_tests(Unit, _Options), Src) :-
 1155    enter_test_unit(Unit, Src).
 1156process_directive(begin_tests(Unit), Src) :-
 1157    enter_test_unit(Unit, Src).
 1158process_directive(end_tests(Unit), Src) :-
 1159    leave_test_unit(Unit, Src).
 1160process_directive('$set_source_module'(system), Src) :-
 1161    assert_module(Src, system).     % hack for handling boot/init.pl
 1162process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :-
 1163    assert_defined_class(Src, Name, Meta, Super, Doc).
 1164process_directive(pce_autoload(Name, From), Src) :-
 1165    assert_defined_class(Src, Name, imported_from(From)).
 1166
 1167process_directive(op(P, A, N), Src) :-
 1168    xref_push_op(Src, P, A, N).
 1169process_directive(set_prolog_flag(Flag, Value), Src) :-
 1170    (   Flag == character_escapes
 1171    ->  set_prolog_flag(character_escapes, Value)
 1172    ;   true
 1173    ),
 1174    current_source_line(Line),
 1175    xref_set_prolog_flag(Flag, Value, Src, Line).
 1176process_directive(style_check(X), _) :-
 1177    style_check(X).
 1178process_directive(encoding(Enc), _) :-
 1179    (   xref_input_stream(Stream)
 1180    ->  catch(set_stream(Stream, encoding(Enc)), error(_,_), true)
 1181    ;   true                        % can this happen?
 1182    ).
 1183process_directive(pce_expansion:push_compile_operators, _) :-
 1184    '$current_source_module'(SM),
 1185    call(pce_expansion:push_compile_operators(SM)). % call to avoid xref
 1186process_directive(pce_expansion:pop_compile_operators, _) :-
 1187    call(pce_expansion:pop_compile_operators).
 1188process_directive(meta_predicate(Meta), Src) :-
 1189    process_meta_predicate(Meta, Src).
 1190process_directive(arithmetic_function(FSpec), Src) :-
 1191    arith_callable(FSpec, Goal),
 1192    !,
 1193    current_source_line(Line),
 1194    assert_called(Src, '<directive>'(Line), Goal, Line).
 1195process_directive(format_predicate(_, Goal), Src) :-
 1196    !,
 1197    current_source_line(Line),
 1198    assert_called(Src, '<directive>'(Line), Goal, Line).
 1199process_directive(if(Cond), Src) :-
 1200    !,
 1201    current_source_line(Line),
 1202    assert_called(Src, '<directive>'(Line), Cond, Line).
 1203process_directive(elif(Cond), Src) :-
 1204    !,
 1205    current_source_line(Line),
 1206    assert_called(Src, '<directive>'(Line), Cond, Line).
 1207process_directive(else, _) :- !.
 1208process_directive(endif, _) :- !.
 1209process_directive(Goal, Src) :-
 1210    current_source_line(Line),
 1211    process_body(Goal, '<directive>'(Line), Src).
 1212
 1213%!  process_meta_predicate(+Decl, +Src)
 1214%
 1215%   Create meta_goal/3 facts from the meta-goal declaration.
 1216
 1217process_meta_predicate((A,B), Src) :-
 1218    !,
 1219    process_meta_predicate(A, Src),
 1220    process_meta_predicate(B, Src).
 1221process_meta_predicate(Decl, Src) :-
 1222    process_meta_head(Src, Decl).
 1223
 1224process_meta_head(Src, Decl) :-         % swapped arguments for maplist
 1225    compound(Decl),
 1226    compound_name_arity(Decl, Name, Arity),
 1227    compound_name_arity(Head, Name, Arity),
 1228    meta_args(1, Arity, Decl, Head, Meta),
 1229    (   (   prolog:meta_goal(Head, _)
 1230        ;   prolog:called_by(Head, _, _, _)
 1231        ;   prolog:called_by(Head, _)
 1232        ;   meta_goal(Head, Meta, _Src)
 1233        )
 1234    ->  true
 1235    ;   warn_late_meta_predicate(Decl, Src),
 1236        retractall(meta_goal(Head, _, Src)),
 1237        assert(meta_goal(Head, Meta, Src))
 1238    ).
 1239
 1240meta_args(I, Arity, _, _, []) :-
 1241    I > Arity,
 1242    !.
 1243meta_args(I, Arity, Decl, Head, [H|T]) :-               % 0
 1244    arg(I, Decl, 0),
 1245    !,
 1246    arg(I, Head, H),
 1247    I2 is I + 1,
 1248    meta_args(I2, Arity, Decl, Head, T).
 1249meta_args(I, Arity, Decl, Head, [H|T]) :-               % ^
 1250    arg(I, Decl, ^),
 1251    !,
 1252    arg(I, Head, EH),
 1253    setof_goal(EH, H),
 1254    I2 is I + 1,
 1255    meta_args(I2, Arity, Decl, Head, T).
 1256meta_args(I, Arity, Decl, Head, [//(H)|T]) :-
 1257    arg(I, Decl, //),
 1258    !,
 1259    arg(I, Head, H),
 1260    I2 is I + 1,
 1261    meta_args(I2, Arity, Decl, Head, T).
 1262meta_args(I, Arity, Decl, Head, [H+A|T]) :-             % I --> H+I
 1263    arg(I, Decl, A),
 1264    integer(A), A > 0,
 1265    !,
 1266    arg(I, Head, H),
 1267    I2 is I + 1,
 1268    meta_args(I2, Arity, Decl, Head, T).
 1269meta_args(I, Arity, Decl, Head, Meta) :-
 1270    I2 is I + 1,
 1271    meta_args(I2, Arity, Decl, Head, Meta).
 1272
 1273
 1274warn_late_meta_predicate(Decl, Src) :-
 1275    xref_called(Src, Decl, By),
 1276    !,
 1277    print_message(warning, meta_predicate_after_call(Decl, By)).
 1278warn_late_meta_predicate(_, _).
 1279
 1280
 1281              /********************************
 1282              *             BODY              *
 1283              ********************************/
 1284
 1285%!  xref_meta(+Source, +Head, -Called) is semidet.
 1286%
 1287%   True when Head calls Called in Source.
 1288%
 1289%   @arg    Called is a list of called terms, terms of the form
 1290%           Term+Extra or terms of the form //(Term).
 1291
 1292xref_meta(Source, Head, Called) :-
 1293    canonical_source(Source, Src),
 1294    xref_meta_src(Head, Called, Src).
 1295
 1296%!  xref_meta(+Head, -Called) is semidet.
 1297%!  xref_meta_src(+Head, -Called, +Src) is semidet.
 1298%
 1299%   True when Called is a  list  of   terms  called  from Head. Each
 1300%   element in Called can be of the  form Term+Int, which means that
 1301%   Term must be extended with Int additional arguments. The variant
 1302%   xref_meta/3 first queries the local context.
 1303%
 1304%   @tbd    Split predifined in several categories.  E.g., the ISO
 1305%           predicates cannot be redefined.
 1306%   @tbd    Rely on the meta_predicate property for many predicates.
 1307%   @deprecated     New code should use xref_meta/3.
 1308
 1309xref_meta_src(Head, Called, Src) :-
 1310    meta_goal(Head, Called, Src),
 1311    !.
 1312xref_meta_src(Head, Called, _) :-
 1313    xref_meta(Head, Called),
 1314    !.
 1315xref_meta_src(Head, Called, _) :-
 1316    compound(Head),
 1317    compound_name_arity(Head, Name, Arity),
 1318    apply_pred(Name),
 1319    Arity > 5,
 1320    !,
 1321    Extra is Arity - 1,
 1322    arg(1, Head, G),
 1323    Called = [G+Extra].
 1324xref_meta_src(Head, Called, _) :-
 1325    with_xref(predicate_property('$xref_tmp':Head, meta_predicate(Meta))),
 1326    !,
 1327    Meta =.. [_|Args],
 1328    meta_args(Args, 1, Head, Called).
 1329
 1330meta_args([], _, _, []).
 1331meta_args([H0|T0], I, Head, [H|T]) :-
 1332    xargs(H0, N),
 1333    !,
 1334    arg(I, Head, A),
 1335    (   N == 0
 1336    ->  H = A
 1337    ;   H = (A+N)
 1338    ),
 1339    I2 is I+1,
 1340    meta_args(T0, I2, Head, T).
 1341meta_args([_|T0], I, Head, T) :-
 1342    I2 is I+1,
 1343    meta_args(T0, I2, Head, T).
 1344
 1345xargs(N, N) :- integer(N), !.
 1346xargs(//, 2).
 1347xargs(^, 0).
 1348
 1349apply_pred(call).                               % built-in
 1350apply_pred(maplist).                            % library(apply_macros)
 1351
 1352xref_meta((A, B),               [A, B]).
 1353xref_meta((A; B),               [A, B]).
 1354xref_meta((A| B),               [A, B]).
 1355xref_meta((A -> B),             [A, B]).
 1356xref_meta((A *-> B),            [A, B]).
 1357xref_meta(findall(_V,G,_L),     [G]).
 1358xref_meta(findall(_V,G,_L,_T),  [G]).
 1359xref_meta(findnsols(_N,_V,G,_L),    [G]).
 1360xref_meta(findnsols(_N,_V,G,_L,_T), [G]).
 1361xref_meta(setof(_V, EG, _L),    [G]) :-
 1362    setof_goal(EG, G).
 1363xref_meta(bagof(_V, EG, _L),    [G]) :-
 1364    setof_goal(EG, G).
 1365xref_meta(aggregate(_V, EG, _L), [G]) :-
 1366    setof_goal(EG, G).
 1367xref_meta(aggregate(_V, _D, EG, _L), [G]) :-
 1368    setof_goal(EG, G).
 1369xref_meta(forall(A, B),         [A, B]).
 1370xref_meta(maplist(G,_),         [G+1]).
 1371xref_meta(maplist(G,_,_),       [G+2]).
 1372xref_meta(maplist(G,_,_,_),     [G+3]).
 1373xref_meta(maplist(G,_,_,_,_),   [G+4]).
 1374xref_meta(map_list_to_pairs(G,_,_), [G+2]).
 1375xref_meta(map_assoc(G, _),      [G+1]).
 1376xref_meta(map_assoc(G, _, _),   [G+2]).
 1377xref_meta(checklist(G, _L),     [G+1]).
 1378xref_meta(sublist(G, _, _),     [G+1]).
 1379xref_meta(include(G, _, _),     [G+1]).
 1380xref_meta(exclude(G, _, _),     [G+1]).
 1381xref_meta(partition(G, _, _, _, _),     [G+2]).
 1382xref_meta(partition(G, _, _, _),[G+1]).
 1383xref_meta(call(G),              [G]).
 1384xref_meta(call(G, _),           [G+1]).
 1385xref_meta(call(G, _, _),        [G+2]).
 1386xref_meta(call(G, _, _, _),     [G+3]).
 1387xref_meta(call(G, _, _, _, _),  [G+4]).
 1388xref_meta(not(G),               [G]).
 1389xref_meta(notrace(G),           [G]).
 1390xref_meta('$notrace'(G),        [G]).
 1391xref_meta(\+(G),                [G]).
 1392xref_meta(ignore(G),            [G]).
 1393xref_meta(once(G),              [G]).
 1394xref_meta(initialization(G),    [G]).
 1395xref_meta(initialization(G,_),  [G]).
 1396xref_meta(retract(Rule),        [G]) :- head_of(Rule, G).
 1397xref_meta(clause(G, _),         [G]).
 1398xref_meta(clause(G, _, _),      [G]).
 1399xref_meta(phrase(G, _A),        [//(G)]).
 1400xref_meta(phrase(G, _A, _R),    [//(G)]).
 1401xref_meta(call_dcg(G, _A, _R),  [//(G)]).
 1402xref_meta(phrase_from_file(G,_),[//(G)]).
 1403xref_meta(catch(A, _, B),       [A, B]).
 1404xref_meta(catch_with_backtrace(A, _, B), [A, B]).
 1405xref_meta(thread_create(A,_,_), [A]).
 1406xref_meta(thread_create(A,_),   [A]).
 1407xref_meta(thread_signal(_,A),   [A]).
 1408xref_meta(thread_idle(A,_),     [A]).
 1409xref_meta(thread_at_exit(A),    [A]).
 1410xref_meta(thread_initialization(A), [A]).
 1411xref_meta(engine_create(_,A,_), [A]).
 1412xref_meta(engine_create(_,A,_,_), [A]).
 1413xref_meta(transaction(A),       [A]).
 1414xref_meta(transaction(A,B,_),   [A,B]).
 1415xref_meta(snapshot(A),          [A]).
 1416xref_meta(predsort(A,_,_),      [A+3]).
 1417xref_meta(call_cleanup(A, B),   [A, B]).
 1418xref_meta(call_cleanup(A, _, B),[A, B]).
 1419xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
 1420xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
 1421xref_meta(call_residue_vars(A,_), [A]).
 1422xref_meta(with_mutex(_,A),      [A]).
 1423xref_meta(assume(G),            [G]).   % library(debug)
 1424xref_meta(assertion(G),         [G]).   % library(debug)
 1425xref_meta(freeze(_, G),         [G]).
 1426xref_meta(when(C, A),           [C, A]).
 1427xref_meta(time(G),              [G]).   % development system
 1428xref_meta(call_time(G, _),      [G]).   % development system
 1429xref_meta(call_time(G, _, _),   [G]).   % development system
 1430xref_meta(profile(G),           [G]).
 1431xref_meta(at_halt(G),           [G]).
 1432xref_meta(call_with_time_limit(_, G), [G]).
 1433xref_meta(call_with_depth_limit(G, _, _), [G]).
 1434xref_meta(call_with_inference_limit(G, _, _), [G]).
 1435xref_meta(alarm(_, G, _),       [G]).
 1436xref_meta(alarm(_, G, _, _),    [G]).
 1437xref_meta('$add_directive_wic'(G), [G]).
 1438xref_meta(with_output_to(_, G), [G]).
 1439xref_meta(if(G),                [G]).
 1440xref_meta(elif(G),              [G]).
 1441xref_meta(meta_options(G,_,_),  [G+1]).
 1442xref_meta(on_signal(_,_,H),     [H+1]) :- H \== default.
 1443xref_meta(distinct(G),          [G]).   % library(solution_sequences)
 1444xref_meta(distinct(_, G),       [G]).
 1445xref_meta(order_by(_, G),       [G]).
 1446xref_meta(limit(_, G),          [G]).
 1447xref_meta(offset(_, G),         [G]).
 1448xref_meta(reset(G,_,_),         [G]).
 1449xref_meta(prolog_listen(Ev,G),  [G+N]) :- event_xargs(Ev, N).
 1450xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N).
 1451xref_meta(tnot(G),		[G]).
 1452xref_meta(not_exists(G),	[G]).
 1453xref_meta(with_tty_raw(G),	[G]).
 1454xref_meta(residual_goals(G),    [G+2]).
 1455
 1456                                        % XPCE meta-predicates
 1457xref_meta(pce_global(_, new(_)), _) :- !, fail.
 1458xref_meta(pce_global(_, B),     [B+1]).
 1459xref_meta(ifmaintainer(G),      [G]).   % used in manual
 1460xref_meta(listen(_, G),         [G]).   % library(broadcast)
 1461xref_meta(listen(_, _, G),      [G]).
 1462xref_meta(in_pce_thread(G),     [G]).
 1463
 1464xref_meta(G, Meta) :-                   % call user extensions
 1465    prolog:meta_goal(G, Meta).
 1466xref_meta(G, Meta) :-                   % Generated from :- meta_predicate
 1467    meta_goal(G, Meta, _Src).
 1468
 1469setof_goal(EG, G) :-
 1470    var(EG), !, G = EG.
 1471setof_goal(_^EG, G) :-
 1472    !,
 1473    setof_goal(EG, G).
 1474setof_goal(G, G).
 1475
 1476event_xargs(abort,            0).
 1477event_xargs(erase,            1).
 1478event_xargs(break,            3).
 1479event_xargs(frame_finished,   1).
 1480event_xargs(thread_exit,      1).
 1481event_xargs(this_thread_exit, 0).
 1482event_xargs(PI,               2) :- pi_to_head(PI, _).
 1483
 1484%!  head_of(+Rule, -Head)
 1485%
 1486%   Get the head for a retract call.
 1487
 1488head_of(Var, _) :-
 1489    var(Var), !, fail.
 1490head_of((Head :- _), Head).
 1491head_of(Head, Head).
 1492
 1493%!  xref_hook(?Callable)
 1494%
 1495%   Definition of known hooks.  Hooks  that   can  be  called in any
 1496%   module are unqualified.  Other  hooks   are  qualified  with the
 1497%   module where they are called.
 1498
 1499xref_hook(Hook) :-
 1500    prolog:hook(Hook).
 1501xref_hook(Hook) :-
 1502    hook(Hook).
 1503
 1504
 1505hook(attr_portray_hook(_,_)).
 1506hook(attr_unify_hook(_,_)).
 1507hook(attribute_goals(_,_,_)).
 1508hook(goal_expansion(_,_)).
 1509hook(term_expansion(_,_)).
 1510hook(goal_expansion(_,_,_,_)).
 1511hook(term_expansion(_,_,_,_)).
 1512hook(resource(_,_,_)).
 1513hook('$pred_option'(_,_,_,_)).
 1514hook('$nowarn_autoload'(_,_)).
 1515
 1516hook(emacs_prolog_colours:goal_classification(_,_)).
 1517hook(emacs_prolog_colours:goal_colours(_,_)).
 1518hook(emacs_prolog_colours:identify(_,_)).
 1519hook(emacs_prolog_colours:style(_,_)).
 1520hook(emacs_prolog_colours:term_colours(_,_)).
 1521hook(pce_principal:get_implementation(_,_,_,_)).
 1522hook(pce_principal:pce_class(_,_,_,_,_,_)).
 1523hook(pce_principal:pce_lazy_get_method(_,_,_)).
 1524hook(pce_principal:pce_lazy_send_method(_,_,_)).
 1525hook(pce_principal:pce_uses_template(_,_)).
 1526hook(pce_principal:send_implementation(_,_,_)).
 1527hook(predicate_options:option_decl(_,_,_)).
 1528hook(prolog:debug_control_hook(_)).
 1529hook(prolog:error_message(_,_,_)).
 1530hook(prolog:expand_answer(_,_,_)).
 1531hook(prolog:general_exception(_,_)).
 1532hook(prolog:help_hook(_)).
 1533hook(prolog:locate_clauses(_,_)).
 1534hook(prolog:message(_,_,_)).
 1535hook(prolog:message_context(_,_,_)).
 1536hook(prolog:message_line_element(_,_)).
 1537hook(prolog:message_location(_,_,_)).
 1538hook(prolog:predicate_summary(_,_)).
 1539hook(prolog:prolog_exception_hook(_,_,_,_,_)).
 1540hook(prolog:residual_goals(_,_)).
 1541hook(prolog_edit:load).
 1542hook(prolog_edit:locate(_,_,_)).
 1543hook(sandbox:safe_directive(_)).
 1544hook(sandbox:safe_global_variable(_)).
 1545hook(sandbox:safe_meta(_,_)).
 1546hook(sandbox:safe_meta_predicate(_)).
 1547hook(sandbox:safe_primitive(_)).
 1548hook(sandbox:safe_prolog_flag(_,_)).
 1549hook(shlib:unload_all_foreign_libraries).
 1550hook(system:'$foreign_registered'(_, _)).
 1551hook(user:exception(_,_,_)).
 1552hook(user:expand_answer(_,_)).
 1553hook(user:expand_query(_,_,_,_)).
 1554hook(user:file_search_path(_,_)).
 1555hook(user:library_directory(_)).
 1556hook(user:message_hook(_,_,_)).
 1557hook(prolog:message_action(_,_)).
 1558hook(user:portray(_)).
 1559hook(user:prolog_clause_name(_,_)).
 1560hook(user:prolog_list_goal(_)).
 1561hook(user:prolog_predicate_name(_,_)).
 1562hook(user:prolog_trace_interception(_,_,_,_)).
 1563
 1564%!  arith_callable(+Spec, -Callable)
 1565%
 1566%   Translate argument of arithmetic_function/1 into a callable term
 1567
 1568arith_callable(Var, _) :-
 1569    var(Var), !, fail.
 1570arith_callable(Module:Spec, Module:Goal) :-
 1571    !,
 1572    arith_callable(Spec, Goal).
 1573arith_callable(Name/Arity, Goal) :-
 1574    PredArity is Arity + 1,
 1575    functor(Goal, Name, PredArity).
 1576
 1577%!  process_body(+Body, +Origin, +Src) is det.
 1578%
 1579%   Process a callable body (body of  a clause or directive). Origin
 1580%   describes the origin of the call. Partial evaluation may lead to
 1581%   non-determinism, which is why we backtrack over process_goal/3.
 1582%
 1583%   We limit the number of explored paths   to  100 to avoid getting
 1584%   trapped in this analysis.
 1585
 1586process_body(Body, Origin, Src) :-
 1587    forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
 1588           true).
 1589
 1590%!  process_goal(+Goal, +Origin, +Src, ?Partial) is multi.
 1591%
 1592%   Xref Goal. The argument Partial is bound   to  `true` if there was a
 1593%   partial evalation inside Goal that has bound variables.
 1594
 1595process_goal(Var, _, _, _) :-
 1596    var(Var),
 1597    !.
 1598process_goal(_:Goal, _, _, _) :-
 1599    var(Goal),
 1600    !.
 1601process_goal(Goal, Origin, Src, P) :-
 1602    Goal = (_,_),                               % problems
 1603    !,
 1604    phrase(conjunction(Goal), Goals),
 1605    process_conjunction(Goals, Origin, Src, P).
 1606process_goal(Goal, Origin, Src, _) :-           % Final disjunction, no
 1607    Goal = (_;_),                               % problems
 1608    !,
 1609    phrase(disjunction(Goal), Goals),
 1610    forall(member(G, Goals),
 1611           process_body(G, Origin, Src)).
 1612process_goal(Goal, Origin, Src, P) :-
 1613    (   (   xmodule(M, Src)
 1614        ->  true
 1615        ;   M = user
 1616        ),
 1617        pi_head(PI, M:Goal),
 1618        (   current_predicate(PI),
 1619            predicate_property(M:Goal, imported_from(IM))
 1620        ->  true
 1621        ;   PI = M:Name/Arity,
 1622            '$find_library'(M, Name, Arity, IM, _Library)
 1623        ->  true
 1624        ;   IM = M
 1625        ),
 1626        prolog:called_by(Goal, IM, M, Called)
 1627    ;   prolog:called_by(Goal, Called)
 1628    ),
 1629    !,
 1630    must_be(list, Called),
 1631    current_source_line(Here),
 1632    assert_called(Src, Origin, Goal, Here),
 1633    process_called_list(Called, Origin, Src, P).
 1634process_goal(Goal, Origin, Src, _) :-
 1635    process_xpce_goal(Goal, Origin, Src),
 1636    !.
 1637process_goal(load_foreign_library(File), _Origin, Src, _) :-
 1638    process_foreign(File, Src).
 1639process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :-
 1640    process_foreign(File, Src).
 1641process_goal(use_foreign_library(File), _Origin, Src, _) :-
 1642    process_foreign(File, Src).
 1643process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :-
 1644    process_foreign(File, Src).
 1645process_goal(Goal, Origin, Src, P) :-
 1646    xref_meta_src(Goal, Metas, Src),
 1647    !,
 1648    current_source_line(Here),
 1649    assert_called(Src, Origin, Goal, Here),
 1650    process_called_list(Metas, Origin, Src, P).
 1651process_goal(Goal, Origin, Src, _) :-
 1652    asserting_goal(Goal, Rule),
 1653    !,
 1654    current_source_line(Here),
 1655    assert_called(Src, Origin, Goal, Here),
 1656    process_assert(Rule, Origin, Src).
 1657process_goal(Goal, Origin, Src, P) :-
 1658    partial_evaluate(Goal, P),
 1659    current_source_line(Here),
 1660    assert_called(Src, Origin, Goal, Here).
 1661
 1662disjunction(Var)   --> {var(Var), !}, [Var].
 1663disjunction((A;B)) --> !, disjunction(A), disjunction(B).
 1664disjunction(G)     --> [G].
 1665
 1666conjunction(Var)   --> {var(Var), !}, [Var].
 1667conjunction((A,B)) --> !, conjunction(A), conjunction(B).
 1668conjunction(G)     --> [G].
 1669
 1670shares_vars(RVars, T) :-
 1671    term_variables(T, TVars0),
 1672    sort(TVars0, TVars),
 1673    ord_intersect(RVars, TVars).
 1674
 1675process_conjunction([], _, _, _).
 1676process_conjunction([Disj|Rest], Origin, Src, P) :-
 1677    nonvar(Disj),
 1678    Disj = (_;_),
 1679    Rest \== [],
 1680    !,
 1681    phrase(disjunction(Disj), Goals),
 1682    term_variables(Rest, RVars0),
 1683    sort(RVars0, RVars),
 1684    partition(shares_vars(RVars), Goals, Sharing, NonSHaring),
 1685    forall(member(G, NonSHaring),
 1686           process_body(G, Origin, Src)),
 1687    (   Sharing == []
 1688    ->  true
 1689    ;   maplist(term_variables, Sharing, GVars0),
 1690        append(GVars0, GVars1),
 1691        sort(GVars1, GVars),
 1692        ord_intersection(GVars, RVars, SVars),
 1693        VT =.. [v|SVars],
 1694        findall(VT,
 1695                (   member(G, Sharing),
 1696                    process_goal(G, Origin, Src, PS),
 1697                    PS == true
 1698                ),
 1699                Alts0),
 1700        (   Alts0 == []
 1701        ->  true
 1702        ;   (   true
 1703            ;   P = true,
 1704                sort(Alts0, Alts1),
 1705                variants(Alts1, 10, Alts),
 1706                member(VT, Alts)
 1707            )
 1708        )
 1709    ),
 1710    process_conjunction(Rest, Origin, Src, P).
 1711process_conjunction([H|T], Origin, Src, P) :-
 1712    process_goal(H, Origin, Src, P),
 1713    process_conjunction(T, Origin, Src, P).
 1714
 1715
 1716process_called_list([], _, _, _).
 1717process_called_list([H|T], Origin, Src, P) :-
 1718    process_meta(H, Origin, Src, P),
 1719    process_called_list(T, Origin, Src, P).
 1720
 1721process_meta(A+N, Origin, Src, P) :-
 1722    !,
 1723    (   extend(A, N, AX)
 1724    ->  process_goal(AX, Origin, Src, P)
 1725    ;   true
 1726    ).
 1727process_meta(//(A), Origin, Src, P) :-
 1728    !,
 1729    process_dcg_goal(A, Origin, Src, P).
 1730process_meta(G, Origin, Src, P) :-
 1731    process_goal(G, Origin, Src, P).
 1732
 1733%!  process_dcg_goal(+Grammar, +Origin, +Src, ?Partial) is det.
 1734%
 1735%   Process  meta-arguments  that  are  tagged   with  //,  such  as
 1736%   phrase/3.
 1737
 1738process_dcg_goal(Var, _, _, _) :-
 1739    var(Var),
 1740    !.
 1741process_dcg_goal((A,B), Origin, Src, P) :-
 1742    !,
 1743    process_dcg_goal(A, Origin, Src, P),
 1744    process_dcg_goal(B, Origin, Src, P).
 1745process_dcg_goal((A;B), Origin, Src, P) :-
 1746    !,
 1747    process_dcg_goal(A, Origin, Src, P),
 1748    process_dcg_goal(B, Origin, Src, P).
 1749process_dcg_goal((A|B), Origin, Src, P) :-
 1750    !,
 1751    process_dcg_goal(A, Origin, Src, P),
 1752    process_dcg_goal(B, Origin, Src, P).
 1753process_dcg_goal((A->B), Origin, Src, P) :-
 1754    !,
 1755    process_dcg_goal(A, Origin, Src, P),
 1756    process_dcg_goal(B, Origin, Src, P).
 1757process_dcg_goal((A*->B), Origin, Src, P) :-
 1758    !,
 1759    process_dcg_goal(A, Origin, Src, P),
 1760    process_dcg_goal(B, Origin, Src, P).
 1761process_dcg_goal({Goal}, Origin, Src, P) :-
 1762    !,
 1763    process_goal(Goal, Origin, Src, P).
 1764process_dcg_goal(List, _Origin, _Src, _) :-
 1765    is_list(List),
 1766    !.               % terminal
 1767process_dcg_goal(List, _Origin, _Src, _) :-
 1768    string(List),
 1769    !.                % terminal
 1770process_dcg_goal(Callable, Origin, Src, P) :-
 1771    extend(Callable, 2, Goal),
 1772    !,
 1773    process_goal(Goal, Origin, Src, P).
 1774process_dcg_goal(_, _, _, _).
 1775
 1776
 1777extend(Var, _, _) :-
 1778    var(Var), !, fail.
 1779extend(M:G, N, M:GX) :-
 1780    !,
 1781    callable(G),
 1782    extend(G, N, GX).
 1783extend(G, N, GX) :-
 1784    (   N =:= 0
 1785    ->  GX = G
 1786    ;   compound(G)
 1787    ->  compound_name_arguments(G, Name, Args),
 1788        length(Rest, N),
 1789        append(Args, Rest, NArgs),
 1790        compound_name_arguments(GX, Name, NArgs)
 1791    ;   atom(G)
 1792    ->  length(NArgs, N),
 1793        compound_name_arguments(GX, G, NArgs)
 1794    ).
 1795
 1796asserting_goal(assert(Rule), Rule).
 1797asserting_goal(asserta(Rule), Rule).
 1798asserting_goal(assertz(Rule), Rule).
 1799asserting_goal(assert(Rule,_), Rule).
 1800asserting_goal(asserta(Rule,_), Rule).
 1801asserting_goal(assertz(Rule,_), Rule).
 1802
 1803process_assert(0, _, _) :- !.           % catch variables
 1804process_assert((_:-Body), Origin, Src) :-
 1805    !,
 1806    process_body(Body, Origin, Src).
 1807process_assert(_, _, _).
 1808
 1809%!  variants(+SortedList, +Max, -Variants) is det.
 1810
 1811variants([], _, []).
 1812variants([H|T], Max, List) :-
 1813    variants(T, H, Max, List).
 1814
 1815variants([], H, _, [H]).
 1816variants(_, _, 0, []) :- !.
 1817variants([H|T], V, Max, List) :-
 1818    (   H =@= V
 1819    ->  variants(T, V, Max, List)
 1820    ;   List = [V|List2],
 1821        Max1 is Max-1,
 1822        variants(T, H, Max1, List2)
 1823    ).
 1824
 1825%!  partial_evaluate(+Goal, ?Parrial) is det.
 1826%
 1827%   Perform partial evaluation on Goal to trap cases such as below.
 1828%
 1829%     ==
 1830%           T = hello(X),
 1831%           findall(T, T, List),
 1832%     ==
 1833%
 1834%   @tbd    Make this user extensible? What about non-deterministic
 1835%           bindings?
 1836
 1837partial_evaluate(Goal, P) :-
 1838    eval(Goal),
 1839    !,
 1840    P = true.
 1841partial_evaluate(_, _).
 1842
 1843eval(X = Y) :-
 1844    unify_with_occurs_check(X, Y).
 1845
 1846		 /*******************************
 1847		 *        PLUNIT SUPPORT	*
 1848		 *******************************/
 1849
 1850enter_test_unit(Unit, _Src) :-
 1851    current_source_line(Line),
 1852    asserta(current_test_unit(Unit, Line)).
 1853
 1854leave_test_unit(Unit, _Src) :-
 1855    retractall(current_test_unit(Unit, _)).
 1856
 1857
 1858                 /*******************************
 1859                 *          XPCE STUFF          *
 1860                 *******************************/
 1861
 1862pce_goal(new(_,_), new(-, new)).
 1863pce_goal(send(_,_), send(arg, msg)).
 1864pce_goal(send_class(_,_,_), send_class(arg, arg, msg)).
 1865pce_goal(get(_,_,_), get(arg, msg, -)).
 1866pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)).
 1867pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)).
 1868pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
 1869
 1870process_xpce_goal(G, Origin, Src) :-
 1871    pce_goal(G, Process),
 1872    !,
 1873    current_source_line(Here),
 1874    assert_called(Src, Origin, G, Here),
 1875    (   arg(I, Process, How),
 1876        arg(I, G, Term),
 1877        process_xpce_arg(How, Term, Origin, Src),
 1878        fail
 1879    ;   true
 1880    ).
 1881
 1882process_xpce_arg(new, Term, Origin, Src) :-
 1883    callable(Term),
 1884    process_new(Term, Origin, Src).
 1885process_xpce_arg(arg, Term, Origin, Src) :-
 1886    compound(Term),
 1887    process_new(Term, Origin, Src).
 1888process_xpce_arg(msg, Term, Origin, Src) :-
 1889    compound(Term),
 1890    (   arg(_, Term, Arg),
 1891        process_xpce_arg(arg, Arg, Origin, Src),
 1892        fail
 1893    ;   true
 1894    ).
 1895
 1896process_new(_M:_Term, _, _) :- !.       % TBD: Calls on other modules!
 1897process_new(Term, Origin, Src) :-
 1898    assert_new(Src, Origin, Term),
 1899    (   compound(Term),
 1900        arg(_, Term, Arg),
 1901        process_xpce_arg(arg, Arg, Origin, Src),
 1902        fail
 1903    ;   true
 1904    ).
 1905
 1906assert_new(_, _, Term) :-
 1907    \+ callable(Term),
 1908    !.
 1909assert_new(Src, Origin, Control) :-
 1910    functor_name(Control, Class),
 1911    pce_control_class(Class),
 1912    !,
 1913    forall(arg(_, Control, Arg),
 1914           assert_new(Src, Origin, Arg)).
 1915assert_new(Src, Origin, Term) :-
 1916    compound(Term),
 1917    arg(1, Term, Prolog),
 1918    Prolog == @(prolog),
 1919    (   Term =.. [message, _, Selector | T],
 1920        atom(Selector)
 1921    ->  Called =.. [Selector|T],
 1922        process_body(Called, Origin, Src)
 1923    ;   Term =.. [?, _, Selector | T],
 1924        atom(Selector)
 1925    ->  append(T, [_R], T2),
 1926        Called =.. [Selector|T2],
 1927        process_body(Called, Origin, Src)
 1928    ),
 1929    fail.
 1930assert_new(_, _, @(_)) :- !.
 1931assert_new(Src, _, Term) :-
 1932    functor_name(Term, Name),
 1933    assert_used_class(Src, Name).
 1934
 1935
 1936pce_control_class(and).
 1937pce_control_class(or).
 1938pce_control_class(if).
 1939pce_control_class(not).
 1940
 1941
 1942                /********************************
 1943                *       INCLUDED MODULES        *
 1944                ********************************/
 1945
 1946%!  process_use_module(+Modules, +Src, +Rexport) is det.
 1947
 1948process_use_module(_Module:_Files, _, _) :- !.  % loaded in another module
 1949process_use_module([], _, _) :- !.
 1950process_use_module([H|T], Src, Reexport) :-
 1951    !,
 1952    process_use_module(H, Src, Reexport),
 1953    process_use_module(T, Src, Reexport).
 1954process_use_module(library(pce), Src, Reexport) :-     % bit special
 1955    !,
 1956    xref_public_list(library(pce), Path, Exports, Src),
 1957    forall(member(Import, Exports),
 1958           process_pce_import(Import, Src, Path, Reexport)).
 1959process_use_module(File, Src, Reexport) :-
 1960    load_module_if_needed(File),
 1961    (   xoption(Src, silent(Silent))
 1962    ->  Extra = [silent(Silent)]
 1963    ;   Extra = [silent(true)]
 1964    ),
 1965    (   xref_public_list(File, Src,
 1966                         [ path(Path),
 1967                           module(M),
 1968                           exports(Exports),
 1969                           public(Public),
 1970                           meta(Meta)
 1971                         | Extra
 1972                         ])
 1973    ->  assert(uses_file(File, Src, Path)),
 1974        assert_import(Src, Exports, _, Path, Reexport),
 1975        assert_xmodule_callable(Exports, M, Src, Path),
 1976        assert_xmodule_callable(Public, M, Src, Path),
 1977        maplist(process_meta_head(Src), Meta),
 1978        (   File = library(chr)     % hacky
 1979        ->  assert(mode(chr, Src))
 1980        ;   true
 1981        )
 1982    ;   assert(uses_file(File, Src, '<not_found>'))
 1983    ).
 1984
 1985process_pce_import(Name/Arity, Src, Path, Reexport) :-
 1986    atom(Name),
 1987    integer(Arity),
 1988    !,
 1989    functor(Term, Name, Arity),
 1990    (   \+ system_predicate(Term),
 1991        \+ Term = pce_error(_)      % hack!?
 1992    ->  assert_import(Src, [Name/Arity], _, Path, Reexport)
 1993    ;   true
 1994    ).
 1995process_pce_import(op(P,T,N), Src, _, _) :-
 1996    xref_push_op(Src, P, T, N).
 1997
 1998%!  process_use_module2(+File, +Import, +Src, +Reexport) is det.
 1999%
 2000%   Process use_module/2 and reexport/2.
 2001
 2002process_use_module2(File, Import, Src, Reexport) :-
 2003    load_module_if_needed(File),
 2004    (   catch(xref_public_list(File, Src,
 2005                               [ path(Path),
 2006                                 exports(Export),
 2007                                 meta(Meta)
 2008                               ]),
 2009              error(_,_),
 2010              fail)
 2011    ->  assertz(uses_file(File, Src, Path)),
 2012        assert_import(Src, Import, Export, Path, Reexport),
 2013        forall((  member(Head, Meta),
 2014                  imported(Head, _, Path)
 2015               ),
 2016               process_meta_head(Src, Head))
 2017    ;   assertz(uses_file(File, Src, '<not_found>'))
 2018    ).
 2019
 2020
 2021%!  load_module_if_needed(+File)
 2022%
 2023%   Load a module explicitly if  it   is  not  suitable for autoloading.
 2024%   Typically this is the case  if   the  module provides essential term
 2025%   and/or goal expansion rulses.
 2026
 2027load_module_if_needed(File) :-
 2028    prolog:no_autoload_module(File),
 2029    !,
 2030    use_module(File, []).
 2031load_module_if_needed(_).
 2032
 2033prolog:no_autoload_module(library(apply_macros)).
 2034prolog:no_autoload_module(library(arithmetic)).
 2035prolog:no_autoload_module(library(record)).
 2036prolog:no_autoload_module(library(persistency)).
 2037prolog:no_autoload_module(library(pldoc)).
 2038prolog:no_autoload_module(library(settings)).
 2039prolog:no_autoload_module(library(debug)).
 2040prolog:no_autoload_module(library(plunit)).
 2041prolog:no_autoload_module(library(macros)).
 2042prolog:no_autoload_module(library(yall)).
 2043
 2044
 2045%!  process_requires(+Import, +Src)
 2046
 2047process_requires(Import, Src) :-
 2048    is_list(Import),
 2049    !,
 2050    require_list(Import, Src).
 2051process_requires(Var, _Src) :-
 2052    var(Var),
 2053    !.
 2054process_requires((A,B), Src) :-
 2055    !,
 2056    process_requires(A, Src),
 2057    process_requires(B, Src).
 2058process_requires(PI, Src) :-
 2059    requires(PI, Src).
 2060
 2061require_list([], _).
 2062require_list([H|T], Src) :-
 2063    requires(H, Src),
 2064    require_list(T, Src).
 2065
 2066requires(PI, _Src) :-
 2067    '$pi_head'(PI, Head),
 2068    '$get_predicate_attribute'(system:Head, defined, 1),
 2069    !.
 2070requires(PI, Src) :-
 2071    '$pi_head'(PI, Head),
 2072    '$pi_head'(Name/Arity, Head),
 2073    '$find_library'(_Module, Name, Arity, _LoadModule, Library),
 2074    (   imported(Head, Src, Library)
 2075    ->  true
 2076    ;   assertz(imported(Head, Src, Library))
 2077    ).
 2078
 2079
 2080%!  xref_public_list(+Spec, +Source, +Options) is semidet.
 2081%
 2082%   Find meta-information about File.  If  Spec   resolves  to  a Prolog
 2083%   source file, this predicate reads all terms upto the first term that
 2084%   is not a directive. If Spec resolves to a SWI-Prolog `.qlf` file, it
 2085%   extracts part of the information from  the   QLF  file.  It uses the
 2086%   module and meta_predicate directives to  assemble the information in
 2087%   Options. Options processed:
 2088%
 2089%     - path(-Path)
 2090%       Path is the full path name of the referenced file.  If Spec
 2091%       resolves to a .qlf file, Path is the name of the embedded
 2092%       Prolog file.
 2093%     - module(-Module)
 2094%       Module is the module defines in Spec.
 2095%     - exports(-Exports)
 2096%       Exports is a list of predicate indicators and operators
 2097%       collected from the module/2 term and reexport declarations.
 2098%     - public(-Public)
 2099%       Public declarations of the file.  Currently always `[]` for
 2100%       .qlf files.
 2101%     - meta(-Meta)
 2102%       Meta is a list of heads as they appear in meta_predicate/1
 2103%       declarations. Currently always `[]` for .qlf files.
 2104%     - silent(+Boolean)
 2105%       Do not print any messages or raise exceptions on errors.
 2106%
 2107%   The information collected by this predicate   is  cached. The cached
 2108%   data is considered valid as long  as   the  modification time of the
 2109%   file does not change.
 2110%
 2111%   @arg Source is the file from which Spec is referenced.
 2112
 2113xref_public_list(File, Src, Options) :-
 2114    option(path(Source), Options, _),
 2115    option(module(Module), Options, _),
 2116    option(exports(Exports), Options, _),
 2117    option(public(Public), Options, _),
 2118    option(meta(Meta), Options, _),
 2119    xref_source_file(File, Path, Src, Options),
 2120    public_list(Path, Source, Module, Meta, Exports, Public, Options).
 2121
 2122%!  xref_public_list(+File, -Path, -Export, +Src) is semidet.
 2123%!  xref_public_list(+File, -Path, -Module, -Export, -Meta, +Src) is semidet.
 2124%!  xref_public_list(+File, -Path, -Module, -Export, -Public, -Meta, +Src) is semidet.
 2125%
 2126%   Find meta-information about File. This predicate reads all terms
 2127%   upto the first term that is not  a directive. It uses the module
 2128%   and  meta_predicate  directives  to   assemble  the  information
 2129%   described below.
 2130%
 2131%   These predicates fail if File is not a module-file.
 2132%
 2133%   @arg  File is a file speficiation for prolog_open_source/2 or a
 2134%         .qlf file name.  Note this makes a stream a valid input.
 2135%   @arg  Path is the canonical path to File
 2136%   @arg  Module is the module defined in Path
 2137%   @arg  Export is a list of predicate indicators.
 2138%   @arg  Meta is a list of heads as they appear in
 2139%         meta_predicate/1 declarations.
 2140%   @arg  Src is the place from which File is referenced.
 2141%   @deprecated New code should use xref_public_list/3, which
 2142%         unifies all variations using an option list.
 2143
 2144xref_public_list(File, Source, Export, Src) :-
 2145    xref_source_file(File, Path, Src),
 2146    public_list(Path, Source, _, _, Export, _, []).
 2147xref_public_list(File, Source, Module, Export, Meta, Src) :-
 2148    xref_source_file(File, Path, Src),
 2149    public_list(Path, Source, Module, Meta, Export, _, []).
 2150xref_public_list(File, Source, Module, Export, Public, Meta, Src) :-
 2151    xref_source_file(File, Path, Src),
 2152    public_list(Path, Source, Module, Meta, Export, Public, []).
 2153
 2154%!  public_list(+Path, -Source, -Module, -Meta, -Export, -Public,
 2155%!              +Options) is det.
 2156%
 2157%   Read the public information for Path.  Options supported are:
 2158%
 2159%     - silent(+Boolean)
 2160%       If `true`, ignore (syntax) errors.  If not specified the default
 2161%       is inherited from xref_source/2.
 2162
 2163:- dynamic  public_list_cache/7. 2164:- volatile public_list_cache/7. 2165
 2166public_list(Path, Source, Module, Meta, Export, Public, _Options) :-
 2167    \+ is_stream(Path),
 2168    public_list_cache(Path, Source, Modified,
 2169                      Module0, Meta0, Export0, Public0),
 2170    time_file(Path, ModifiedNow),
 2171    (   abs(Modified-ModifiedNow) < 0.0001
 2172    ->  !,
 2173        t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0)
 2174    ;   retractall(public_list_cache(Path, _, _, _, _, _, _)),
 2175        fail
 2176    ).
 2177public_list(Path, Source, Module, Meta, Export, Public, Options) :-
 2178    public_list_nc(Path, Source, Module0, Meta0, Export0, Public0, Options),
 2179    (   Error = error(_,_),
 2180        catch(time_file(Path, Modified), Error, fail)
 2181    ->  asserta(public_list_cache(Path, Source, Modified,
 2182                                  Module0, Meta0, Export0, Public0))
 2183    ;   true
 2184    ),
 2185    t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0).
 2186
 2187public_list_nc(Path, Source, Module, Meta, Export, Public, _Options) :-
 2188    \+ is_stream(Path),
 2189    public_list_from_index(Path, Module, Meta, Export, Public),
 2190    !,
 2191    qlf_pl_file(Path, Source).
 2192public_list_nc(Path, Source, Module, [], Export, [], _Options) :-
 2193    \+ is_stream(Path),
 2194    is_qlf_file(Path),
 2195    !,
 2196    '$qlf_module'(Path, Info),
 2197    _{module:Module, exports:Export, file:Source} :< Info.
 2198public_list_nc(Path, Path, Module, Meta, Export, Public, Options) :-
 2199    (   is_stream(Path)
 2200    ;   exists_file(Path)
 2201    ),
 2202    !,
 2203    prolog_file_directives(Path, Directives, Options),
 2204    public_list(Directives, Path, Module, Meta, [], Export, [], Public, []).
 2205public_list_nc(Path, Path, Module, [], Export, [], _Options) :-
 2206    \+ is_stream(Path),
 2207    qlf_pl_file(QlfFile, Path),
 2208    '$qlf_module'(QlfFile, Info),
 2209    _{module:Module, exports:Export} :< Info.
 2210
 2211public_list([(:- module(Module, Export0))|Decls], Path,
 2212            Module, Meta, MT, Export, Rest, Public, PT) :-
 2213    !,
 2214    (   is_list(Export0)
 2215    ->  append(Export0, Reexport, Export)
 2216    ;   Reexport = Export
 2217    ),
 2218    public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT).
 2219public_list([(:- encoding(_))|Decls], Path,
 2220            Module, Meta, MT, Export, Rest, Public, PT) :-
 2221    public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT).
 2222
 2223public_list_([], _, Meta, Meta, Export, Export, Public, Public).
 2224public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :-
 2225    public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0),
 2226    !,
 2227    public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT).
 2228public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :-
 2229    public_list_(T, Path, Meta, MT, Export, Rest, Public, PT).
 2230
 2231public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :-
 2232    reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT).
 2233public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :-
 2234    public_from_import(Import, Spec, Path, Reexport, Rest).
 2235public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :-
 2236    phrase(meta_decls(Decl), Meta, MT).
 2237public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :-
 2238    phrase(public_decls(Decl), Public, PT).
 2239
 2240%!  reexport_files(+Files, +Src,
 2241%!                 -Meta, ?MetaTail, -Exports, ?ExportsTail,
 2242%!                 -Public, ?PublicTail)
 2243
 2244reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !.
 2245reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :-
 2246    !,
 2247    xref_source_file(H, Path, Src),
 2248    public_list(Path, _Source, _Module, Meta0, Export0, Public0, []),
 2249    append(Meta0, MT1, Meta),
 2250    append(Export0, ET1, Export),
 2251    append(Public0, PT1, Public),
 2252    reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT).
 2253reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :-
 2254    xref_source_file(Spec, Path, Src),
 2255    public_list(Path, _Source, _Module, Meta0, Export0, Public0, []),
 2256    append(Meta0, MT, Meta),
 2257    append(Export0, ET, Export),
 2258    append(Public0, PT, Public).
 2259
 2260public_from_import(except(Map), Path, Src, Export, Rest) :-
 2261    !,
 2262    xref_public_list(Path, _, AllExports, Src),
 2263    except(Map, AllExports, NewExports),
 2264    append(NewExports, Rest, Export).
 2265public_from_import(Import, _, _, Export, Rest) :-
 2266    import_name_map(Import, Export, Rest).
 2267
 2268
 2269%!  except(+Remove, +AllExports, -Exports)
 2270
 2271except([], Exports, Exports).
 2272except([PI0 as NewName|Map], Exports0, Exports) :-
 2273    !,
 2274    canonical_pi(PI0, PI),
 2275    map_as(Exports0, PI, NewName, Exports1),
 2276    except(Map, Exports1, Exports).
 2277except([PI0|Map], Exports0, Exports) :-
 2278    canonical_pi(PI0, PI),
 2279    select(PI2, Exports0, Exports1),
 2280    same_pi(PI, PI2),
 2281    !,
 2282    except(Map, Exports1, Exports).
 2283
 2284
 2285map_as([PI|T], Repl, As, [PI2|T])  :-
 2286    same_pi(Repl, PI),
 2287    !,
 2288    pi_as(PI, As, PI2).
 2289map_as([H|T0], Repl, As, [H|T])  :-
 2290    map_as(T0, Repl, As, T).
 2291
 2292pi_as(_/Arity, Name, Name/Arity).
 2293pi_as(_//Arity, Name, Name//Arity).
 2294
 2295import_name_map([], L, L).
 2296import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :-
 2297    !,
 2298    import_name_map(T0, T, Tail).
 2299import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :-
 2300    !,
 2301    import_name_map(T0, T, Tail).
 2302import_name_map([H|T0], [H|T], Tail) :-
 2303    import_name_map(T0, T, Tail).
 2304
 2305canonical_pi(Name//Arity0, PI) :-
 2306    integer(Arity0),
 2307    !,
 2308    PI = Name/Arity,
 2309    Arity is Arity0 + 2.
 2310canonical_pi(PI, PI).
 2311
 2312same_pi(Canonical, PI2) :-
 2313    canonical_pi(PI2, Canonical).
 2314
 2315meta_decls(Var) -->
 2316    { var(Var) },
 2317    !.
 2318meta_decls((A,B)) -->
 2319    !,
 2320    meta_decls(A),
 2321    meta_decls(B).
 2322meta_decls(A) -->
 2323    [A].
 2324
 2325public_decls(Var) -->
 2326    { var(Var) },
 2327    !.
 2328public_decls((A,B)) -->
 2329    !,
 2330    public_decls(A),
 2331    public_decls(B).
 2332public_decls(A) -->
 2333    [A].
 2334
 2335%!  public_list_from_index(+Path, -Module, -Meta, -Exports, -Public) is semidet.
 2336%
 2337%   Read the exports for  Path  from  the   INDEX.pl  file  in  the same
 2338%   directory.
 2339
 2340public_list_from_index(Path, Module, Meta, Export, Public) :-
 2341    file_name_extension(BasePath, _Ext, Path),
 2342    file_directory_name(BasePath, Dir),
 2343    atom_concat(Dir, '/INDEX.pl', IndexFile),
 2344    exists_file(IndexFile),
 2345    file_base_name(BasePath, Base),
 2346    setup_call_cleanup(
 2347        '$push_input_context'(autoload_index),
 2348        setup_call_cleanup(
 2349            open(IndexFile, read, In),
 2350            index_public_list(In, Base, Module, Meta, Export, Public),
 2351            close(In)),
 2352        '$pop_input_context').
 2353
 2354index_public_list(In, Base, Module, Meta, Export, Public) :-
 2355    read_term(In, Term, []),
 2356    index_public_list(Term, In, Base, Module, Meta, Export, Public).
 2357
 2358index_public_list(end_of_file, _In, _Base, _Module, [], [], []).
 2359index_public_list(index(op:Op, Module, Base), In, Base, Module, Meta, [Op|Export], Public) :-
 2360    !,
 2361    read_term(In, Term, []),
 2362    index_public_list(Term, In, Base, Module, Meta, Export, Public).
 2363index_public_list(index((public):Head, Module, Base), In, Base, Module, Meta, Export, [PI|Public]) :-
 2364    !,
 2365    pi_head(PI, Head),
 2366    read_term(In, Term, []),
 2367    index_public_list(Term, In, Base, Module, Meta, Export, Public).
 2368index_public_list(index(Head, Module, Base), In, Base, Module, Meta, [PI|Export], Public) :-
 2369    !,
 2370    pi_head(PI, Head),
 2371    (   meta_mode(Head)
 2372    ->  Meta = [Head|MetaT]
 2373    ;   Meta = MetaT
 2374    ),
 2375    read_term(In, Term, []),
 2376    index_public_list(Term, In, Base, Module, MetaT, Export, Public).
 2377index_public_list(index(Name, Arity, Module, Base), In, Base, Module, Meta, [Name/Arity|Export], Public) :-
 2378    !,
 2379    read_term(In, Term, []),
 2380    index_public_list(Term, In, Base, Module, Meta, Export, Public).
 2381index_public_list(_, In, Base, Module, Meta, Export, Public) :-
 2382    read_term(In, Term, []),
 2383    index_public_list(Term, In, Base, Module, Meta, Export, Public).
 2384
 2385meta_mode(H) :-
 2386    compound(H),
 2387    arg(_, H, A),
 2388    meta_arg(A),
 2389    !.
 2390
 2391meta_arg(I) :-
 2392    integer(I),
 2393    !.
 2394meta_arg(:).
 2395meta_arg(^).
 2396meta_arg(//).
 2397
 2398                 /*******************************
 2399                 *             INCLUDE          *
 2400                 *******************************/
 2401
 2402process_include([], _) :- !.
 2403process_include([H|T], Src) :-
 2404    !,
 2405    process_include(H, Src),
 2406    process_include(T, Src).
 2407process_include(File, Src) :-
 2408    callable(File),
 2409    !,
 2410    (   once(xref_input(ParentSrc, _)),
 2411        xref_source_file(File, Path, ParentSrc)
 2412    ->  (   (   uses_file(_, Src, Path)
 2413            ;   Path == Src
 2414            )
 2415        ->  true
 2416        ;   assert(uses_file(File, Src, Path)),
 2417            (   xoption(Src, process_include(true))
 2418            ->  findall(O, xoption(Src, O), Options),
 2419                setup_call_cleanup(
 2420                    open_include_file(Path, In, Refs),
 2421                    collect(Src, Path, In, Options),
 2422                    close_include(In, Refs))
 2423            ;   true
 2424            )
 2425        )
 2426    ;   assert(uses_file(File, Src, '<not_found>'))
 2427    ).
 2428process_include(_, _).
 2429
 2430%!  open_include_file(+Path, -In, -Refs)
 2431%
 2432%   Opens an :- include(File) referenced file.   Note that we cannot
 2433%   use prolog_open_source/2 because we   should  _not_ safe/restore
 2434%   the lexical context.
 2435
 2436open_include_file(Path, In, [Ref]) :-
 2437    once(xref_input(_, Parent)),
 2438    stream_property(Parent, encoding(Enc)),
 2439    '$push_input_context'(xref_include),
 2440    catch((   prolog:xref_open_source(Path, In)
 2441          ->  catch(set_stream(In, encoding(Enc)),
 2442                    error(_,_), true)       % deal with non-file input
 2443          ;   include_encoding(Enc, Options),
 2444              open(Path, read, In, Options)
 2445          ), E,
 2446          ( '$pop_input_context', throw(E))),
 2447    catch((   peek_char(In, #)              % Deal with #! script
 2448          ->  skip(In, 10)
 2449          ;   true
 2450          ), E,
 2451          ( close_include(In, []), throw(E))),
 2452    asserta(xref_input(Path, In), Ref).
 2453
 2454include_encoding(wchar_t, []) :- !.
 2455include_encoding(Enc, [encoding(Enc)]).
 2456
 2457
 2458close_include(In, Refs) :-
 2459    maplist(erase, Refs),
 2460    close(In, [force(true)]),
 2461    '$pop_input_context'.
 2462
 2463%!  process_foreign(+Spec, +Src)
 2464%
 2465%   Process a load_foreign_library/1 call.
 2466
 2467process_foreign(Spec, Src) :-
 2468    ground(Spec),
 2469    current_foreign_library(Spec, Defined),
 2470    !,
 2471    (   xmodule(Module, Src)
 2472    ->  true
 2473    ;   Module = user
 2474    ),
 2475    process_foreign_defined(Defined, Module, Src).
 2476process_foreign(_, _).
 2477
 2478process_foreign_defined([], _, _).
 2479process_foreign_defined([H|T], M, Src) :-
 2480    (   H = M:Head
 2481    ->  assert_foreign(Src, Head)
 2482    ;   assert_foreign(Src, H)
 2483    ),
 2484    process_foreign_defined(T, M, Src).
 2485
 2486
 2487                 /*******************************
 2488                 *          CHR SUPPORT         *
 2489                 *******************************/
 2490
 2491/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2492This part of the file supports CHR. Our choice is between making special
 2493hooks to make CHR expansion work and  then handle the (complex) expanded
 2494code or process the  CHR  source   directly.  The  latter looks simpler,
 2495though I don't like the idea  of   adding  support for libraries to this
 2496module.  A  file  is  supposed  to  be  a    CHR   file  if  it  uses  a
 2497use_module(library(chr) or contains a :-   constraint/1 directive. As an
 2498extra bonus we get the source-locations right :-)
 2499- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2500
 2501process_chr(@(_Name, Rule), Src) :-
 2502    mode(chr, Src),
 2503    process_chr(Rule, Src).
 2504process_chr(pragma(Rule, _Pragma), Src) :-
 2505    mode(chr, Src),
 2506    process_chr(Rule, Src).
 2507process_chr(<=>(Head, Body), Src) :-
 2508    mode(chr, Src),
 2509    chr_head(Head, Src, H),
 2510    chr_body(Body, H, Src).
 2511process_chr(==>(Head, Body), Src) :-
 2512    mode(chr, Src),
 2513    chr_head(Head, H, Src),
 2514    chr_body(Body, H, Src).
 2515process_chr((:- chr_constraint(Decls)), Src) :-
 2516    (   mode(chr, Src)
 2517    ->  true
 2518    ;   assert(mode(chr, Src))
 2519    ),
 2520    chr_decls(Decls, Src).
 2521
 2522chr_decls((A,B), Src) =>
 2523    chr_decls(A, Src),
 2524    chr_decls(B, Src).
 2525chr_decls(Head, Src) =>
 2526    generalise_term(Head, Gen),
 2527    (   declared(Gen, chr_constraint, Src, _)
 2528    ->  true
 2529    ;   current_source_line(Line),
 2530        assertz(declared(Gen, chr_constraint, Src, Line))
 2531    ).
 2532
 2533chr_head(X, _, _) :-
 2534    var(X),
 2535    !.                      % Illegal.  Warn?
 2536chr_head(\(A,B), Src, H) :-
 2537    chr_head(A, Src, H),
 2538    process_body(B, H, Src).
 2539chr_head((H0,B), Src, H) :-
 2540    chr_defined(H0, Src, H),
 2541    process_body(B, H, Src).
 2542chr_head(H0, Src, H) :-
 2543    chr_defined(H0, Src, H).
 2544
 2545chr_defined(X, _, _) :-
 2546    var(X),
 2547    !.
 2548chr_defined(#(C,_Id), Src, C) :-
 2549    !,
 2550    assert_constraint(Src, C).
 2551chr_defined(A, Src, A) :-
 2552    assert_constraint(Src, A).
 2553
 2554chr_body(X, From, Src) :-
 2555    var(X),
 2556    !,
 2557    process_body(X, From, Src).
 2558chr_body('|'(Guard, Goals), H, Src) :-
 2559    !,
 2560    chr_body(Guard, H, Src),
 2561    chr_body(Goals, H, Src).
 2562chr_body(G, From, Src) :-
 2563    process_body(G, From, Src).
 2564
 2565assert_constraint(_, Head) :-
 2566    var(Head),
 2567    !.
 2568assert_constraint(Src, Head) :-
 2569    constraint(Head, Src, _),
 2570    !.
 2571assert_constraint(Src, Head) :-
 2572    generalise_term(Head, Term),
 2573    current_source_line(Line),
 2574    assert(constraint(Term, Src, Line)).
 2575
 2576
 2577                /********************************
 2578                *       PHASE 1 ASSERTIONS      *
 2579                ********************************/
 2580
 2581%!  assert_called(+Src, +From, +Head, +Line) is det.
 2582%
 2583%   Assert the fact that Head is called by From in Src. We do not
 2584%   assert called system predicates.
 2585
 2586assert_called(_, _, Var, _) :-
 2587    var(Var),
 2588    !.
 2589assert_called(Src, From, Goal, Line) :-
 2590    var(From),
 2591    !,
 2592    assert_called(Src, '<unknown>', Goal, Line).
 2593assert_called(_, _, Goal, _) :-
 2594    expand_hide_called(Goal),
 2595    !.
 2596assert_called(Src, Origin, M:G, Line) :-
 2597    !,
 2598    (   atom(M),
 2599        callable(G)
 2600    ->  current_condition(Cond),
 2601        (   xmodule(M, Src)         % explicit call to own module
 2602        ->  assert_called(Src, Origin, G, Line)
 2603        ;   called(M:G, Src, Origin, Cond, Line) % already registered
 2604        ->  true
 2605        ;   hide_called(M:G, Src)           % not interesting (now)
 2606        ->  true
 2607        ;   generalise(Origin, OTerm),
 2608            generalise(G, GTerm)
 2609        ->  assert(called(M:GTerm, Src, OTerm, Cond, Line))
 2610        ;   true
 2611        )
 2612    ;   true                        % call to variable module
 2613    ).
 2614assert_called(Src, _, Goal, _) :-
 2615    (   xmodule(M, Src)
 2616    ->  M \== system
 2617    ;   M = user
 2618    ),
 2619    hide_called(M:Goal, Src),
 2620    !.
 2621assert_called(Src, Origin, Goal, Line) :-
 2622    current_condition(Cond),
 2623    (   called(Goal, Src, Origin, Cond, Line)
 2624    ->  true
 2625    ;   generalise(Origin, OTerm),
 2626        generalise(Goal, Term)
 2627    ->  assert(called(Term, Src, OTerm, Cond, Line))
 2628    ;   true
 2629    ).
 2630
 2631
 2632%!  expand_hide_called(:Callable) is semidet.
 2633%
 2634%   Goals that should not turn up as being called. Hack. Eventually
 2635%   we should deal with that using an XPCE plugin.
 2636
 2637expand_hide_called(pce_principal:send_implementation(_, _, _)).
 2638expand_hide_called(pce_principal:get_implementation(_, _, _, _)).
 2639expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)).
 2640expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)).
 2641
 2642assert_defined(Src, Goal) :-
 2643    Goal = test(_Test),
 2644    current_test_unit(Unit, Line),
 2645    assert_called(Src, '<test_unit>'(Unit), Goal, Line),
 2646    fail.
 2647assert_defined(Src, Goal) :-
 2648    Goal = test(_Test, _Options),
 2649    current_test_unit(Unit, Line),
 2650    assert_called(Src, '<test_unit>'(Unit), Goal, Line),
 2651    fail.
 2652assert_defined(Src, Goal) :-
 2653    defined(Goal, Src, _),
 2654    !.
 2655assert_defined(Src, Goal) :-
 2656    generalise(Goal, Term),
 2657    current_source_line(Line),
 2658    assert(defined(Term, Src, Line)).
 2659
 2660assert_foreign(Src, Goal) :-
 2661    foreign(Goal, Src, _),
 2662    !.
 2663assert_foreign(Src, Goal) :-
 2664    generalise(Goal, Term),
 2665    current_source_line(Line),
 2666    assert(foreign(Term, Src, Line)).
 2667
 2668assert_grammar_rule(Src, Goal) :-
 2669    grammar_rule(Goal, Src),
 2670    !.
 2671assert_grammar_rule(Src, Goal) :-
 2672    generalise(Goal, Term),
 2673    assert(grammar_rule(Term, Src)).
 2674
 2675
 2676%!  assert_import(+Src, +Import, +ExportList, +From, +Reexport) is det.
 2677%
 2678%   Asserts imports into Src. Import   is  the import specification,
 2679%   ExportList is the list of known   exported predicates or unbound
 2680%   if this need not be checked and From  is the file from which the
 2681%   public predicates come. If  Reexport   is  =true=, re-export the
 2682%   imported predicates.
 2683%
 2684%   @tbd    Tighter type-checking on Import.
 2685
 2686assert_import(_, [], _, _, _) :- !.
 2687assert_import(Src, [H|T], Export, From, Reexport) :-
 2688    !,
 2689    assert_import(Src, H, Export, From, Reexport),
 2690    assert_import(Src, T, Export, From, Reexport).
 2691assert_import(Src, except(Except), Export, From, Reexport) :-
 2692    !,
 2693    is_list(Export),
 2694    !,
 2695    except(Except, Export, Import),
 2696    assert_import(Src, Import, _All, From, Reexport).
 2697assert_import(Src, Import as Name, Export, From, Reexport) :-
 2698    !,
 2699    pi_to_head(Import, Term0),
 2700    rename_goal(Term0, Name, Term),
 2701    (   in_export_list(Term0, Export)
 2702    ->  assert(imported(Term, Src, From)),
 2703        assert_reexport(Reexport, Src, Term)
 2704    ;   current_source_line(Line),
 2705        assert_called(Src, '<directive>'(Line), Term0, Line)
 2706    ).
 2707assert_import(Src, Import, Export, From, Reexport) :-
 2708    pi_to_head(Import, Term),
 2709    !,
 2710    (   in_export_list(Term, Export)
 2711    ->  assert(imported(Term, Src, From)),
 2712        assert_reexport(Reexport, Src, Term)
 2713    ;   current_source_line(Line),
 2714        assert_called(Src, '<directive>'(Line), Term, Line)
 2715    ).
 2716assert_import(Src, op(P,T,N), _, _, _) :-
 2717    xref_push_op(Src, P,T,N).
 2718
 2719in_export_list(_Head, Export) :-
 2720    var(Export),
 2721    !.
 2722in_export_list(Head, Export) :-
 2723    member(PI, Export),
 2724    pi_to_head(PI, Head).
 2725
 2726assert_reexport(false, _, _) :- !.
 2727assert_reexport(true, Src, Term) :-
 2728    assert(exported(Term, Src)).
 2729
 2730%!  process_import(:Import, +Src)
 2731%
 2732%   Process an import/1 directive
 2733
 2734process_import(M:PI, Src) :-
 2735    pi_to_head(PI, Head),
 2736    !,
 2737    (   atom(M),
 2738        current_module(M),
 2739        module_property(M, file(From))
 2740    ->  true
 2741    ;   From = '<unknown>'
 2742    ),
 2743    assert(imported(Head, Src, From)).
 2744process_import(_, _).
 2745
 2746%!  assert_xmodule_callable(PIs, Module, Src, From)
 2747%
 2748%   We can call all exports  and   public  predicates of an imported
 2749%   module using Module:Goal.
 2750%
 2751%   @tbd    Should we distinguish this from normal imported?
 2752
 2753assert_xmodule_callable([], _, _, _).
 2754assert_xmodule_callable([PI|T], M, Src, From) :-
 2755    (   pi_to_head(M:PI, Head)
 2756    ->  assert(imported(Head, Src, From))
 2757    ;   true
 2758    ),
 2759    assert_xmodule_callable(T, M, Src, From).
 2760
 2761
 2762%!  assert_op(+Src, +Op) is det.
 2763%
 2764%   @param Op       Ground term op(Priority, Type, Name).
 2765
 2766assert_op(Src, op(P,T,M:N)) :-
 2767    (   '$current_source_module'(M)
 2768    ->  Name = N
 2769    ;   Name = M:N
 2770    ),
 2771    (   xop(Src, op(P,T,Name))
 2772    ->  true
 2773    ;   assert(xop(Src, op(P,T,Name)))
 2774    ).
 2775
 2776%!  assert_module(+Src, +Module)
 2777%
 2778%   Assert we are loading code into Module.  This is also used to
 2779%   exploit local term-expansion and other rules.
 2780
 2781assert_module(Src, Module) :-
 2782    xmodule(Module, Src),
 2783    !.
 2784assert_module(Src, Module) :-
 2785    '$set_source_module'(Module),
 2786    assert(xmodule(Module, Src)),
 2787    (   module_property(Module, class(system))
 2788    ->  retractall(xoption(Src, register_called(_))),
 2789        assert(xoption(Src, register_called(all)))
 2790    ;   true
 2791    ).
 2792
 2793assert_module_export(_, []) :- !.
 2794assert_module_export(Src, [H|T]) :-
 2795    !,
 2796    assert_module_export(Src, H),
 2797    assert_module_export(Src, T).
 2798assert_module_export(Src, PI) :-
 2799    pi_to_head(PI, Term),
 2800    !,
 2801    assert(exported(Term, Src)).
 2802assert_module_export(Src, op(P, A, N)) :-
 2803    xref_push_op(Src, P, A, N).
 2804
 2805%!  assert_module3(+Import, +Src)
 2806%
 2807%   Handle 3th argument of module/3 declaration.
 2808
 2809assert_module3([], _) :- !.
 2810assert_module3([H|T], Src) :-
 2811    !,
 2812    assert_module3(H, Src),
 2813    assert_module3(T, Src).
 2814assert_module3(Option, Src) :-
 2815    process_use_module(library(dialect/Option), Src, false).
 2816
 2817
 2818%!  process_predicates(:Closure, +Predicates, +Src)
 2819%
 2820%   Process areguments of dynamic,  etc.,   using  call(Closure, PI,
 2821%   Src).  Handles  both  lists  of    specifications  and  (PI,...)
 2822%   specifications.
 2823
 2824process_predicates(Closure, Preds, Src) :-
 2825    is_list(Preds),
 2826    !,
 2827    process_predicate_list(Preds, Closure, Src).
 2828process_predicates(Closure, as(Preds, _Options), Src) :-
 2829    !,
 2830    process_predicates(Closure, Preds, Src).
 2831process_predicates(Closure, Preds, Src) :-
 2832    process_predicate_comma(Preds, Closure, Src).
 2833
 2834process_predicate_list([], _, _).
 2835process_predicate_list([H|T], Closure, Src) :-
 2836    (   nonvar(H)
 2837    ->  call(Closure, H, Src)
 2838    ;   true
 2839    ),
 2840    process_predicate_list(T, Closure, Src).
 2841
 2842process_predicate_comma(Var, _, _) :-
 2843    var(Var),
 2844    !.
 2845process_predicate_comma(M:(A,B), Closure, Src) :-
 2846    !,
 2847    process_predicate_comma(M:A, Closure, Src),
 2848    process_predicate_comma(M:B, Closure, Src).
 2849process_predicate_comma((A,B), Closure, Src) :-
 2850    !,
 2851    process_predicate_comma(A, Closure, Src),
 2852    process_predicate_comma(B, Closure, Src).
 2853process_predicate_comma(as(Spec, _Options), Closure, Src) :-
 2854    !,
 2855    process_predicate_comma(Spec, Closure, Src).
 2856process_predicate_comma(A, Closure, Src) :-
 2857    call(Closure, A, Src).
 2858
 2859
 2860assert_dynamic(PI, Src) :-
 2861    pi_to_head(PI, Term),
 2862    (   thread_local(Term, Src, _)  % dynamic after thread_local has
 2863    ->  true                        % no effect
 2864    ;   current_source_line(Line),
 2865        assert(dynamic(Term, Src, Line))
 2866    ).
 2867
 2868assert_thread_local(PI, Src) :-
 2869    pi_to_head(PI, Term),
 2870    current_source_line(Line),
 2871    assert(thread_local(Term, Src, Line)).
 2872
 2873assert_multifile(PI, Src) :-                    % :- multifile(Spec)
 2874    pi_to_head(PI, Term),
 2875    current_source_line(Line),
 2876    assert(multifile(Term, Src, Line)).
 2877
 2878assert_public(PI, Src) :-                       % :- public(Spec)
 2879    pi_to_head(PI, Term),
 2880    current_source_line(Line),
 2881    assert_called(Src, '<public>'(Line), Term, Line),
 2882    assert(public(Term, Src, Line)).
 2883
 2884assert_export(PI, Src) :-                       % :- export(Spec)
 2885    pi_to_head(PI, Term),
 2886    !,
 2887    assert(exported(Term, Src)).
 2888
 2889%!  pi_to_head(+PI, -Head) is semidet.
 2890%
 2891%   Translate Name/Arity or Name//Arity to a callable term. Fails if
 2892%   PI is not a predicate indicator.
 2893
 2894pi_to_head(Var, _) :-
 2895    var(Var), !, fail.
 2896pi_to_head(M:PI, M:Term) :-
 2897    !,
 2898    pi_to_head(PI, Term).
 2899pi_to_head(Name/Arity, Term) :-
 2900    functor(Term, Name, Arity).
 2901pi_to_head(Name//DCGArity, Term) :-
 2902    Arity is DCGArity+2,
 2903    functor(Term, Name, Arity).
 2904
 2905
 2906assert_used_class(Src, Name) :-
 2907    used_class(Name, Src),
 2908    !.
 2909assert_used_class(Src, Name) :-
 2910    assert(used_class(Name, Src)).
 2911
 2912assert_defined_class(Src, Name, _Meta, _Super, _) :-
 2913    defined_class(Name, _, _, Src, _),
 2914    !.
 2915assert_defined_class(_, _, _, -, _) :- !.               % :- pce_extend_class
 2916assert_defined_class(Src, Name, Meta, Super, Summary) :-
 2917    current_source_line(Line),
 2918    (   Summary == @(default)
 2919    ->  Atom = ''
 2920    ;   is_list(Summary)
 2921    ->  atom_codes(Atom, Summary)
 2922    ;   string(Summary)
 2923    ->  atom_concat(Summary, '', Atom)
 2924    ),
 2925    assert(defined_class(Name, Super, Atom, Src, Line)),
 2926    (   Meta = @(_)
 2927    ->  true
 2928    ;   assert_used_class(Src, Meta)
 2929    ),
 2930    assert_used_class(Src, Super).
 2931
 2932assert_defined_class(Src, Name, imported_from(_File)) :-
 2933    defined_class(Name, _, _, Src, _),
 2934    !.
 2935assert_defined_class(Src, Name, imported_from(File)) :-
 2936    assert(defined_class(Name, _, '', Src, file(File))).
 2937
 2938
 2939                /********************************
 2940                *            UTILITIES          *
 2941                ********************************/
 2942
 2943%!  generalise(+Callable, -General)
 2944%
 2945%   Generalise a callable term.
 2946
 2947generalise(Var, Var) :-
 2948    var(Var),
 2949    !.                    % error?
 2950generalise(pce_principal:send_implementation(Id, _, _),
 2951           pce_principal:send_implementation(Id, _, _)) :-
 2952    atom(Id),
 2953    !.
 2954generalise(pce_principal:get_implementation(Id, _, _, _),
 2955           pce_principal:get_implementation(Id, _, _, _)) :-
 2956    atom(Id),
 2957    !.
 2958generalise('<directive>'(Line), '<directive>'(Line)) :- !.
 2959generalise(test(Test), test(Test)) :-
 2960    current_test_unit(_,_),
 2961    ground(Test),
 2962    !.
 2963generalise(test(Test, _), test(Test, _)) :-
 2964    current_test_unit(_,_),
 2965    ground(Test),
 2966    !.
 2967generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !.
 2968generalise(Module:Goal0, Module:Goal) :-
 2969    atom(Module),
 2970    !,
 2971    generalise(Goal0, Goal).
 2972generalise(Term0, Term) :-
 2973    callable(Term0),
 2974    generalise_term(Term0, Term).
 2975
 2976
 2977                 /*******************************
 2978                 *      SOURCE MANAGEMENT       *
 2979                 *******************************/
 2980
 2981/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2982This section of the file contains   hookable  predicates to reason about
 2983sources. The built-in code here  can  only   deal  with  files. The XPCE
 2984library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we
 2985can do cross-referencing on PceEmacs edit   buffers.  Other examples for
 2986hooking can be databases, (HTTP) URIs, etc.
 2987- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2988
 2989:- multifile
 2990    prolog:xref_source_directory/2, % +Source, -Dir
 2991    prolog:xref_source_file/3.      % +Spec, -Path, +Options
 2992
 2993
 2994%!  xref_source_file(+Spec, -File, +Src) is semidet.
 2995%!  xref_source_file(+Spec, -File, +Src, +Options) is semidet.
 2996%
 2997%   Find named source file from Spec, relative to Src.
 2998
 2999xref_source_file(Plain, File, Source) :-
 3000    xref_source_file(Plain, File, Source, []).
 3001
 3002xref_source_file(QSpec, File, Source, Options) :-
 3003    nonvar(QSpec), QSpec = _:Spec,
 3004    !,
 3005    must_be(acyclic, Spec),
 3006    xref_source_file(Spec, File, Source, Options).
 3007xref_source_file(Spec, File, _Source, _Options) :-
 3008    is_stream(Spec), !,
 3009    File = Spec.
 3010xref_source_file(Spec, File, Source, Options) :-
 3011    nonvar(Spec),
 3012    prolog:xref_source_file(Spec, File,
 3013                            [ relative_to(Source)
 3014                            | Options
 3015                            ]),
 3016    !.
 3017xref_source_file(Plain, File, Source, Options) :-
 3018    atom(Plain),
 3019    \+ is_absolute_file_name(Plain),
 3020    (   prolog:xref_source_directory(Source, Dir)
 3021    ->  true
 3022    ;   atom(Source),
 3023        file_directory_name(Source, Dir)
 3024    ),
 3025    atomic_list_concat([Dir, /, Plain], Spec0),
 3026    absolute_file_name(Spec0, Spec),
 3027    do_xref_source_file(Spec, File, Options),
 3028    !.
 3029xref_source_file(Spec, File, Source, Options) :-
 3030    do_xref_source_file(Spec, File,
 3031                        [ relative_to(Source)
 3032                        | Options
 3033                        ]),
 3034    !.
 3035xref_source_file(_, _, _, Options) :-
 3036    option(silent(true), Options),
 3037    !,
 3038    fail.
 3039xref_source_file(Spec, _, Src, _Options) :-
 3040    verbose(Src),
 3041    print_message(warning, error(existence_error(file, Spec), _)),
 3042    fail.
 3043
 3044do_xref_source_file(Spec, File, Options) :-
 3045    nonvar(Spec),
 3046    option(file_type(Type), Options, prolog),
 3047    absolute_file_name(Spec, File0,
 3048                       [ file_type(Type),
 3049                         access(read),
 3050                         file_errors(fail)
 3051                       ]),
 3052    !,
 3053    qlf_pl_file(File0, File).
 3054do_xref_source_file(Spec, File, Options) :-
 3055    atom(Spec), % handle absolute /file/to/source.pl without sources
 3056    file_name_extension(Base, Ext, Spec),
 3057    user:prolog_file_type(Ext, source),
 3058    option(file_type(prolog), Options, prolog),
 3059    absolute_file_name(Base, File0,
 3060                       [ file_type(prolog),
 3061                         access(read),
 3062                         file_errors(fail)
 3063                       ]),
 3064    qlf_pl_file(File0, File).
 3065
 3066%!  qlf_pl_file(?QlfFile, ?PlFile) is semidet.
 3067
 3068qlf_pl_file(QlfFile, PlFile) :-
 3069    nonvar(QlfFile),
 3070    is_qlf_file(QlfFile),
 3071    !,
 3072    '$qlf_module'(QlfFile, Info),
 3073    #{file:PlFile} :< Info.
 3074qlf_pl_file(QlfFile, PlFile) :-
 3075    nonvar(PlFile),
 3076    !,
 3077    (   file_name_extension(Base, Ext, PlFile),
 3078        user:prolog_file_type(Ext, source)
 3079    ->  true
 3080    ),
 3081    (   user:prolog_file_type(QlfExt, qlf),
 3082        file_name_extension(Base, QlfExt, QlfFile),
 3083        exists_file(QlfFile)
 3084    ->  true
 3085    ),
 3086    '$qlf_module'(QlfFile, Info),
 3087    #{file:PlFile} :< Info,
 3088    !.
 3089qlf_pl_file(PlFile, PlFile).
 3090
 3091is_qlf_file(QlfFile) :-
 3092    file_name_extension(_, Ext, QlfFile),
 3093    user:prolog_file_type(Ext, qlf),
 3094    !.
 3095
 3096%!  canonical_source(?Source, ?Src) is det.
 3097%
 3098%   Src is the canonical version of Source if Source is given.
 3099
 3100canonical_source(Source, Src) :-
 3101    (   ground(Source)
 3102    ->  prolog_canonical_source(Source, Src)
 3103    ;   Source = Src
 3104    ).
 3105
 3106%!  goal_name_arity(+Goal, -Name, -Arity)
 3107%
 3108%   Generalized version of  functor/3  that   can  deal  with name()
 3109%   goals.
 3110
 3111goal_name_arity(Goal, Name, Arity) :-
 3112    (   compound(Goal)
 3113    ->  compound_name_arity(Goal, Name, Arity)
 3114    ;   atom(Goal)
 3115    ->  Name = Goal, Arity = 0
 3116    ).
 3117
 3118generalise_term(Specific, General) :-
 3119    (   compound(Specific)
 3120    ->  compound_name_arity(Specific, Name, Arity),
 3121        compound_name_arity(General, Name, Arity)
 3122    ;   General = Specific
 3123    ).
 3124
 3125functor_name(Term, Name) :-
 3126    (   compound(Term)
 3127    ->  compound_name_arity(Term, Name, _)
 3128    ;   atom(Term)
 3129    ->  Name = Term
 3130    ).
 3131
 3132rename_goal(Goal0, Name, Goal) :-
 3133    (   compound(Goal0)
 3134    ->  compound_name_arity(Goal0, _, Arity),
 3135        compound_name_arity(Goal, Name, Arity)
 3136    ;   Goal = Name
 3137    ).
 3138
 3139
 3140                /*******************************
 3141                *           MESSAGES           *
 3142                *******************************/<
 3143
 3144:- multifile prolog:message//1.
 3145
 3146prolog:message(meta_predicate_after_call(Decl, By)) -->
 3147    { pi_head(ByPI, By) },
 3148    [ ansi(code, ':- meta_predicate(~p)', [Decl]),
 3149      ' declaration appears after call from '-[],
 3150      ansi(code, '~p', [ByPI])
 3151    ]