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