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