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