1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2005-2024, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(prolog_clause,
   39          [ clause_info/4,              % +ClauseRef, -File, -TermPos, -VarNames
   40            clause_info/5,              % +ClauseRef, -File, -TermPos, -VarNames,
   41                                        % +Options
   42            initialization_layout/4,    % +SourceLoc, +Goal, -Term, -TermPos
   43            predicate_name/2,           % +Head, -Name
   44            clause_name/2               % +ClauseRef, -Name
   45          ]).   46:- use_module(library(debug),[debugging/1,debug/3]).   47:- autoload(library(listing),[portray_clause/1]).   48:- autoload(library(lists),[append/3]).   49:- autoload(library(occurs),[sub_term/2]).   50:- autoload(library(option),[option/3]).   51:- autoload(library(prolog_source),[read_source_term_at_location/3]).   52
   53
   54:- public                               % called from library(trace/clause)
   55    unify_term/2,
   56    make_varnames/5,
   57    do_make_varnames/3.   58
   59:- multifile
   60    unify_goal/5,                   % +Read, +Decomp, +M, +Pos, -Pos
   61    unify_clause_hook/5,
   62    make_varnames_hook/5,
   63    open_source/2.                  % +Input, -Stream
   64
   65:- predicate_options(prolog_clause:clause_info/5, 5,
   66                     [ head(-any),
   67                       body(-any),
   68                       variable_names(-list)
   69                     ]).

 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.

  109clause_info(ClauseRef, File, TermPos, NameOffset) :-
  110    clause_info(ClauseRef, File, TermPos, NameOffset, []).
  111
  112clause_info(ClauseRef, File, TermPos, NameOffset, Options) :-
  113    (   debugging(clause_info)
  114    ->  clause_name(ClauseRef, Name),
  115        debug(clause_info, 'clause_info(~w) (~w)... ',
  116              [ClauseRef, Name])
  117    ;   true
  118    ),
  119    clause_property(ClauseRef, file(File)),
  120    File \== user,                  % loaded using ?- [user].
  121    '$clause'(Head0, Body, ClauseRef, VarOffset),
  122    option(head(Head0), Options, _),
  123    option(body(Body), Options, _),
  124    (   module_property(Module, file(File))
  125    ->  true
  126    ;   strip_module(user:Head0, Module, _)
  127    ),
  128    unqualify(Head0, Module, Head),
  129    (   Body == true
  130    ->  DecompiledClause = Head
  131    ;   DecompiledClause = (Head :- Body)
  132    ),
  133    clause_property(ClauseRef, line_count(LineNo)),
  134    debug(clause_info, 'from ~w:~d ... ', [File, LineNo]),
  135    read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames),
  136    option(variable_names(VarNames), Options, _),
  137    debug(clause_info, 'read ...', []),
  138    unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos),
  139    debug(clause_info, 'unified ...', []),
  140    make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset),
  141    debug(clause_info, 'got names~n', []),
  142    !.
  143
  144unqualify(Module:Head, Module, Head) :-
  145    !.
  146unqualify(Head, _, Head).

 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.

  160unify_term(X, X) :- !.
  161unify_term(X1, X2) :-
  162    compound(X1),
  163    compound(X2),
  164    functor(X1, F, Arity),
  165    functor(X2, F, Arity),
  166    !,
  167    unify_args(0, Arity, X1, X2).
  168unify_term(X, Y) :-
  169    float(X), float(Y),
  170    !.
  171unify_term(X, '$BLOB'(_)) :-
  172    blob(X, _),
  173    \+ atom(X).
  174unify_term(X, Y) :-
  175    string(X),
  176    is_list(Y),
  177    string_codes(X, Y),
  178    !.
  179unify_term(_, Y) :-
  180    Y == '...',
  181    !.                          % elipses left by max_depth
  182unify_term(_:X, Y) :-
  183    unify_term(X, Y),
  184    !.
  185unify_term(X, _:Y) :-
  186    unify_term(X, Y),
  187    !.
  188unify_term(X, Y) :-
  189    format('[INTERNAL ERROR: Diff:~n'),
  190    portray_clause(X),
  191    format('~N*** <->~n'),
  192    portray_clause(Y),
  193    break.
  194
  195unify_args(N, N, _, _) :- !.
  196unify_args(I, Arity, T1, T2) :-
  197    A is I + 1,
  198    arg(A, T1, A1),
  199    arg(A, T2, A2),
  200    unify_term(A1, A2),
  201    unify_args(A, Arity, T1, T2).

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

Read a term from File at Line.

  209read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :-
  210    setup_call_cleanup(
  211        '$push_input_context'(clause_info),
  212        read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames),
  213        '$pop_input_context').
  214
  215read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :-
  216    catch(try_open_source(File, In), error(_,_), fail),
  217    set_stream(In, newline(detect)),
  218    call_cleanup(
  219        read_source_term_at_location(
  220            In, Clause,
  221            [ line(Line),
  222              module(Module),
  223              subterm_positions(TermPos),
  224              variable_names(VarNames)
  225            ]),
  226        close(In)).

 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)

  239:- public try_open_source/2.            % used by library(prolog_breakpoints).
  240
  241try_open_source(File, In) :-
  242    open_source(File, In),
  243    !.
  244try_open_source(File, In) :-
  245    open(File, read, In, [reposition(true)]).

 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

  264make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :-
  265    make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term),
  266    !.
  267make_varnames(ReadClause, _, Offsets, Names, Bindings) :-
  268    dcg_head(ReadClause, Head),
  269    !,
  270    functor(Head, _, Arity),
  271    In is Arity,
  272    memberchk(In=IVar, Offsets),
  273    Names1 = ['<DCG_list>'=IVar|Names],
  274    Out is Arity + 1,
  275    memberchk(Out=OVar, Offsets),
  276    Names2 = ['<DCG_tail>'=OVar|Names1],
  277    make_varnames(xx, xx, Offsets, Names2, Bindings).
  278make_varnames(_, _, Offsets, Names, Bindings) :-
  279    length(Offsets, L),
  280    functor(Bindings, varnames, L),
  281    do_make_varnames(Offsets, Names, Bindings).
  282
  283dcg_head((Head,_ --> _Body), Head).
  284dcg_head((Head   --> _Body), Head).
  285dcg_head((Head,_ ==> _Body), Head).
  286dcg_head((Head   ==> _Body), Head).
  287
  288do_make_varnames([], _, _).
  289do_make_varnames([N=Var|TO], Names, Bindings) :-
  290    (   find_varname(Var, Names, Name)
  291    ->  true
  292    ;   Name = '_'
  293    ),
  294    AN is N + 1,
  295    arg(AN, Bindings, Name),
  296    do_make_varnames(TO, Names, Bindings).
  297
  298find_varname(Var, [Name = TheVar|_], Name) :-
  299    Var == TheVar,
  300    !.
  301find_varname(Var, [_|T], Name) :-
  302    find_varname(Var, T, Name).

 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.

  325unify_clause(Read, _, _, _, _) :-
  326    var(Read),
  327    !,
  328    fail.
  329unify_clause((RHead :- RBody), (CHead :- CBody), Module, TermPos1, TermPos) :-
  330    '$expand':f2_pos(TermPos1, HPos, BPos1,
  331                     TermPos2, HPos, BPos2),
  332    inlined_unification(RBody, CBody, RBody1, CBody1, RHead,
  333                        BPos1, BPos2),
  334    RBody1 \== RBody,
  335    !,
  336    unify_clause2((RHead :- RBody1), (CHead :- CBody1), Module,
  337                  TermPos2, TermPos).
  338unify_clause(Read, Decompiled, _, TermPos, TermPos) :-
  339    Read =@= Decompiled,
  340    !,
  341    Read = Decompiled.
  342unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  343    unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos),
  344    !.
  345                                        % XPCE send-methods
  346unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  347    !,
  348    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  349                                        % XPCE get-methods
  350unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  351    !,
  352    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  353                                        % Unit test clauses
  354unify_clause((TH :- RBody), (CH :- !, CBody), Module, TP0, TP) :-
  355    plunit_source_head(TH),
  356    plunit_compiled_head(CH),
  357    !,
  358    TP0 = term_position(F,T,FF,FT,[HP,BP0]),
  359    ubody(RBody, CBody, Module, BP0, BP),
  360    TP  = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
  361                                        % module:head :- body
  362unify_clause((Head :- Read),
  363             (Head :- _M:Compiled), Module, TermPos0, TermPos) :-
  364    unify_clause2((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
  365    TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
  366    TermPos  = term_position(TA,TZ,FA,FZ,
  367                             [ PH,
  368                               term_position(0,0,0,0,[0-0,PB])
  369                             ]).
  370                                        % DCG rules
  371unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  372    Read = (_ --> Terminal0, _),
  373    (   is_list(Terminal0)
  374    ->  Terminal = Terminal0
  375    ;   string(Terminal0)
  376    ->  string_codes(Terminal0, Terminal)
  377    ),
  378    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  379    (   dcg_unify_in_head(Compiled2, Compiled3)
  380    ->  true
  381    ;   Compiled2 = (DH :- _CBody),
  382        functor(DH, _, Arity),
  383        DArg is Arity - 1,
  384        append(Terminal, _Tail, List),
  385        arg(DArg, DH, List),
  386        Compiled3 = Compiled2
  387    ),
  388    TermPos1 = term_position(F,T,FF,FT,[ HP,
  389                                         term_position(_,_,_,_,[_,BP])
  390                                       ]),
  391    !,
  392    TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]),
  393    match_module(Compiled3, Compiled1, Module, TermPos2, TermPos).
  394                                               % SSU rules
  395unify_clause((Head,RCond => Body), (CHead :- CCondAndBody), Module,
  396             term_position(F,T,FF,FT,
  397                           [ term_position(_,_,_,_,[HP,CP]),
  398                             BP
  399                           ]),
  400             TermPos) :-
  401    split_on_cut(CCondAndBody, CCond, CBody0),
  402    !,
  403    inlined_unification(RCond, CCond, RCond1, CCond1, Head, CP, CP1),
  404    TermPos1 = term_position(F,T,FF,FT, [HP, BP1]),
  405    BP2 = term_position(_,_,_,_, [FF-FT, BP]), % Represent (!, Body), placing
  406    (   CCond1 == true                         % ! at =>
  407    ->  BP1 = BP2,                             % Whole guard is inlined
  408        unify_clause2((Head :- !, Body), (CHead :- !, CBody0),
  409                      Module, TermPos1, TermPos)
  410    ;   mkconj_pos(RCond1, CP1, (!,Body), BP2, RBody, BP1),
  411        mkconj_npos(CCond1, (!,CBody0), CBody),
  412        unify_clause2((Head :- RBody), (CHead :- CBody),
  413                      Module, TermPos1, TermPos)
  414    ).
  415unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :-
  416    !,
  417    unify_clause2((Head :- Body), Compiled1, Module, TermPos0, TermPos).
  418unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  419    Read = (_ ==> _),
  420    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  421    Compiled2 \= (_ ==> _),
  422    !,
  423    unify_clause(Compiled2, Compiled1, Module, TermPos1, TermPos).
  424unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  425    unify_clause2(Read, Decompiled, Module, TermPos0, TermPos).
  426
  427dcg_unify_in_head((Head :- L1=L2, Body), (Head :- Body)) :-
  428    functor(Head, _, Arity),
  429    DArg is Arity - 1,
  430    arg(DArg, Head, L0),
  431    L0 == L1,
  432    L1 = L2.
  433
  434% mkconj, but also unify position info
  435mkconj_pos((A,B), term_position(F,T,FF,FT,[PA,PB]), Ex, ExPos, Code, Pos) =>
  436    Code = (A,B1),
  437    Pos = term_position(F,T,FF,FT,[PA,PB1]),
  438    mkconj_pos(B, PB, Ex, ExPos, B1, PB1).
  439mkconj_pos(Last, LastPos, Ex, ExPos, Code, Pos) =>
  440    Code = (Last,Ex),
  441    Pos = term_position(_,_,_,_,[LastPos,ExPos]).
  442
  443% similar to mkconj, but we should __not__ optimize `true` away.
  444mkconj_npos((A,B), Ex, Code) =>
  445    Code = (A,B1),
  446    mkconj_npos(B, Ex, B1).
  447mkconj_npos(A, Ex, Code) =>
  448    Code = (A,Ex).

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

Stratified version to be used after the first match

  454unify_clause2(Read, Decompiled, _, TermPos, TermPos) :-
  455    Read =@= Decompiled,
  456    !,
  457    Read = Decompiled.
  458unify_clause2(Read, Compiled1, Module, TermPos0, TermPos) :-
  459    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  460    match_module(Compiled2, Compiled1, Module, TermPos1, TermPos),
  461    !.
  462unify_clause2(_, _, _, _, _) :-       % I don't know ...
  463    debug(clause_info, 'Could not unify clause', []),
  464    fail.
  465
  466unify_clause_head(H1, H2) :-
  467    strip_module(H1, _, H),
  468    strip_module(H2, _, H).
  469
  470plunit_source_head(test(_,_)) => true.
  471plunit_source_head(test(_)) => true.
  472plunit_source_head(_) => fail.
  473
  474plunit_compiled_head(_:'unit body'(_, _)) => true.
  475plunit_compiled_head('unit body'(_, _)) => true.
  476plunit_compiled_head(_) => fail.

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

  483inlined_unification((V=T,RBody0), (CV=CT,CBody0),
  484                    RBody, CBody, RHead, BPos1, BPos),
  485    inlineable_head_var(RHead, V2),
  486    V == V2,
  487    (V=T) =@= (CV=CT) =>
  488    argpos(2, BPos1, BPos2),
  489    inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos).
  490inlined_unification((V=T), (CV=CT),
  491                    RBody, CBody, RHead, BPos1, BPos),
  492    inlineable_head_var(RHead, V2),
  493    V == V2,
  494    (V=T) =@= (CV=CT) =>
  495    RBody = true,
  496    CBody = true,
  497    argpos(2, BPos1, BPos).
  498inlined_unification((V=T,RBody0), CBody0,
  499                    RBody, CBody, RHead, BPos1, BPos),
  500    inlineable_head_var(RHead, V2),
  501    V == V2,
  502    \+ (CBody0 = (G1,_), G1 =@= (V=T)) =>
  503    argpos(2, BPos1, BPos2),
  504    inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos).
  505inlined_unification((V=_), true,
  506                    RBody, CBody, RHead, BPos1, BPos),
  507    inlineable_head_var(RHead, V2),
  508    V == V2 =>
  509    RBody = true,
  510    CBody = true,
  511    argpos(2, BPos1, BPos).
  512inlined_unification(RBody0, CBody0, RBody, CBody, _RHead,
  513                    BPos0, BPos) =>
  514    RBody = RBody0,
  515    BPos  = BPos0,
  516    CBody = CBody0.

 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.

  523inlineable_head_var(Head, Var) :-
  524    compound(Head),
  525    arg(_, Head, Var).
  526
  527split_on_cut((Cond0,!,Body0), Cond, Body) =>
  528    Cond = Cond0,
  529    Body = Body0.
  530split_on_cut((!,Body0), Cond, Body) =>
  531    Cond = true,
  532    Body = Body0.
  533split_on_cut((A,B), Cond, Body) =>
  534    Cond = (A,Cond1),
  535    split_on_cut(B, Cond1, Body).
  536split_on_cut(_, _, _) =>
  537    fail.
  538
  539ci_expand(Read, Compiled, Module, TermPos0, TermPos) :-
  540    catch(setup_call_cleanup(
  541              ( set_xref_flag(OldXRef),
  542                '$set_source_module'(Old, Module)
  543              ),
  544              expand_term(Read, TermPos0, Compiled, TermPos),
  545              ( '$set_source_module'(Old),
  546                set_prolog_flag(xref, OldXRef)
  547              )),
  548          E,
  549          expand_failed(E, Read)),
  550    compound(TermPos),                  % make sure somthing is filled.
  551    arg(1, TermPos, A1), nonvar(A1),
  552    arg(2, TermPos, A2), nonvar(A2).
  553
  554set_xref_flag(Value) :-
  555    current_prolog_flag(xref, Value),
  556    !,
  557    set_prolog_flag(xref, true).
  558set_xref_flag(false) :-
  559    create_prolog_flag(xref, true, [type(boolean)]).
  560
  561match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :-
  562    !,
  563    unify_clause_head(H1, H2),
  564    unify_body(B1, B2, Module, Pos0, Pos).
  565match_module((H1 :- B1), H2, _Module, Pos0, Pos) :-
  566    B1 == true,
  567    unify_clause_head(H1, H2),
  568    Pos = Pos0,
  569    !.
  570match_module(H1, H2, _, Pos, Pos) :-    % deal with facts
  571    unify_clause_head(H1, H2).

 expand_failed(+Exception, +Term)

When debugging, indicate that expansion of the term failed.

  577expand_failed(E, Read) :-
  578    debugging(clause_info),
  579    message_to_string(E, Msg),
  580    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  581    fail.

 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.

  590unify_body(B, C, _, Pos, Pos) :-
  591    B =@= C, B = C,
  592    does_not_dcg_after_binding(B, Pos),
  593    !.
  594unify_body(R, D, Module,
  595           term_position(F,T,FF,FT,[HP,BP0]),
  596           term_position(F,T,FF,FT,[HP,BP])) :-
  597    ubody(R, D, Module, BP0, BP).

 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.

  607does_not_dcg_after_binding(B, Pos) :-
  608    \+ sub_term(brace_term_position(_,_,_), Pos),
  609    \+ (sub_term((Cut,_=_), B), Cut == !),
  610    !.
  611
  612
  613/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  614Some remarks.
  615
  616a --> { x, y, z }.
  617    This is translated into "(x,y),z), X=Y" by the DCG translator, after
  618    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
  619- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

 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

  634ubody(B, DB, _, P, P) :-
  635    var(P),                        % TBD: Create compatible pos term?
  636    !,
  637    B = DB.
  638ubody(B, C, _, P, P) :-
  639    B =@= C, B = C,
  640    does_not_dcg_after_binding(B, P),
  641    !.
  642ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :-
  643    !,
  644    ubody(X0, X, M, P0, P).
  645ubody(X, Y, _,                    % X = call(X)
  646      Pos,
  647      term_position(From, To, From, To, [Pos])) :-
  648    nonvar(Y),
  649    Y = call(X),
  650    !,
  651    arg(1, Pos, From),
  652    arg(2, Pos, To).
  653ubody(A, B, _, P1, P2) :-
  654    nonvar(A), A = (_=_),
  655    nonvar(B), B = (LB=RB),
  656    A =@= (RB=LB),
  657    !,
  658    P1 = term_position(F,T, FF,FT, [PL,PR]),
  659    P2 = term_position(F,T, FF,FT, [PR,PL]).
  660ubody(A, B, _, P1, P2) :-
  661    nonvar(A), A = (_==_),
  662    nonvar(B), B = (LB==RB),
  663    A =@= (RB==LB),
  664    !,
  665    P1 = term_position(F,T, FF,FT, [PL,PR]),
  666    P2 = term_position(F,T, FF,FT, [PR,PL]).
  667ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :-
  668    nonvar(B), B = M:R,
  669    ubody(R, D, M, RP, TPOut).
  670ubody(B, D, M, term_position(_,_,_,_,[RP0,RP1]), TPOut) :-
  671    nonvar(B), B = (B0,B1),
  672    (   maybe_optimized(B0),
  673        ubody(B1, D, M, RP1, TPOut)
  674    ->  true
  675    ;   maybe_optimized(B1),
  676        ubody(B0, D, M, RP0, TPOut)
  677    ),
  678    !.
  679ubody(B0, B, M,
  680      brace_term_position(F,T,A0),
  681      Pos) :-
  682    B0 = (_,_=_),
  683    !,
  684    T1 is T - 1,
  685    ubody(B0, B, M,
  686          term_position(F,T,
  687                        F,T,
  688                        [A0,T1-T]),
  689          Pos).
  690ubody(B0, B, M,
  691      brace_term_position(F,T,A0),
  692      term_position(F,T,F,T,[A])) :-
  693    !,
  694    ubody(B0, B, M, A0, A).
  695ubody(C0, C, M, P0, P) :-
  696    nonvar(C0), nonvar(C),
  697    C0 = (_,_), C = (_,_),
  698    !,
  699    conj(C0, P0, GL, PL),
  700    mkconj(C, M, P, GL, PL).
  701ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :-
  702    unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled),
  703    !.
  704ubody(X0, X, M,
  705      term_position(F,T,FF,TT,PA0),
  706      term_position(F,T,FF,TT,PA)) :-
  707    callable(X0),
  708    callable(X),
  709    meta(M, X0, S),
  710    !,
  711    X0 =.. [_|A0],
  712    X  =.. [_|A],
  713    S =.. [_|AS],
  714    ubody_list(A0, A, AS, M, PA0, PA).
  715ubody(X0, X, M,
  716      term_position(F,T,FF,TT,PA0),
  717      term_position(F,T,FF,TT,PA)) :-
  718    expand_goal(X0, X1, M, PA0, PA),
  719    X1 =@= X,
  720    X1 = X.
  721
  722                                        % 5.7.X optimizations
  723ubody(_=_, true, _,                     % singleton = Any
  724      term_position(F,T,_FF,_TT,_PA),
  725      F-T) :- !.
  726ubody(_==_, fail, _,                    % singleton/firstvar == Any
  727      term_position(F,T,_FF,_TT,_PA),
  728      F-T) :- !.
  729ubody(A1=B1, B2=A2, _,                  % Term = Var --> Var = Term
  730      term_position(F,T,FF,TT,[PA1,PA2]),
  731      term_position(F,T,FF,TT,[PA2,PA1])) :-
  732    var(B1), var(B2),
  733    (A1==B1) =@= (B2==A2),
  734    !,
  735    A1 = A2, B1=B2.
  736ubody(A1==B1, B2==A2, _,                % const == Var --> Var == const
  737      term_position(F,T,FF,TT,[PA1,PA2]),
  738      term_position(F,T,FF,TT,[PA2,PA1])) :-
  739    var(B1), var(B2),
  740    (A1==B1) =@= (B2==A2),
  741    !,
  742    A1 = A2, B1=B2.
  743ubody(A is B - C, A is B + C2, _, Pos, Pos) :-
  744    integer(C),
  745    C2 =:= -C,
  746    !.
  747
  748ubody_list([], [], [], _, [], []).
  749ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
  750    ubody_elem(AS, G0, G, M, PA0, PA),
  751    ubody_list(T0, T, ASL, M, PAT0, PAT).
  752
  753ubody_elem(0, G0, G, M, PA0, PA) :-
  754    !,
  755    ubody(G0, G, M, PA0, PA).
  756ubody_elem(_, G, G, _, PA, PA).

 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.

  763conj(Goal, Pos, GoalList, PosList) :-
  764    conj(Goal, Pos, GoalList, [], PosList, []).
  765
  766conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
  767    !,
  768    conj(A, PA, GL, TGA, PL, TPA),
  769    conj(B, PB, TGA, TG, TPA, TP).
  770conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
  771    B = (_=_),
  772    !,
  773    conj(A, PA, GL, TGA, PL, TPA),
  774    T1 is T - 1,
  775    conj(B, T1-T, TGA, TG, TPA, TP).
  776conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :-
  777    nonvar(Pos),
  778    !,
  779    conj(A, Pos, GL, TG, PL, TP).
  780conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
  781    F1 is F+1,
  782    T1 is T+1.
  783conj(A, P, [A|TG], TG, [P|TP], TP).

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

  788mkconj(Goal, M, Pos, GoalList, PosList) :-
  789    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
  790
  791mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
  792    nonvar(Conj),
  793    Conj = (A,B),
  794    !,
  795    mkconj(A, M, PA, GL, TGA, PL, TPA),
  796    mkconj(B, M, PB, TGA, TG, TPA, TP).
  797mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
  798    ubody(A, A0, M, P, P0),
  799    !.
  800mkconj(A0, M, P0, [RG|TG0], TG, [_|TP0], TP) :-
  801    maybe_optimized(RG),
  802    mkconj(A0, M, P0, TG0, TG, TP0, TP).
  803
  804maybe_optimized(debug(_,_,_)).
  805maybe_optimized(assertion(_)).
  806maybe_optimized(true).

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

Get the position for the nth argument of PositionTerm.

  812argpos(N, parentheses_term_position(_,_,PosIn), Pos) =>
  813    argpos(N, PosIn, Pos).
  814argpos(N, term_position(_,_,_,_,ArgPos), Pos) =>
  815    nth1(N, ArgPos, Pos).
  816argpos(_, _, _) => true.
  817
  818
  819                 /*******************************
  820                 *    PCE STUFF (SHOULD MOVE)   *
  821                 *******************************/
  822
  823/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  824        <method>(Receiver, ... Arg ...) :->
  825                Body
  826
  827mapped to:
  828
  829        send_implementation(Id, <method>(...Arg...), Receiver)
  830
  831- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  832
  833pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
  834    !,
  835    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
  836pce_method_clause(Head, Body,
  837                  send_implementation(_Id, Msg, Receiver), PlBody,
  838                  M, TermPos0, TermPos) :-
  839    !,
  840    debug(clause_info, 'send method ...', []),
  841    arg(1, Head, Receiver),
  842    functor(Head, _, Arity),
  843    pce_method_head_arguments(2, Arity, Head, Msg),
  844    debug(clause_info, 'head ...', []),
  845    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  846pce_method_clause(Head, Body,
  847                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
  848                  M, TermPos0, TermPos) :-
  849    !,
  850    debug(clause_info, 'get method ...', []),
  851    arg(1, Head, Receiver),
  852    debug(clause_info, 'receiver ...', []),
  853    functor(Head, _, Arity),
  854    arg(Arity, Head, PceResult),
  855    debug(clause_info, '~w?~n', [PceResult = Result]),
  856    pce_unify_head_arg(PceResult, Result),
  857    Ar is Arity - 1,
  858    pce_method_head_arguments(2, Ar, Head, Msg),
  859    debug(clause_info, 'head ...', []),
  860    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  861
  862pce_method_head_arguments(N, Arity, Head, Msg) :-
  863    N =< Arity,
  864    !,
  865    arg(N, Head, PceArg),
  866    PLN is N - 1,
  867    arg(PLN, Msg, PlArg),
  868    pce_unify_head_arg(PceArg, PlArg),
  869    debug(clause_info, '~w~n', [PceArg = PlArg]),
  870    NextArg is N+1,
  871    pce_method_head_arguments(NextArg, Arity, Head, Msg).
  872pce_method_head_arguments(_, _, _, _).
  873
  874pce_unify_head_arg(V, A) :-
  875    var(V),
  876    !,
  877    V = A.
  878pce_unify_head_arg(A:_=_, A) :- !.
  879pce_unify_head_arg(A:_, A).
  880
  881%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
  882%
  883%       Unify the body of an XPCE method.  Goal-expansion makes this
  884%       rather tricky, especially as we cannot call XPCE's expansion
  885%       on an isolated method.
  886%
  887%       TermPos0 is the term-position term of the whole clause!
  888%
  889%       Further, please note that the body of the method-clauses reside
  890%       in another module than pce_principal, and therefore the body
  891%       starts with an I_CONTEXT call. This implies we need a
  892%       hypothetical term-position for the module-qualifier.
  893
  894pce_method_body(A0, A, M, TermPos0, TermPos) :-
  895    TermPos0 = term_position(F, T, FF, FT,
  896                             [ HeadPos,
  897                               BodyPos0
  898                             ]),
  899    TermPos  = term_position(F, T, FF, FT,
  900                             [ HeadPos,
  901                               term_position(0,0,0,0, [0-0,BodyPos])
  902                             ]),
  903    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
  904
  905
  906pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
  907    !,
  908    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
  909    TermPos  = BodyPos,
  910    expand_goal(A0, A, M, BodyPos0, BodyPos).
  911pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  912    A0 =.. [Func,B0,C0],
  913    control_op(Func),
  914    !,
  915    A =.. [Func,B,C],
  916    TermPos0 = term_position(F, T, FF, FT,
  917                             [ BP0,
  918                               CP0
  919                             ]),
  920    TermPos  = term_position(F, T, FF, FT,
  921                             [ BP,
  922                               CP
  923                             ]),
  924    pce_method_body2(B0, B, M, BP0, BP),
  925    expand_goal(C0, C, M, CP0, CP).
  926pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  927    expand_goal(A0, A, M, TermPos0, TermPos).
  928
  929control_op(',').
  930control_op((;)).
  931control_op((->)).
  932control_op((*->)).
  933
  934                 /*******************************
  935                 *     EXPAND_GOAL SUPPORT      *
  936                 *******************************/
  937
  938/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  939With the introduction of expand_goal, it  is increasingly hard to relate
  940the clause from the database to the actual  source. For one thing, we do
  941not know the compilation  module  of  the   clause  (unless  we  want to
  942decompile it).
  943
  944Goal expansion can translate  goals   into  control-constructs, multiple
  945clauses, or delete a subgoal.
  946
  947To keep track of the source-locations, we   have to redo the analysis of
  948the clause as defined in init.pl
  949- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  950
  951expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
  952    var(G),
  953    !.
  954expand_goal(G, G1, _, P, P) :-
  955    var(G),
  956    !,
  957    G1 = G.
  958expand_goal(M0, M, Module, P0, P) :-
  959    meta(Module, M0, S),
  960    !,
  961    P0 = term_position(F,T,FF,FT,PL0),
  962    P  = term_position(F,T,FF,FT,PL),
  963    functor(M0, Functor, Arity),
  964    functor(M,  Functor, Arity),
  965    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
  966expand_goal(A, B, Module, P0, P) :-
  967    goal_expansion(A, B0, P0, P1),
  968    !,
  969    expand_goal(B0, B, Module, P1, P).
  970expand_goal(A, A, _, P, P).
  971
  972expand_meta_args([],      [],   _,  _, _,      _,  _).
  973expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
  974    arg(I, M0, A0),
  975    arg(I, M,  A),
  976    arg(I, S,  AS),
  977    expand_arg(AS, A0, A, Module, P0, P),
  978    NI is I + 1,
  979    expand_meta_args(T0, T, NI, S, Module, M0, M).
  980
  981expand_arg(0, A0, A, Module, P0, P) :-
  982    !,
  983    expand_goal(A0, A, Module, P0, P).
  984expand_arg(_, A, A, _, P, P).
  985
  986meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
  987
  988goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
  989    compound(Msg),
  990    Msg =.. [send_super, Selector | Args],
  991    !,
  992    SuperMsg =.. [Selector|Args].
  993goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
  994    compound(Msg),
  995    Msg =.. [get_super, Selector | Args],
  996    !,
  997    SuperMsg =.. [Selector|Args].
  998goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
  999goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
 1000goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
 1001    compound(SendSuperN),
 1002    compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]),
 1003    Msg =.. [Sel|Args].
 1004goal_expansion(SendN, send(R, Msg), P, P) :-
 1005    compound(SendN),
 1006    compound_name_arguments(SendN, send, [R,Sel|Args]),
 1007    atom(Sel), Args \== [],
 1008    Msg =.. [Sel|Args].
 1009goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
 1010    compound(GetSuperN),
 1011    compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]),
 1012    append(Args, [Answer], AllArgs),
 1013    Msg =.. [Sel|Args].
 1014goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
 1015    compound(GetN),
 1016    compound_name_arguments(GetN, get, [R,Sel|AllArgs]),
 1017    append(Args, [Answer], AllArgs),
 1018    atom(Sel), Args \== [],
 1019    Msg =.. [Sel|Args].
 1020goal_expansion(G0, G, P, P) :-
 1021    user:goal_expansion(G0, G),     % TBD: we need the module!
 1022    G0 \== G.                       % \=@=?
 1023
 1024
 1025                 /*******************************
 1026                 *        INITIALIZATION        *
 1027                 *******************************/

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

Find term-layout of :- initialization directives.

 1034initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
 1035    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
 1036    Directive    = (:- initialization(ReadGoal)),
 1037    DirectivePos = term_position(_, _, _, _, [InitPos]),
 1038    InitPos      = term_position(_, _, _, _, [GoalPos]),
 1039    (   ReadGoal = M:_
 1040    ->  Goal = M:Goal0
 1041    ;   Goal = Goal0
 1042    ),
 1043    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
 1044    !.
 1045
 1046
 1047                 /*******************************
 1048                 *        PRINTABLE NAMES       *
 1049                 *******************************/
 1050
 1051:- module_transparent
 1052    predicate_name/2. 1053:- multifile
 1054    user:prolog_predicate_name/2,
 1055    user:prolog_clause_name/2. 1056
 1057hidden_module(user).
 1058hidden_module(system).
 1059hidden_module(pce_principal).           % should be config
 1060hidden_module(Module) :-                % SWI-Prolog specific
 1061    import_module(Module, system).
 1062
 1063thaffix(1, st) :- !.
 1064thaffix(2, nd) :- !.
 1065thaffix(_, th).

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

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

 1071predicate_name(Predicate, PName) :-
 1072    strip_module(Predicate, Module, Head),
 1073    (   user:prolog_predicate_name(Module:Head, PName)
 1074    ->  true
 1075    ;   functor(Head, Name, Arity),
 1076        (   hidden_module(Module)
 1077        ->  format(string(PName), '~q/~d', [Name, Arity])
 1078        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
 1079        )
 1080    ).

 clause_name(+Ref, -Name)

Provide a suitable description of the indicated clause.

 1086clause_name(Ref, Name) :-
 1087    user:prolog_clause_name(Ref, Name),
 1088    !.
 1089clause_name(Ref, Name) :-
 1090    nth_clause(Head, N, Ref),
 1091    !,
 1092    predicate_name(Head, PredName),
 1093    thaffix(N, Th),
 1094    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
 1095clause_name(Ref, Name) :-
 1096    clause_property(Ref, erased),
 1097    !,
 1098    clause_property(Ref, predicate(M:PI)),
 1099    format(string(Name), 'erased clause from ~q', [M:PI]).
 1100clause_name(_, '<meta-call>')