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