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