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