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