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