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