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