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