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