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