1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2005-2024, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(prolog_clause,
   39          [ clause_info/4,              % +ClauseRef, -File, -TermPos, -VarNames
   40            clause_info/5,              % +ClauseRef, -File, -TermPos, -VarNames,
   41                                        % +Options
   42            initialization_layout/4,    % +SourceLoc, +Goal, -Term, -TermPos
   43            predicate_name/2,           % +Head, -Name
   44            clause_name/2               % +ClauseRef, -Name
   45          ]).   46:- use_module(library(debug),[debugging/1,debug/3]).   47:- autoload(library(listing),[portray_clause/1]).   48:- autoload(library(lists),[append/3]).   49:- autoload(library(occurs),[sub_term/2]).   50:- autoload(library(option),[option/3]).   51:- autoload(library(prolog_source),[read_source_term_at_location/3]).   52
   53
   54:- public                               % called from library(trace/clause)
   55    unify_term/2,
   56    make_varnames/5,
   57    do_make_varnames/3.   58
   59:- multifile
   60    unify_goal/5,                   % +Read, +Decomp, +M, +Pos, -Pos
   61    unify_clause_hook/5,
   62    make_varnames_hook/5,
   63    open_source/2.                  % +Input, -Stream
   64
   65:- predicate_options(prolog_clause:clause_info/5, 5,
   66                     [ head(-any),
   67                       body(-any),
   68                       variable_names(-list)
   69                     ]).   70
   71/** <module> Get detailed source-information about a clause
   72
   73This module started life as part of the   GUI tracer. As it is generally
   74useful for debugging  purposes  it  has   moved  to  the  general Prolog
   75library.
   76
   77The tracer library library(trace/clause) adds   caching and dealing with
   78dynamic predicates using listing to  XPCE   objects  to  this. Note that
   79clause_info/4 as below can be slow.
   80*/
   81
   82%!  clause_info(+ClauseRef, -File, -TermPos, -VarOffsets) is semidet.
   83%!  clause_info(+ClauseRef, -File, -TermPos, -VarOffsets, +Options) is semidet.
   84%
   85%   Fetches source information for the  given   clause.  File is the
   86%   file from which the clause  was   loaded.  TermPos describes the
   87%   source layout in a format   compatible  to the subterm_positions
   88%   option  of  read_term/2.  VarOffsets  provides   access  to  the
   89%   variable allocation in a stack-frame.   See  make_varnames/5 for
   90%   details.
   91%
   92%   Note that positions are  _|character   positions|_,  i.e., _not_
   93%   bytes. Line endings count as a   single character, regardless of
   94%   whether the actual ending is =|\n|= or =|\r\n|_.
   95%
   96%   Defined options are:
   97%
   98%     - variable_names(-Names)
   99%       Unify Names with the variable names list (Name=Var) as
  100%       returned by read_term/3.  This argument is intended for
  101%       reporting source locations and refactoring based on
  102%       analysis of the compiled code.
  103%     - head(-Head)
  104%     - body(-Body)
  105%       Get the head and body as terms.   This is similar to
  106%       clause/3, but a seperate call would break the variable
  107%       identity.
  108
  109clause_info(ClauseRef, File, TermPos, NameOffset) :-
  110    clause_info(ClauseRef, File, TermPos, NameOffset, []).
  111
  112clause_info(ClauseRef, File, TermPos, NameOffset, Options) :-
  113    (   debugging(clause_info)
  114    ->  clause_name(ClauseRef, Name),
  115        debug(clause_info, 'clause_info(~w) (~w)... ',
  116              [ClauseRef, Name])
  117    ;   true
  118    ),
  119    clause_property(ClauseRef, file(File)),
  120    File \== user,                  % loaded using ?- [user].
  121    '$clause'(Head0, Body, ClauseRef, VarOffset),
  122    option(head(Head0), Options, _),
  123    option(body(Body), Options, _),
  124    (   module_property(Module, file(File))
  125    ->  true
  126    ;   strip_module(user:Head0, Module, _)
  127    ),
  128    unqualify(Head0, Module, Head),
  129    (   Body == true
  130    ->  DecompiledClause = Head
  131    ;   DecompiledClause = (Head :- Body)
  132    ),
  133    clause_property(ClauseRef, line_count(LineNo)),
  134    debug(clause_info, 'from ~w:~d ... ', [File, LineNo]),
  135    read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames),
  136    option(variable_names(VarNames), Options, _),
  137    debug(clause_info, 'read ...', []),
  138    unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos),
  139    debug(clause_info, 'unified ...', []),
  140    make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset),
  141    debug(clause_info, 'got names~n', []),
  142    !.
  143
  144unqualify(Module:Head, Module, Head) :-
  145    !.
  146unqualify(Head, _, Head).
  147
  148
  149%!  unify_term(+T1, +T2)
  150%
  151%   Unify the two terms, where T2 is created by writing the term and
  152%   reading it back in, but  be   aware  that  rounding problems may
  153%   cause floating point numbers not to  unify. Also, if the initial
  154%   term has a string object, it is written   as "..." and read as a
  155%   code-list. We compensate for that.
  156%
  157%   NOTE: Called directly from  library(trace/clause)   for  the GUI
  158%   tracer.
  159
  160unify_term(X, X) :- !.
  161unify_term(X1, X2) :-
  162    compound(X1),
  163    compound(X2),
  164    functor(X1, F, Arity),
  165    functor(X2, F, Arity),
  166    !,
  167    unify_args(0, Arity, X1, X2).
  168unify_term(X, Y) :-
  169    float(X), float(Y),
  170    !.
  171unify_term(X, '$BLOB'(_)) :-
  172    blob(X, _),
  173    \+ atom(X).
  174unify_term(X, Y) :-
  175    string(X),
  176    is_list(Y),
  177    string_codes(X, Y),
  178    !.
  179unify_term(_, Y) :-
  180    Y == '...',
  181    !.                          % elipses left by max_depth
  182unify_term(_:X, Y) :-
  183    unify_term(X, Y),
  184    !.
  185unify_term(X, _:Y) :-
  186    unify_term(X, Y),
  187    !.
  188unify_term(X, Y) :-
  189    format('[INTERNAL ERROR: Diff:~n'),
  190    portray_clause(X),
  191    format('~N*** <->~n'),
  192    portray_clause(Y),
  193    break.
  194
  195unify_args(N, N, _, _) :- !.
  196unify_args(I, Arity, T1, T2) :-
  197    A is I + 1,
  198    arg(A, T1, A1),
  199    arg(A, T2, A2),
  200    unify_term(A1, A2),
  201    unify_args(A, Arity, T1, T2).
  202
  203
  204%!  read_term_at_line(+File, +Line, +Module,
  205%!                    -Clause, -TermPos, -VarNames) is semidet.
  206%
  207%   Read a term from File at Line.
  208
  209read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :-
  210    setup_call_cleanup(
  211        '$push_input_context'(clause_info),
  212        read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames),
  213        '$pop_input_context').
  214
  215read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :-
  216    catch(try_open_source(File, In), error(_,_), fail),
  217    set_stream(In, newline(detect)),
  218    call_cleanup(
  219        read_source_term_at_location(
  220            In, Clause,
  221            [ line(Line),
  222              module(Module),
  223              subterm_positions(TermPos),
  224              variable_names(VarNames)
  225            ]),
  226        close(In)).
  227
  228%!  open_source(+File, -Stream) is semidet.
  229%
  230%   Hook into clause_info/5 that opens the stream holding the source
  231%   for a specific clause. Thus, the query must succeed. The default
  232%   implementation calls open/3 on the `File` property.
  233%
  234%     ==
  235%     clause_property(ClauseRef, file(File)),
  236%     prolog_clause:open_source(File, Stream)
  237%     ==
  238
  239:- public try_open_source/2.            % used by library(prolog_breakpoints).
  240
  241try_open_source(File, In) :-
  242    open_source(File, In),
  243    !.
  244try_open_source(File, In) :-
  245    open(File, read, In, [reposition(true)]).
  246
  247
  248%!  make_varnames(+ReadClause, +DecompiledClause,
  249%!                +Offsets, +Names, -Term) is det.
  250%
  251%   Create a Term varnames(...) where each argument contains the name
  252%   of the variable at that offset.  If the read Clause is a DCG rule,
  253%   name the two last arguments <DCG_list> and <DCG_tail>
  254%
  255%   This    predicate    calles     the      multifile     predicate
  256%   make_varnames_hook/5 with the same arguments   to allow for user
  257%   extensions. Extending this predicate  is   needed  if a compiler
  258%   adds additional arguments to the clause   head that must be made
  259%   visible in the GUI tracer.
  260%
  261%   @param Offsets  List of Offset=Var
  262%   @param Names    List of Name=Var
  263
  264make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :-
  265    make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term),
  266    !.
  267make_varnames(ReadClause, _, Offsets, Names, Bindings) :-
  268    dcg_head(ReadClause, Head),
  269    !,
  270    functor(Head, _, Arity),
  271    In is Arity,
  272    memberchk(In=IVar, Offsets),
  273    Names1 = ['<DCG_list>'=IVar|Names],
  274    Out is Arity + 1,
  275    memberchk(Out=OVar, Offsets),
  276    Names2 = ['<DCG_tail>'=OVar|Names1],
  277    make_varnames(xx, xx, Offsets, Names2, Bindings).
  278make_varnames(_, _, Offsets, Names, Bindings) :-
  279    length(Offsets, L),
  280    functor(Bindings, varnames, L),
  281    do_make_varnames(Offsets, Names, Bindings).
  282
  283dcg_head((Head,_ --> _Body), Head).
  284dcg_head((Head   --> _Body), Head).
  285dcg_head((Head,_ ==> _Body), Head).
  286dcg_head((Head   ==> _Body), Head).
  287
  288do_make_varnames([], _, _).
  289do_make_varnames([N=Var|TO], Names, Bindings) :-
  290    (   find_varname(Var, Names, Name)
  291    ->  true
  292    ;   Name = '_'
  293    ),
  294    AN is N + 1,
  295    arg(AN, Bindings, Name),
  296    do_make_varnames(TO, Names, Bindings).
  297
  298find_varname(Var, [Name = TheVar|_], Name) :-
  299    Var == TheVar,
  300    !.
  301find_varname(Var, [_|T], Name) :-
  302    find_varname(Var, T, Name).
  303
  304%!  unify_clause(+Read, +Decompiled, +Module, +ReadTermPos,
  305%!               -RecompiledTermPos).
  306%
  307%   What you read isn't always what goes into the database. The task
  308%   of this predicate is to establish  the relation between the term
  309%   read from the file and the result from decompiling the clause.
  310%
  311%   This predicate calls the multifile predicate unify_clause_hook/5
  312%   with the same arguments to support user extensions.
  313%
  314%   @arg Module is the source module that   was active when loading this
  315%   clause,  which  is  the  same  as  prolog_load_context/2  using  the
  316%   `module` context. If this cannot be established  it is the module to
  317%   which the clause itself is associated.   The argument may be used to
  318%   determine whether or not a specific user transformation is in scope.
  319%   See also term_expansion/2,4 and goal_expansion/2,4.
  320%
  321%   @tbd    This really must be  more   flexible,  dealing with much
  322%           more complex source-translations,  falling   back  to  a
  323%           heuristic method locating as much as possible.
  324
  325unify_clause(Read, _, _, _, _) :-
  326    var(Read),
  327    !,
  328    fail.
  329unify_clause((RHead :- RBody), (CHead :- CBody), Module, TermPos1, TermPos) :-
  330    '$expand':f2_pos(TermPos1, HPos, BPos1,
  331                     TermPos2, HPos, BPos2),
  332    inlined_unification(RBody, CBody, RBody1, CBody1, RHead,
  333                        BPos1, BPos2),
  334    RBody1 \== RBody,
  335    !,
  336    unify_clause2((RHead :- RBody1), (CHead :- CBody1), Module,
  337                  TermPos2, TermPos).
  338unify_clause(Read, Decompiled, _, TermPos, TermPos) :-
  339    Read =@= Decompiled,
  340    !,
  341    Read = Decompiled.
  342unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  343    unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos),
  344    !.
  345                                        % XPCE send-methods
  346unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  347    !,
  348    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  349                                        % XPCE get-methods
  350unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  351    !,
  352    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  353                                        % Unit test clauses
  354unify_clause((TH :- RBody), (CH :- !, CBody), Module, TP0, TP) :-
  355    plunit_source_head(TH),
  356    plunit_compiled_head(CH),
  357    !,
  358    TP0 = term_position(F,T,FF,FT,[HP,BP0]),
  359    ubody(RBody, CBody, Module, BP0, BP),
  360    TP  = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
  361                                        % module:head :- body
  362unify_clause((Head :- Read),
  363             (Head :- _M:Compiled), Module, TermPos0, TermPos) :-
  364    unify_clause2((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
  365    TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
  366    TermPos  = term_position(TA,TZ,FA,FZ,
  367                             [ PH,
  368                               term_position(0,0,0,0,[0-0,PB])
  369                             ]).
  370                                        % DCG rules
  371unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  372    Read = (_ --> Terminal0, _),
  373    (   is_list(Terminal0)
  374    ->  Terminal = Terminal0
  375    ;   string(Terminal0)
  376    ->  string_codes(Terminal0, Terminal)
  377    ),
  378    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  379    (   dcg_unify_in_head(Compiled2, Compiled3)
  380    ->  true
  381    ;   Compiled2 = (DH :- _CBody),
  382        functor(DH, _, Arity),
  383        DArg is Arity - 1,
  384        append(Terminal, _Tail, List),
  385        arg(DArg, DH, List),
  386        Compiled3 = Compiled2
  387    ),
  388    TermPos1 = term_position(F,T,FF,FT,[ HP,
  389                                         term_position(_,_,_,_,[_,BP])
  390                                       ]),
  391    !,
  392    TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]),
  393    match_module(Compiled3, Compiled1, Module, TermPos2, TermPos).
  394                                               % SSU rules
  395unify_clause((Head,RCond => Body), (CHead :- CCondAndBody), Module,
  396             term_position(F,T,FF,FT,
  397                           [ term_position(_,_,_,_,[HP,CP]),
  398                             BP
  399                           ]),
  400             TermPos) :-
  401    split_on_cut(CCondAndBody, CCond, CBody0),
  402    !,
  403    inlined_unification(RCond, CCond, RCond1, CCond1, Head, CP, CP1),
  404    TermPos1 = term_position(F,T,FF,FT, [HP, BP1]),
  405    BP2 = term_position(_,_,_,_, [FF-FT, BP]), % Represent (!, Body), placing
  406    (   CCond1 == true                         % ! at =>
  407    ->  BP1 = BP2,                             % Whole guard is inlined
  408        unify_clause2((Head :- !, Body), (CHead :- !, CBody0),
  409                      Module, TermPos1, TermPos)
  410    ;   mkconj_pos(RCond1, CP1, (!,Body), BP2, RBody, BP1),
  411        mkconj_npos(CCond1, (!,CBody0), CBody),
  412        unify_clause2((Head :- RBody), (CHead :- CBody),
  413                      Module, TermPos1, TermPos)
  414    ).
  415unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :-
  416    !,
  417    unify_clause2((Head :- Body), Compiled1, Module, TermPos0, TermPos).
  418unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  419    Read = (_ ==> _),
  420    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  421    Compiled2 \= (_ ==> _),
  422    !,
  423    unify_clause(Compiled2, Compiled1, Module, TermPos1, TermPos).
  424unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  425    unify_clause2(Read, Decompiled, Module, TermPos0, TermPos).
  426
  427dcg_unify_in_head((Head :- L1=L2, Body), (Head :- Body)) :-
  428    functor(Head, _, Arity),
  429    DArg is Arity - 1,
  430    arg(DArg, Head, L0),
  431    L0 == L1,
  432    L1 = L2.
  433
  434% mkconj, but also unify position info
  435mkconj_pos((A,B), term_position(F,T,FF,FT,[PA,PB]), Ex, ExPos, Code, Pos) =>
  436    Code = (A,B1),
  437    Pos = term_position(F,T,FF,FT,[PA,PB1]),
  438    mkconj_pos(B, PB, Ex, ExPos, B1, PB1).
  439mkconj_pos(Last, LastPos, Ex, ExPos, Code, Pos) =>
  440    Code = (Last,Ex),
  441    Pos = term_position(_,_,_,_,[LastPos,ExPos]).
  442
  443% similar to mkconj, but we should __not__ optimize `true` away.
  444mkconj_npos((A,B), Ex, Code) =>
  445    Code = (A,B1),
  446    mkconj_npos(B, Ex, B1).
  447mkconj_npos(A, Ex, Code) =>
  448    Code = (A,Ex).
  449
  450%!  unify_clause2(+Read, +Decompiled, +Module, +TermPosIn, -TermPosOut)
  451%
  452%   Stratified version to be used after the first match
  453
  454unify_clause2(Read, Decompiled, _, TermPos, TermPos) :-
  455    Read =@= Decompiled,
  456    !,
  457    Read = Decompiled.
  458unify_clause2(Read, Compiled1, Module, TermPos0, TermPos) :-
  459    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  460    match_module(Compiled2, Compiled1, Module, TermPos1, TermPos),
  461    !.
  462unify_clause2(_, _, _, _, _) :-       % I don't know ...
  463    debug(clause_info, 'Could not unify clause', []),
  464    fail.
  465
  466unify_clause_head(H1, H2) :-
  467    strip_module(H1, _, H),
  468    strip_module(H2, _, H).
  469
  470plunit_source_head(test(_,_)) => true.
  471plunit_source_head(test(_)) => true.
  472plunit_source_head(_) => fail.
  473
  474plunit_compiled_head(_:'unit body'(_, _)) => true.
  475plunit_compiled_head('unit body'(_, _)) => true.
  476plunit_compiled_head(_) => fail.
  477
  478%!  inlined_unification(+BodyRead, +BodyCompiled,
  479%!                      -BodyReadOut, -BodyCompiledOut,
  480%!                      +HeadRead,
  481%!                      +BodyPosIn, -BodyPosOut) is det.
  482
  483inlined_unification((V=T,RBody0), (CV=CT,CBody0),
  484                    RBody, CBody, RHead, BPos1, BPos),
  485    inlineable_head_var(RHead, V2),
  486    V == V2,
  487    (V=T) =@= (CV=CT) =>
  488    argpos(2, BPos1, BPos2),
  489    inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos).
  490inlined_unification((V=T), (CV=CT),
  491                    RBody, CBody, RHead, BPos1, BPos),
  492    inlineable_head_var(RHead, V2),
  493    V == V2,
  494    (V=T) =@= (CV=CT) =>
  495    RBody = true,
  496    CBody = true,
  497    argpos(2, BPos1, BPos).
  498inlined_unification((V=T,RBody0), CBody0,
  499                    RBody, CBody, RHead, BPos1, BPos),
  500    inlineable_head_var(RHead, V2),
  501    V == V2,
  502    \+ (CBody0 = (G1,_), G1 =@= (V=T)) =>
  503    argpos(2, BPos1, BPos2),
  504    inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos).
  505inlined_unification((V=_), true,
  506                    RBody, CBody, RHead, BPos1, BPos),
  507    inlineable_head_var(RHead, V2),
  508    V == V2 =>
  509    RBody = true,
  510    CBody = true,
  511    argpos(2, BPos1, BPos).
  512inlined_unification(RBody0, CBody0, RBody, CBody, _RHead,
  513                    BPos0, BPos) =>
  514    RBody = RBody0,
  515    BPos  = BPos0,
  516    CBody = CBody0.
  517
  518%!  inlineable_head_var(+Head, -Var) is nondet
  519%
  520%   True when Var is a variable in  Head   that  may  be used for inline
  521%   unification. Currently we only inline direct arguments to the head.
  522
  523inlineable_head_var(Head, Var) :-
  524    compound(Head),
  525    arg(_, Head, Var).
  526
  527split_on_cut((Cond0,!,Body0), Cond, Body) =>
  528    Cond = Cond0,
  529    Body = Body0.
  530split_on_cut((!,Body0), Cond, Body) =>
  531    Cond = true,
  532    Body = Body0.
  533split_on_cut((A,B), Cond, Body) =>
  534    Cond = (A,Cond1),
  535    split_on_cut(B, Cond1, Body).
  536split_on_cut(_, _, _) =>
  537    fail.
  538
  539ci_expand(Read, Compiled, Module, TermPos0, TermPos) :-
  540    catch(setup_call_cleanup(
  541              ( set_xref_flag(OldXRef),
  542                '$set_source_module'(Old, Module)
  543              ),
  544              expand_term(Read, TermPos0, Compiled, TermPos),
  545              ( '$set_source_module'(Old),
  546                set_prolog_flag(xref, OldXRef)
  547              )),
  548          E,
  549          expand_failed(E, Read)),
  550    compound(TermPos),                  % make sure somthing is filled.
  551    arg(1, TermPos, A1), nonvar(A1),
  552    arg(2, TermPos, A2), nonvar(A2).
  553
  554set_xref_flag(Value) :-
  555    current_prolog_flag(xref, Value),
  556    !,
  557    set_prolog_flag(xref, true).
  558set_xref_flag(false) :-
  559    create_prolog_flag(xref, true, [type(boolean)]).
  560
  561match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :-
  562    !,
  563    unify_clause_head(H1, H2),
  564    unify_body(B1, B2, Module, Pos0, Pos).
  565match_module((H1 :- B1), H2, _Module, Pos0, Pos) :-
  566    B1 == true,
  567    unify_clause_head(H1, H2),
  568    Pos = Pos0,
  569    !.
  570match_module(H1, H2, _, Pos, Pos) :-    % deal with facts
  571    unify_clause_head(H1, H2).
  572
  573%!  expand_failed(+Exception, +Term)
  574%
  575%   When debugging, indicate that expansion of the term failed.
  576
  577expand_failed(E, Read) :-
  578    debugging(clause_info),
  579    message_to_string(E, Msg),
  580    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  581    fail.
  582
  583%!  unify_body(+Read, +Decompiled, +Module, +Pos0, -Pos)
  584%
  585%   Deal with translations implied by the compiler.  For example,
  586%   compiling (a,b),c yields the same code as compiling a,b,c.
  587%
  588%   Pos0 and Pos still include the term-position of the head.
  589
  590unify_body(B, C, _, Pos, Pos) :-
  591    B =@= C, B = C,
  592    does_not_dcg_after_binding(B, Pos),
  593    !.
  594unify_body(R, D, Module,
  595           term_position(F,T,FF,FT,[HP,BP0]),
  596           term_position(F,T,FF,FT,[HP,BP])) :-
  597    ubody(R, D, Module, BP0, BP).
  598
  599%!  does_not_dcg_after_binding(+ReadBody, +ReadPos) is semidet.
  600%
  601%   True  if  ReadPos/ReadPos  does   not    contain   DCG   delayed
  602%   unifications.
  603%
  604%   @tbd    We should pass that we are in a DCG; if we are not there
  605%           is no reason for this test.
  606
  607does_not_dcg_after_binding(B, Pos) :-
  608    \+ sub_term(brace_term_position(_,_,_), Pos),
  609    \+ (sub_term((Cut,_=_), B), Cut == !),
  610    !.
  611
  612
  613/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  614Some remarks.
  615
  616a --> { x, y, z }.
  617    This is translated into "(x,y),z), X=Y" by the DCG translator, after
  618    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
  619- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  620
  621%!  unify_goal(+Read, +Decompiled, +Module,
  622%!             +TermPosRead, -TermPosDecompiled) is semidet.
  623%
  624%   This hook is called to  fix   up  source code manipulations that
  625%   result from goal expansions.
  626
  627%!  ubody(+Read, +Decompiled, +Module, +TermPosRead, -TermPosForDecompiled)
  628%
  629%   @arg Read             Clause read _after_ expand_term/2
  630%   @arg Decompiled       Decompiled clause
  631%   @arg Module           Load module
  632%   @arg TermPosRead      Sub-term positions of source
  633
  634ubody(B, DB, _, P, P) :-
  635    var(P),                        % TBD: Create compatible pos term?
  636    !,
  637    B = DB.
  638ubody(B, C, _, P, P) :-
  639    B =@= C, B = C,
  640    does_not_dcg_after_binding(B, P),
  641    !.
  642ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :-
  643    !,
  644    ubody(X0, X, M, P0, P).
  645ubody(X, Y, _,                    % X = call(X)
  646      Pos,
  647      term_position(From, To, From, To, [Pos])) :-
  648    nonvar(Y),
  649    Y = call(X),
  650    !,
  651    arg(1, Pos, From),
  652    arg(2, Pos, To).
  653ubody(A, B, _, P1, P2) :-
  654    nonvar(A), A = (_=_),
  655    nonvar(B), B = (LB=RB),
  656    A =@= (RB=LB),
  657    !,
  658    P1 = term_position(F,T, FF,FT, [PL,PR]),
  659    P2 = term_position(F,T, FF,FT, [PR,PL]).
  660ubody(A, B, _, P1, P2) :-
  661    nonvar(A), A = (_==_),
  662    nonvar(B), B = (LB==RB),
  663    A =@= (RB==LB),
  664    !,
  665    P1 = term_position(F,T, FF,FT, [PL,PR]),
  666    P2 = term_position(F,T, FF,FT, [PR,PL]).
  667ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :-
  668    nonvar(B), B = M:R,
  669    ubody(R, D, M, RP, TPOut).
  670ubody(B, D, M, term_position(_,_,_,_,[RP0,RP1]), TPOut) :-
  671    nonvar(B), B = (B0,B1),
  672    (   maybe_optimized(B0),
  673        ubody(B1, D, M, RP1, TPOut)
  674    ->  true
  675    ;   maybe_optimized(B1),
  676        ubody(B0, D, M, RP0, TPOut)
  677    ),
  678    !.
  679ubody(B0, B, M,
  680      brace_term_position(F,T,A0),
  681      Pos) :-
  682    B0 = (_,_=_),
  683    !,
  684    T1 is T - 1,
  685    ubody(B0, B, M,
  686          term_position(F,T,
  687                        F,T,
  688                        [A0,T1-T]),
  689          Pos).
  690ubody(B0, B, M,
  691      brace_term_position(F,T,A0),
  692      term_position(F,T,F,T,[A])) :-
  693    !,
  694    ubody(B0, B, M, A0, A).
  695ubody(C0, C, M, P0, P) :-
  696    nonvar(C0), nonvar(C),
  697    C0 = (_,_), C = (_,_),
  698    !,
  699    conj(C0, P0, GL, PL),
  700    mkconj(C, M, P, GL, PL).
  701ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :-
  702    unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled),
  703    !.
  704ubody(X0, X, M,
  705      term_position(F,T,FF,TT,PA0),
  706      term_position(F,T,FF,TT,PA)) :-
  707    callable(X0),
  708    callable(X),
  709    meta(M, X0, S),
  710    !,
  711    X0 =.. [_|A0],
  712    X  =.. [_|A],
  713    S =.. [_|AS],
  714    ubody_list(A0, A, AS, M, PA0, PA).
  715ubody(X0, X, M,
  716      term_position(F,T,FF,TT,PA0),
  717      term_position(F,T,FF,TT,PA)) :-
  718    expand_goal(X0, X1, M, PA0, PA),
  719    X1 =@= X,
  720    X1 = X.
  721
  722                                        % 5.7.X optimizations
  723ubody(_=_, true, _,                     % singleton = Any
  724      term_position(F,T,_FF,_TT,_PA),
  725      F-T) :- !.
  726ubody(_==_, fail, _,                    % singleton/firstvar == Any
  727      term_position(F,T,_FF,_TT,_PA),
  728      F-T) :- !.
  729ubody(A1=B1, B2=A2, _,                  % Term = Var --> Var = Term
  730      term_position(F,T,FF,TT,[PA1,PA2]),
  731      term_position(F,T,FF,TT,[PA2,PA1])) :-
  732    var(B1), var(B2),
  733    (A1==B1) =@= (B2==A2),
  734    !,
  735    A1 = A2, B1=B2.
  736ubody(A1==B1, B2==A2, _,                % const == Var --> Var == const
  737      term_position(F,T,FF,TT,[PA1,PA2]),
  738      term_position(F,T,FF,TT,[PA2,PA1])) :-
  739    var(B1), var(B2),
  740    (A1==B1) =@= (B2==A2),
  741    !,
  742    A1 = A2, B1=B2.
  743ubody(A is B - C, A is B + C2, _, Pos, Pos) :-
  744    integer(C),
  745    C2 =:= -C,
  746    !.
  747
  748ubody_list([], [], [], _, [], []).
  749ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
  750    ubody_elem(AS, G0, G, M, PA0, PA),
  751    ubody_list(T0, T, ASL, M, PAT0, PAT).
  752
  753ubody_elem(0, G0, G, M, PA0, PA) :-
  754    !,
  755    ubody(G0, G, M, PA0, PA).
  756ubody_elem(_, G, G, _, PA, PA).
  757
  758%!  conj(+GoalTerm, +PositionTerm, -GoalList, -PositionList)
  759%
  760%   Turn a conjunctive body into a list   of  goals and their positions,
  761%   i.e., removing the positions of the (,)/2 terms.
  762
  763conj(Goal, Pos, GoalList, PosList) :-
  764    conj(Goal, Pos, GoalList, [], PosList, []).
  765
  766conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
  767    !,
  768    conj(A, PA, GL, TGA, PL, TPA),
  769    conj(B, PB, TGA, TG, TPA, TP).
  770conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
  771    B = (_=_),
  772    !,
  773    conj(A, PA, GL, TGA, PL, TPA),
  774    T1 is T - 1,
  775    conj(B, T1-T, TGA, TG, TPA, TP).
  776conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :-
  777    nonvar(Pos),
  778    !,
  779    conj(A, Pos, GL, TG, PL, TP).
  780conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
  781    F1 is F+1,
  782    T1 is T+1.
  783conj(A, P, [A|TG], TG, [P|TP], TP).
  784
  785
  786%!  mkconj(+Decompiled, +Module, -Position, +ReadGoals, +ReadPositions)
  787
  788mkconj(Goal, M, Pos, GoalList, PosList) :-
  789    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
  790
  791mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
  792    nonvar(Conj),
  793    Conj = (A,B),
  794    !,
  795    mkconj(A, M, PA, GL, TGA, PL, TPA),
  796    mkconj(B, M, PB, TGA, TG, TPA, TP).
  797mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
  798    ubody(A, A0, M, P, P0),
  799    !.
  800mkconj(A0, M, P0, [RG|TG0], TG, [_|TP0], TP) :-
  801    maybe_optimized(RG),
  802    mkconj(A0, M, P0, TG0, TG, TP0, TP).
  803
  804maybe_optimized(debug(_,_,_)).
  805maybe_optimized(assertion(_)).
  806maybe_optimized(true).
  807
  808%!  argpos(+N, +PositionTerm, -ArgPositionTerm) is det.
  809%
  810%   Get the position for the nth argument of PositionTerm.
  811
  812argpos(N, parentheses_term_position(_,_,PosIn), Pos) =>
  813    argpos(N, PosIn, Pos).
  814argpos(N, term_position(_,_,_,_,ArgPos), Pos) =>
  815    nth1(N, ArgPos, Pos).
  816argpos(_, _, _) => true.
  817
  818
  819                 /*******************************
  820                 *    PCE STUFF (SHOULD MOVE)   *
  821                 *******************************/
  822
  823/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  824        <method>(Receiver, ... Arg ...) :->
  825                Body
  826
  827mapped to:
  828
  829        send_implementation(Id, <method>(...Arg...), Receiver)
  830
  831- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  832
  833pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
  834    !,
  835    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
  836pce_method_clause(Head, Body,
  837                  send_implementation(_Id, Msg, Receiver), PlBody,
  838                  M, TermPos0, TermPos) :-
  839    !,
  840    debug(clause_info, 'send method ...', []),
  841    arg(1, Head, Receiver),
  842    functor(Head, _, Arity),
  843    pce_method_head_arguments(2, Arity, Head, Msg),
  844    debug(clause_info, 'head ...', []),
  845    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  846pce_method_clause(Head, Body,
  847                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
  848                  M, TermPos0, TermPos) :-
  849    !,
  850    debug(clause_info, 'get method ...', []),
  851    arg(1, Head, Receiver),
  852    debug(clause_info, 'receiver ...', []),
  853    functor(Head, _, Arity),
  854    arg(Arity, Head, PceResult),
  855    debug(clause_info, '~w?~n', [PceResult = Result]),
  856    pce_unify_head_arg(PceResult, Result),
  857    Ar is Arity - 1,
  858    pce_method_head_arguments(2, Ar, Head, Msg),
  859    debug(clause_info, 'head ...', []),
  860    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  861
  862pce_method_head_arguments(N, Arity, Head, Msg) :-
  863    N =< Arity,
  864    !,
  865    arg(N, Head, PceArg),
  866    PLN is N - 1,
  867    arg(PLN, Msg, PlArg),
  868    pce_unify_head_arg(PceArg, PlArg),
  869    debug(clause_info, '~w~n', [PceArg = PlArg]),
  870    NextArg is N+1,
  871    pce_method_head_arguments(NextArg, Arity, Head, Msg).
  872pce_method_head_arguments(_, _, _, _).
  873
  874pce_unify_head_arg(V, A) :-
  875    var(V),
  876    !,
  877    V = A.
  878pce_unify_head_arg(A:_=_, A) :- !.
  879pce_unify_head_arg(A:_, A).
  880
  881%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
  882%
  883%       Unify the body of an XPCE method.  Goal-expansion makes this
  884%       rather tricky, especially as we cannot call XPCE's expansion
  885%       on an isolated method.
  886%
  887%       TermPos0 is the term-position term of the whole clause!
  888%
  889%       Further, please note that the body of the method-clauses reside
  890%       in another module than pce_principal, and therefore the body
  891%       starts with an I_CONTEXT call. This implies we need a
  892%       hypothetical term-position for the module-qualifier.
  893
  894pce_method_body(A0, A, M, TermPos0, TermPos) :-
  895    TermPos0 = term_position(F, T, FF, FT,
  896                             [ HeadPos,
  897                               BodyPos0
  898                             ]),
  899    TermPos  = term_position(F, T, FF, FT,
  900                             [ HeadPos,
  901                               term_position(0,0,0,0, [0-0,BodyPos])
  902                             ]),
  903    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
  904
  905
  906pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
  907    !,
  908    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
  909    TermPos  = BodyPos,
  910    expand_goal(A0, A, M, BodyPos0, BodyPos).
  911pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  912    A0 =.. [Func,B0,C0],
  913    control_op(Func),
  914    !,
  915    A =.. [Func,B,C],
  916    TermPos0 = term_position(F, T, FF, FT,
  917                             [ BP0,
  918                               CP0
  919                             ]),
  920    TermPos  = term_position(F, T, FF, FT,
  921                             [ BP,
  922                               CP
  923                             ]),
  924    pce_method_body2(B0, B, M, BP0, BP),
  925    expand_goal(C0, C, M, CP0, CP).
  926pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  927    expand_goal(A0, A, M, TermPos0, TermPos).
  928
  929control_op(',').
  930control_op((;)).
  931control_op((->)).
  932control_op((*->)).
  933
  934                 /*******************************
  935                 *     EXPAND_GOAL SUPPORT      *
  936                 *******************************/
  937
  938/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  939With the introduction of expand_goal, it  is increasingly hard to relate
  940the clause from the database to the actual  source. For one thing, we do
  941not know the compilation  module  of  the   clause  (unless  we  want to
  942decompile it).
  943
  944Goal expansion can translate  goals   into  control-constructs, multiple
  945clauses, or delete a subgoal.
  946
  947To keep track of the source-locations, we   have to redo the analysis of
  948the clause as defined in init.pl
  949- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  950
  951expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
  952    var(G),
  953    !.
  954expand_goal(G, G1, _, P, P) :-
  955    var(G),
  956    !,
  957    G1 = G.
  958expand_goal(M0, M, Module, P0, P) :-
  959    meta(Module, M0, S),
  960    !,
  961    P0 = term_position(F,T,FF,FT,PL0),
  962    P  = term_position(F,T,FF,FT,PL),
  963    functor(M0, Functor, Arity),
  964    functor(M,  Functor, Arity),
  965    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
  966expand_goal(A, B, Module, P0, P) :-
  967    goal_expansion(A, B0, P0, P1),
  968    !,
  969    expand_goal(B0, B, Module, P1, P).
  970expand_goal(A, A, _, P, P).
  971
  972expand_meta_args([],      [],   _,  _, _,      _,  _).
  973expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
  974    arg(I, M0, A0),
  975    arg(I, M,  A),
  976    arg(I, S,  AS),
  977    expand_arg(AS, A0, A, Module, P0, P),
  978    NI is I + 1,
  979    expand_meta_args(T0, T, NI, S, Module, M0, M).
  980
  981expand_arg(0, A0, A, Module, P0, P) :-
  982    !,
  983    expand_goal(A0, A, Module, P0, P).
  984expand_arg(_, A, A, _, P, P).
  985
  986meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
  987
  988goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
  989    compound(Msg),
  990    Msg =.. [send_super, Selector | Args],
  991    !,
  992    SuperMsg =.. [Selector|Args].
  993goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
  994    compound(Msg),
  995    Msg =.. [get_super, Selector | Args],
  996    !,
  997    SuperMsg =.. [Selector|Args].
  998goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
  999goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
 1000goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
 1001    compound(SendSuperN),
 1002    compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]),
 1003    Msg =.. [Sel|Args].
 1004goal_expansion(SendN, send(R, Msg), P, P) :-
 1005    compound(SendN),
 1006    compound_name_arguments(SendN, send, [R,Sel|Args]),
 1007    atom(Sel), Args \== [],
 1008    Msg =.. [Sel|Args].
 1009goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
 1010    compound(GetSuperN),
 1011    compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]),
 1012    append(Args, [Answer], AllArgs),
 1013    Msg =.. [Sel|Args].
 1014goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
 1015    compound(GetN),
 1016    compound_name_arguments(GetN, get, [R,Sel|AllArgs]),
 1017    append(Args, [Answer], AllArgs),
 1018    atom(Sel), Args \== [],
 1019    Msg =.. [Sel|Args].
 1020goal_expansion(G0, G, P, P) :-
 1021    user:goal_expansion(G0, G),     % TBD: we need the module!
 1022    G0 \== G.                       % \=@=?
 1023
 1024
 1025                 /*******************************
 1026                 *        INITIALIZATION        *
 1027                 *******************************/
 1028
 1029%!  initialization_layout(+SourceLocation, ?InitGoal,
 1030%!                        -ReadGoal, -TermPos) is semidet.
 1031%
 1032%   Find term-layout of :- initialization directives.
 1033
 1034initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
 1035    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
 1036    Directive    = (:- initialization(ReadGoal)),
 1037    DirectivePos = term_position(_, _, _, _, [InitPos]),
 1038    InitPos      = term_position(_, _, _, _, [GoalPos]),
 1039    (   ReadGoal = M:_
 1040    ->  Goal = M:Goal0
 1041    ;   Goal = Goal0
 1042    ),
 1043    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
 1044    !.
 1045
 1046
 1047                 /*******************************
 1048                 *        PRINTABLE NAMES       *
 1049                 *******************************/
 1050
 1051:- module_transparent
 1052    predicate_name/2. 1053:- multifile
 1054    user:prolog_predicate_name/2,
 1055    user:prolog_clause_name/2. 1056
 1057hidden_module(user).
 1058hidden_module(system).
 1059hidden_module(pce_principal).           % should be config
 1060hidden_module(Module) :-                % SWI-Prolog specific
 1061    import_module(Module, system).
 1062
 1063thaffix(1, st) :- !.
 1064thaffix(2, nd) :- !.
 1065thaffix(_, th).
 1066
 1067%!  predicate_name(:Head, -PredName:string) is det.
 1068%
 1069%   Describe a predicate as [Module:]Name/Arity.
 1070
 1071predicate_name(Predicate, PName) :-
 1072    strip_module(Predicate, Module, Head),
 1073    (   user:prolog_predicate_name(Module:Head, PName)
 1074    ->  true
 1075    ;   functor(Head, Name, Arity),
 1076        (   hidden_module(Module)
 1077        ->  format(string(PName), '~q/~d', [Name, Arity])
 1078        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
 1079        )
 1080    ).
 1081
 1082%!  clause_name(+Ref, -Name)
 1083%
 1084%   Provide a suitable description of the indicated clause.
 1085
 1086clause_name(Ref, Name) :-
 1087    user:prolog_clause_name(Ref, Name),
 1088    !.
 1089clause_name(Ref, Name) :-
 1090    nth_clause(Head, N, Ref),
 1091    !,
 1092    predicate_name(Head, PredName),
 1093    thaffix(N, Th),
 1094    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
 1095clause_name(Ref, Name) :-
 1096    clause_property(Ref, erased),
 1097    !,
 1098    clause_property(Ref, predicate(M:PI)),
 1099    format(string(Name), 'erased clause from ~q', [M:PI]).
 1100clause_name(_, '<meta-call>')