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