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                     ]).

 clause_info(+ClauseRef, -File, -TermPos, -VarOffsets) is semidet

 clause_info(+ClauseRef, -File, -TermPos, -VarOffsets, +Options) is semidet

Fetches source information for the given clause. File is the file from which the clause was loaded. TermPos describes the source layout in a format compatible to the subterm_positions option of read_term/2. VarOffsets provides access to the variable allocation in a stack-frame. See make_varnames/5 for details.

Note that positions are character positions, i.e., not bytes. Line endings count as a single character, regardless of whether the actual ending is \n or \r\n.

Defined options are:

variable_names(-Names)

Unify Names with the variable names list (Name=Var) as returned by read_term/3. This argument is intended for reporting source locations and refactoring based on analysis of the compiled code.

head(-Head)

body(-Body)

Get the head and body as terms. This is similar to clause/3, but a seperate call would break the variable identity.

  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).

 unify_term(+T1, +T2)

Unify the two terms, where T2 is created by writing the term and reading it back in, but be aware that rounding problems may cause floating point numbers not to unify. Also, if the initial term has a string object, it is written as "..." and read as a code-list. We compensate for that.

NOTE: Called directly from library(trace/clause) for the GUI tracer.

  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).

 read_term_at_line(+File, +Line, +Module, -Clause, -TermPos, -VarNames) is semidet

Read a term from File at Line.

  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)).

 open_source(+File, -Stream) is semidet

Hook into clause_info/5 that opens the stream holding the source for a specific clause. Thus, the query must succeed. The default implementation calls open/3 on the File property.

clause_property(ClauseRef, file(File)),
prolog_clause:open_source(File, Stream)

  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)]).

 make_varnames(+ReadClause, +DecompiledClause, +Offsets, +Names, -Term) is det

Create a Term varnames(...) where each argument contains the name of the variable at that offset. If the read Clause is a DCG rule, name the two last arguments <DCG_list> and <DCG_tail>

This predicate calles the multifile predicate make_varnames_hook/5 with the same arguments to allow for user extensions. Extending this predicate is needed if a compiler adds additional arguments to the clause head that must be made visible in the GUI tracer.

Arguments:

Offsets	- List of Offset=Var
Names	- List of Name=Var

  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).

 unify_clause(+Read, +Decompiled, +Module, +ReadTermPos, -RecompiledTermPos)

What you read isn't always what goes into the database. The task of this predicate is to establish the relation between the term read from the file and the result from decompiling the clause.

This predicate calls the multifile predicate unify_clause_hook/5 with the same arguments to support user extensions.

Arguments:

Module

- is the source module that was active when loading this clause, which is the same as prolog_load_context/2 using the module context. If this cannot be established it is the module to which the clause itself is associated. The argument may be used to determine whether or not a specific user transformation is in scope. See also term_expansion/2,4 and goal_expansion/2,4.

To be done

- This really must be more flexible, dealing with much more complex source-translations, falling back to a heuristic method locating as much as possible.

  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).

 unify_clause2(+Read, +Decompiled, +Module, +TermPosIn, -TermPosOut)

Stratified version to be used after the first match

  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.

 inlined_unification(+BodyRead, +BodyCompiled, -BodyReadOut, -BodyCompiledOut, +HeadRead, +BodyPosIn, -BodyPosOut) is det

  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.

 inlineable_head_var(+Head, -Var) is nondet

True when Var is a variable in Head that may be used for inline unification. Currently we only inline direct arguments to the head.

  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).

 expand_failed(+Exception, +Term)

When debugging, indicate that expansion of the term failed.

  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.

 unify_body(+Read, +Decompiled, +Module, +Pos0, -Pos)

Deal with translations implied by the compiler. For example, compiling (a,b),c yields the same code as compiling a,b,c.

Pos0 and Pos still include the term-position of the head.

  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).

 does_not_dcg_after_binding(+ReadBody, +ReadPos) is semidet

True if ReadPos/ReadPos does not contain DCG delayed unifications.

To be done

- We should pass that we are in a DCG; if we are not there is no reason for this test.

  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- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

 unify_goal(+Read, +Decompiled, +Module, +TermPosRead, -TermPosDecompiled) is semidet

This hook is called to fix up source code manipulations that result from goal expansions.

 ubody(+Read, +Decompiled, +Module, +TermPosRead, -TermPosForDecompiled)

Arguments:

Read	- Clause read after expand_term/2
Decompiled	- Decompiled clause
Module	- Load module
TermPosRead	- Sub-term positions of source

  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    !.
  755ubody(A is I + B, A is B + I2, _,       % Var is Int + Var --> Var is Var + Int
  756      term_position(F,T,FF,TT,[PA,term_position(F1,T1,FF1,TT1,[PI,PB])]),
  757      term_position(F,T,FF,TT,[PA,term_position(F1,T1,FF1,TT1,[PB,PI])])) :-
  758    integer(I),
  759    I2 == I,
  760    !.
  761
  762ubody_list([], [], [], _, [], []).
  763ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
  764    ubody_elem(AS, G0, G, M, PA0, PA),
  765    ubody_list(T0, T, ASL, M, PAT0, PAT).
  766
  767ubody_elem(0, G0, G, M, PA0, PA) :-
  768    !,
  769    ubody(G0, G, M, PA0, PA).
  770ubody_elem(_, G, G, _, PA, PA).

 conj(+GoalTerm, +PositionTerm, -GoalList, -PositionList)

Turn a conjunctive body into a list of goals and their positions, i.e., removing the positions of the (,)/2 terms.

  777conj(Goal, Pos, GoalList, PosList) :-
  778    conj(Goal, Pos, GoalList, [], PosList, []).
  779
  780conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
  781    !,
  782    conj(A, PA, GL, TGA, PL, TPA),
  783    conj(B, PB, TGA, TG, TPA, TP).
  784conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
  785    B = (_=_),
  786    !,
  787    conj(A, PA, GL, TGA, PL, TPA),
  788    T1 is T - 1,
  789    conj(B, T1-T, TGA, TG, TPA, TP).
  790conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :-
  791    nonvar(Pos),
  792    !,
  793    conj(A, Pos, GL, TG, PL, TP).
  794conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
  795    F1 is F+1,
  796    T1 is T+1.
  797conj(A, P, [A|TG], TG, [P|TP], TP).

 mkconj(+Decompiled, +Module, -Position, +ReadGoals, +ReadPositions)

  802mkconj(Goal, M, Pos, GoalList, PosList) :-
  803    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
  804
  805mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
  806    nonvar(Conj),
  807    Conj = (A,B),
  808    !,
  809    mkconj(A, M, PA, GL, TGA, PL, TPA),
  810    mkconj(B, M, PB, TGA, TG, TPA, TP).
  811mkconj(A0, M, P0, GL, TG, PL, TP) :-
  812    is_dict_eval(A0),
  813    GL = [G1|_],
  814    is_dict_eval(G1),
  815    !,
  816    (   term_variables(GL, RVars),
  817        length(RVars, NRVars),
  818        select_dict_eval(GL, PL, A, P, TG, TP),
  819        ubody(A, A0, M, P, P0),
  820        term_variables(GL, RVars1),
  821        length(RVars1, NRVars)          % did not alias read variables
  822    ;   skip_optimized(GL, PL, GL1, PL1),
  823        mkconj(A0, M, P0, GL1, TG, PL1, TP)
  824    ).
  825mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
  826    ubody(A, A0, M, P, P0),
  827    !.
  828mkconj(A0, M, P0, GL, TG, PL, TP) :-
  829    skip_optimized(GL, PL, GL1, PL1),
  830    mkconj(A0, M, P0, GL1, TG, PL1, TP).
  831
  832%   The order of the '.'/3 calls  produced  by functional notation on
  833%   dicts depends on goal expansion. For example, library(apply_macros)
  834%   reorders the arguments of maplist/N.  Allow the decompiled
  835%   '.'/3 goal to match any goal in the leading run of '.'/3 calls.
  836
  837is_dict_eval(G) :-
  838    nonvar(G),
  839    G = '.'(_,_,_).
  840
  841select_dict_eval([G|GT], [P|PT], G, P, GT, PT).
  842select_dict_eval([G0|GT0], [P0|PT0], G, P, [G0|GT], [P0|PT]) :-
  843    GT0 = [G1|_],
  844    is_dict_eval(G1),
  845    select_dict_eval(GT0, PT0, G, P, GT, PT).

 skip_optimized(+GoalList, +PosList, -GoalList1, -PosList1)

Skip a goal that may be removed by the compiler, including the '.'/3 calls that evaluate dicts in its arguments.

  852skip_optimized([G|GT], [_|PT], GT, PT) :-
  853    maybe_optimized(G).
  854skip_optimized([G|GT], [_|PT], GL, PL) :-
  855    is_dict_eval(G),
  856    skip_optimized(GT, PT, GL, PL).
  857
  858maybe_optimized(debug(_,_,_)).
  859maybe_optimized(assertion(_)).
  860maybe_optimized(true).

 argpos(+N, +PositionTerm, -ArgPositionTerm) is det

Get the position for the nth argument of PositionTerm.

  866argpos(N, parentheses_term_position(_,_,PosIn), Pos) =>
  867    argpos(N, PosIn, Pos).
  868argpos(N, term_position(_,_,_,_,ArgPos), Pos) =>
  869    nth1(N, ArgPos, Pos).
  870argpos(_, _, _) => true.
  871
  872
  873                 /*******************************
  874                 *    PCE STUFF (SHOULD MOVE)   *
  875                 *******************************/
  876
  877/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  878        <method>(Receiver, ... Arg ...) :->
  879                Body
  880
  881mapped to:
  882
  883        send_implementation(Id, <method>(...Arg...), Receiver)
  884
  885- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  886
  887pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
  888    !,
  889    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
  890pce_method_clause(Head, Body,
  891                  send_implementation(_Id, Msg, Receiver), PlBody,
  892                  M, TermPos0, TermPos) :-
  893    !,
  894    debug(clause_info, 'send method ...', []),
  895    arg(1, Head, Receiver),
  896    functor(Head, _, Arity),
  897    pce_method_head_arguments(2, Arity, Head, Msg),
  898    debug(clause_info, 'head ...', []),
  899    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  900pce_method_clause(Head, Body,
  901                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
  902                  M, TermPos0, TermPos) :-
  903    !,
  904    debug(clause_info, 'get method ...', []),
  905    arg(1, Head, Receiver),
  906    debug(clause_info, 'receiver ...', []),
  907    functor(Head, _, Arity),
  908    arg(Arity, Head, PceResult),
  909    debug(clause_info, '~w?~n', [PceResult = Result]),
  910    pce_unify_head_arg(PceResult, Result),
  911    Ar is Arity - 1,
  912    pce_method_head_arguments(2, Ar, Head, Msg),
  913    debug(clause_info, 'head ...', []),
  914    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  915
  916pce_method_head_arguments(N, Arity, Head, Msg) :-
  917    N =< Arity,
  918    !,
  919    arg(N, Head, PceArg),
  920    PLN is N - 1,
  921    arg(PLN, Msg, PlArg),
  922    pce_unify_head_arg(PceArg, PlArg),
  923    debug(clause_info, '~w~n', [PceArg = PlArg]),
  924    NextArg is N+1,
  925    pce_method_head_arguments(NextArg, Arity, Head, Msg).
  926pce_method_head_arguments(_, _, _, _).
  927
  928pce_unify_head_arg(V, A) :-
  929    var(V),
  930    !,
  931    V = A.
  932pce_unify_head_arg(A:_=_, A) :- !.
  933pce_unify_head_arg(A:_, A).
  934
  935%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
  936%
  937%       Unify the body of an XPCE method.  Goal-expansion makes this
  938%       rather tricky, especially as we cannot call XPCE's expansion
  939%       on an isolated method.
  940%
  941%       TermPos0 is the term-position term of the whole clause!
  942%
  943%       Further, please note that the body of the method-clauses reside
  944%       in another module than pce_principal, and therefore the body
  945%       starts with an I_CONTEXT call. This implies we need a
  946%       hypothetical term-position for the module-qualifier.
  947
  948pce_method_body(A0, A, M, TermPos0, TermPos) :-
  949    TermPos0 = term_position(F, T, FF, FT,
  950                             [ HeadPos,
  951                               BodyPos0
  952                             ]),
  953    TermPos  = term_position(F, T, FF, FT,
  954                             [ HeadPos,
  955                               term_position(0,0,0,0, [0-0,BodyPos])
  956                             ]),
  957    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
  958
  959
  960pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
  961    !,
  962    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
  963    TermPos  = BodyPos,
  964    expand_goal(A0, A, M, BodyPos0, BodyPos).
  965pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  966    A0 =.. [Func,B0,C0],
  967    control_op(Func),
  968    !,
  969    A =.. [Func,B,C],
  970    TermPos0 = term_position(F, T, FF, FT,
  971                             [ BP0,
  972                               CP0
  973                             ]),
  974    TermPos  = term_position(F, T, FF, FT,
  975                             [ BP,
  976                               CP
  977                             ]),
  978    pce_method_body2(B0, B, M, BP0, BP),
  979    expand_goal(C0, C, M, CP0, CP).
  980pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  981    expand_goal(A0, A, M, TermPos0, TermPos).
  982
  983control_op(',').
  984control_op((;)).
  985control_op((->)).
  986control_op((*->)).
  987
  988                 /*******************************
  989                 *     EXPAND_GOAL SUPPORT      *
  990                 *******************************/
  991
  992/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  993With the introduction of expand_goal, it  is increasingly hard to relate
  994the clause from the database to the actual  source. For one thing, we do
  995not know the compilation  module  of  the   clause  (unless  we  want to
  996decompile it).
  997
  998Goal expansion can translate  goals   into  control-constructs, multiple
  999clauses, or delete a subgoal.
 1000
 1001To keep track of the source-locations, we   have to redo the analysis of
 1002the clause as defined in init.pl
 1003- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1004
 1005expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
 1006    var(G),
 1007    !.
 1008expand_goal(G, G1, _, P, P) :-
 1009    var(G),
 1010    !,
 1011    G1 = G.
 1012expand_goal(M0, M, Module, P0, P) :-
 1013    meta(Module, M0, S),
 1014    !,
 1015    P0 = term_position(F,T,FF,FT,PL0),
 1016    P  = term_position(F,T,FF,FT,PL),
 1017    functor(M0, Functor, Arity),
 1018    functor(M,  Functor, Arity),
 1019    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
 1020expand_goal(A, B, Module, P0, P) :-
 1021    goal_expansion(A, B0, P0, P1),
 1022    !,
 1023    expand_goal(B0, B, Module, P1, P).
 1024expand_goal(A, A, _, P, P).
 1025
 1026expand_meta_args([],      [],   _,  _, _,      _,  _).
 1027expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
 1028    arg(I, M0, A0),
 1029    arg(I, M,  A),
 1030    arg(I, S,  AS),
 1031    expand_arg(AS, A0, A, Module, P0, P),
 1032    NI is I + 1,
 1033    expand_meta_args(T0, T, NI, S, Module, M0, M).
 1034
 1035expand_arg(0, A0, A, Module, P0, P) :-
 1036    !,
 1037    expand_goal(A0, A, Module, P0, P).
 1038expand_arg(_, A, A, _, P, P).
 1039
 1040meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
 1041
 1042goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
 1043    compound(Msg),
 1044    Msg =.. [send_super, Selector | Args],
 1045    !,
 1046    SuperMsg =.. [Selector|Args].
 1047goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
 1048    compound(Msg),
 1049    Msg =.. [get_super, Selector | Args],
 1050    !,
 1051    SuperMsg =.. [Selector|Args].
 1052goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
 1053goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
 1054goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
 1055    compound(SendSuperN),
 1056    compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]),
 1057    Msg =.. [Sel|Args].
 1058goal_expansion(SendN, send(R, Msg), P, P) :-
 1059    compound(SendN),
 1060    compound_name_arguments(SendN, send, [R,Sel|Args]),
 1061    atom(Sel), Args \== [],
 1062    Msg =.. [Sel|Args].
 1063goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
 1064    compound(GetSuperN),
 1065    compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]),
 1066    append(Args, [Answer], AllArgs),
 1067    Msg =.. [Sel|Args].
 1068goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
 1069    compound(GetN),
 1070    compound_name_arguments(GetN, get, [R,Sel|AllArgs]),
 1071    append(Args, [Answer], AllArgs),
 1072    atom(Sel), Args \== [],
 1073    Msg =.. [Sel|Args].
 1074goal_expansion(G0, G, P, P) :-
 1075    user:goal_expansion(G0, G),     % TBD: we need the module!
 1076    G0 \== G.                       % \=@=?
 1077
 1078
 1079                 /*******************************
 1080                 *        INITIALIZATION        *
 1081                 *******************************/

 initialization_layout(+SourceLocation, ?InitGoal, -ReadGoal, -TermPos) is semidet

Find term-layout of :- initialization directives.

 1088initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
 1089    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
 1090    Directive    = (:- initialization(ReadGoal)),
 1091    DirectivePos = term_position(_, _, _, _, [InitPos]),
 1092    InitPos      = term_position(_, _, _, _, [GoalPos]),
 1093    (   ReadGoal = M:_
 1094    ->  Goal = M:Goal0
 1095    ;   Goal = Goal0
 1096    ),
 1097    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
 1098    !.
 1099
 1100
 1101                 /*******************************
 1102                 *        PRINTABLE NAMES       *
 1103                 *******************************/
 1104
 1105:- module_transparent
 1106    predicate_name/2. 1107:- multifile
 1108    user:prolog_predicate_name/2,
 1109    user:prolog_clause_name/2. 1110
 1111hidden_module(user).
 1112hidden_module(system).
 1113hidden_module(pce_principal).           % should be config
 1114hidden_module(Module) :-                % SWI-Prolog specific
 1115    import_module(Module, system).
 1116
 1117thaffix(1, st) :- !.
 1118thaffix(2, nd) :- !.
 1119thaffix(_, th).

 predicate_name(:Head, -PredName:string) is det

Describe a predicate as [Module:]Name/Arity.

 1125predicate_name(Predicate, PName) :-
 1126    strip_module(Predicate, Module, Head),
 1127    (   user:prolog_predicate_name(Module:Head, PName)
 1128    ->  true
 1129    ;   functor(Head, Name, Arity),
 1130        (   hidden_module(Module)
 1131        ->  format(string(PName), '~q/~d', [Name, Arity])
 1132        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
 1133        )
 1134    ).

 clause_name(+Ref, -Name)

Provide a suitable description of the indicated clause.

 1140clause_name(Ref, Name) :-
 1141    user:prolog_clause_name(Ref, Name),
 1142    !.
 1143clause_name(Ref, Name) :-
 1144    nth_clause(Head, N, Ref),
 1145    !,
 1146    predicate_name(Head, PredName),
 1147    thaffix(N, Th),
 1148    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
 1149clause_name(Ref, Name) :-
 1150    clause_property(Ref, erased),
 1151    !,
 1152    clause_property(Ref, predicate(M:PI)),
 1153    format(string(Name), 'erased clause from ~q', [M:PI]).
 1154clause_name(_, '<meta-call>')