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