View source with raw comments or as raw
    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-2021, 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:- autoload(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                     ]).

Get detailed source-information about a clause

This module started life as part of the GUI tracer. As it is generally useful for debugging purposes it has moved to the general Prolog library.

The tracer library library(trace/clause) adds caching and dealing with dynamic predicates using listing to XPCE objects to this. Note that clause_info/4 as below can be slow. */

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

  155unify_term(X, X) :- !.
  156unify_term(X1, X2) :-
  157    compound(X1),
  158    compound(X2),
  159    functor(X1, F, Arity),
  160    functor(X2, F, Arity),
  161    !,
  162    unify_args(0, Arity, X1, X2).
  163unify_term(X, Y) :-
  164    float(X), float(Y),
  165    !.
  166unify_term(X, '$BLOB'(_)) :-
  167    blob(X, _),
  168    \+ atom(X).
  169unify_term(X, Y) :-
  170    string(X),
  171    is_list(Y),
  172    string_codes(X, Y),
  173    !.
  174unify_term(_, Y) :-
  175    Y == '...',
  176    !.                          % elipses left by max_depth
  177unify_term(_:X, Y) :-
  178    unify_term(X, Y),
  179    !.
  180unify_term(X, _:Y) :-
  181    unify_term(X, Y),
  182    !.
  183unify_term(X, Y) :-
  184    format('[INTERNAL ERROR: Diff:~n'),
  185    portray_clause(X),
  186    format('~N*** <->~n'),
  187    portray_clause(Y),
  188    break.
  189
  190unify_args(N, N, _, _) :- !.
  191unify_args(I, Arity, T1, T2) :-
  192    A is I + 1,
  193    arg(A, T1, A1),
  194    arg(A, T2, A2),
  195    unify_term(A1, A2),
  196    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.
  204read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :-
  205    setup_call_cleanup(
  206        '$push_input_context'(clause_info),
  207        read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames),
  208        '$pop_input_context').
  209
  210read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :-
  211    catch(try_open_source(File, In), error(_,_), fail),
  212    set_stream(In, newline(detect)),
  213    call_cleanup(
  214        read_source_term_at_location(
  215            In, Clause,
  216            [ line(Line),
  217              module(Module),
  218              subterm_positions(TermPos),
  219              variable_names(VarNames)
  220            ]),
  221        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)
  234:- public try_open_source/2.            % used by library(prolog_breakpoints).
  235
  236try_open_source(File, In) :-
  237    open_source(File, In),
  238    !.
  239try_open_source(File, In) :-
  240    open(File, read, In).
 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
  259make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :-
  260    make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term),
  261    !.
  262make_varnames((Head --> _Body), _, Offsets, Names, Bindings) :-
  263    !,
  264    functor(Head, _, Arity),
  265    In is Arity,
  266    memberchk(In=IVar, Offsets),
  267    Names1 = ['<DCG_list>'=IVar|Names],
  268    Out is Arity + 1,
  269    memberchk(Out=OVar, Offsets),
  270    Names2 = ['<DCG_tail>'=OVar|Names1],
  271    make_varnames(xx, xx, Offsets, Names2, Bindings).
  272make_varnames(_, _, Offsets, Names, Bindings) :-
  273    length(Offsets, L),
  274    functor(Bindings, varnames, L),
  275    do_make_varnames(Offsets, Names, Bindings).
  276
  277do_make_varnames([], _, _).
  278do_make_varnames([N=Var|TO], Names, Bindings) :-
  279    (   find_varname(Var, Names, Name)
  280    ->  true
  281    ;   Name = '_'
  282    ),
  283    AN is N + 1,
  284    arg(AN, Bindings, Name),
  285    do_make_varnames(TO, Names, Bindings).
  286
  287find_varname(Var, [Name = TheVar|_], Name) :-
  288    Var == TheVar,
  289    !.
  290find_varname(Var, [_|T], Name) :-
  291    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.
  314unify_clause(Read, _, _, _, _) :-
  315    var(Read),
  316    !,
  317    fail.
  318unify_clause(Read, Decompiled, _, TermPos, TermPos) :-
  319    Read =@= Decompiled,
  320    !,
  321    Read = Decompiled.
  322                                        % XPCE send-methods
  323unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  324    unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos),
  325    !.
  326unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  327    !,
  328    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  329                                        % XPCE get-methods
  330unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  331    !,
  332    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  333                                        % Unit test clauses
  334unify_clause((TH :- Body),
  335             (_:'unit body'(_, _) :- !, Body), _,
  336             TP0, TP) :-
  337    (   TH = test(_,_)
  338    ;   TH = test(_)
  339    ),
  340    !,
  341    TP0 = term_position(F,T,FF,FT,[HP,BP]),
  342    TP  = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
  343                                        % module:head :- body
  344unify_clause((Head :- Read),
  345             (Head :- _M:Compiled), Module, TermPos0, TermPos) :-
  346    unify_clause((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
  347    TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
  348    TermPos  = term_position(TA,TZ,FA,FZ,
  349                             [ PH,
  350                               term_position(0,0,0,0,[0-0,PB])
  351                             ]).
  352                                        % DCG rules
  353unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  354    Read = (_ --> Terminal, _),
  355    is_list(Terminal),
  356    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  357    Compiled2 = (DH :- _),
  358    functor(DH, _, Arity),
  359    DArg is Arity - 1,
  360    append(Terminal, _Tail, List),
  361    arg(DArg, DH, List),
  362    TermPos1 = term_position(F,T,FF,FT,[ HP,
  363                                         term_position(_,_,_,_,[_,BP])
  364                                       ]),
  365    !,
  366    TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]),
  367    match_module(Compiled2, Compiled1, Module, TermPos2, TermPos).
  368unify_clause((Head,Cond => Body), Compiled1, Module,
  369             term_position(F,T,FF,FT,
  370                           [ term_position(_,_,_,_,[HP,CP]),
  371                             BP
  372                           ]),
  373             TermPos) :-
  374    !,
  375    TermPos1 = term_position(F,T,FF,FT,
  376                             [ HP,
  377                               term_position(_,_,_,_,
  378                                             [ CP,
  379                                               term_position(_,_,_,_,
  380                                                             [ FF-FT,
  381                                                               BP
  382                                                             ])
  383                                             ])
  384                             ]),
  385    unify_clause((Head :- Cond, !, Body), Compiled1, Module, TermPos1, TermPos).
  386unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :-
  387    !,
  388    unify_clause(Head :- Body, Compiled1, Module, TermPos0, TermPos).
  389                                        % general term-expansion
  390unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  391    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  392    match_module(Compiled2, Compiled1, Module, TermPos1, TermPos).
  393                                        % I don't know ...
  394unify_clause(_, _, _, _, _) :-
  395    debug(clause_info, 'Could not unify clause', []),
  396    fail.
  397
  398unify_clause_head(H1, H2) :-
  399    strip_module(H1, _, H),
  400    strip_module(H2, _, H).
  401
  402ci_expand(Read, Compiled, Module, TermPos0, TermPos) :-
  403    catch(setup_call_cleanup(
  404              ( set_xref_flag(OldXRef),
  405                '$set_source_module'(Old, Module)
  406              ),
  407              expand_term(Read, TermPos0, Compiled, TermPos),
  408              ( '$set_source_module'(Old),
  409                set_prolog_flag(xref, OldXRef)
  410              )),
  411          E,
  412          expand_failed(E, Read)),
  413    compound(TermPos),                  % make sure somthing is filled.
  414    arg(1, TermPos, A1), nonvar(A1),
  415    arg(2, TermPos, A2), nonvar(A2).
  416
  417set_xref_flag(Value) :-
  418    current_prolog_flag(xref, Value),
  419    !,
  420    set_prolog_flag(xref, true).
  421set_xref_flag(false) :-
  422    create_prolog_flag(xref, true, [type(boolean)]).
  423
  424match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :-
  425    !,
  426    unify_clause_head(H1, H2),
  427    unify_body(B1, B2, Module, Pos0, Pos).
  428match_module((H1 :- B1), H2, _Module, Pos0, Pos) :-
  429    B1 == true,
  430    unify_clause_head(H1, H2),
  431    Pos = Pos0,
  432    !.
  433match_module(H1, H2, _, Pos, Pos) :-    % deal with facts
  434    unify_clause_head(H1, H2).
 expand_failed(+Exception, +Term)
When debugging, indicate that expansion of the term failed.
  440expand_failed(E, Read) :-
  441    debugging(clause_info),
  442    message_to_string(E, Msg),
  443    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  444    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.

  453unify_body(B, C, _, Pos, Pos) :-
  454    B =@= C, B = C,
  455    does_not_dcg_after_binding(B, Pos),
  456    !.
  457unify_body(R, D, Module,
  458           term_position(F,T,FF,FT,[HP,BP0]),
  459           term_position(F,T,FF,FT,[HP,BP])) :-
  460    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.
  470does_not_dcg_after_binding(B, Pos) :-
  471    \+ sub_term(brace_term_position(_,_,_), Pos),
  472    \+ (sub_term((Cut,_=_), B), Cut == !),
  473    !.
  474
  475
  476/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  477Some remarks.
  478
  479a --> { x, y, z }.
  480    This is translated into "(x,y),z), X=Y" by the DCG translator, after
  481    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
  482- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 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
  497ubody(B, DB, _, P, P) :-
  498    var(P),                        % TBD: Create compatible pos term?
  499    !,
  500    B = DB.
  501ubody(B, C, _, P, P) :-
  502    B =@= C, B = C,
  503    does_not_dcg_after_binding(B, P),
  504    !.
  505ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :-
  506    !,
  507    ubody(X0, X, M, P0, P).
  508ubody(X, Y, _,                    % X = call(X)
  509      Pos,
  510      term_position(From, To, From, To, [Pos])) :-
  511    nonvar(Y),
  512    Y = call(X),
  513    !,
  514    arg(1, Pos, From),
  515    arg(2, Pos, To).
  516ubody(A, B, _, P1, P2) :-
  517    nonvar(A), A = (_=_),
  518    nonvar(B), B = (LB=RB),
  519    A =@= (RB=LB),
  520    !,
  521    P1 = term_position(F,T, FF,FT, [PL,PR]),
  522    P2 = term_position(F,T, FF,FT, [PR,PL]).
  523ubody(A, B, _, P1, P2) :-
  524    nonvar(A), A = (_==_),
  525    nonvar(B), B = (LB==RB),
  526    A =@= (RB==LB),
  527    !,
  528    P1 = term_position(F,T, FF,FT, [PL,PR]),
  529    P2 = term_position(F,T, FF,FT, [PR,PL]).
  530ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :-
  531    nonvar(B), B = M:R,
  532    ubody(R, D, M, RP, TPOut).
  533ubody(B0, B, M,
  534      brace_term_position(F,T,A0),
  535      Pos) :-
  536    B0 = (_,_=_),
  537    !,
  538    T1 is T - 1,
  539    ubody(B0, B, M,
  540          term_position(F,T,
  541                        F,T,
  542                        [A0,T1-T]),
  543          Pos).
  544ubody(B0, B, M,
  545      brace_term_position(F,T,A0),
  546      term_position(F,T,F,T,[A])) :-
  547    !,
  548    ubody(B0, B, M, A0, A).
  549ubody(C0, C, M, P0, P) :-
  550    nonvar(C0), nonvar(C),
  551    C0 = (_,_), C = (_,_),
  552    !,
  553    conj(C0, P0, GL, PL),
  554    mkconj(C, M, P, GL, PL).
  555ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :-
  556    unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled),
  557    !.
  558ubody(X0, X, M,
  559      term_position(F,T,FF,TT,PA0),
  560      term_position(F,T,FF,TT,PA)) :-
  561    meta(M, X0, S),
  562    !,
  563    X0 =.. [_|A0],
  564    X  =.. [_|A],
  565    S =.. [_|AS],
  566    ubody_list(A0, A, AS, M, PA0, PA).
  567ubody(X0, X, M,
  568      term_position(F,T,FF,TT,PA0),
  569      term_position(F,T,FF,TT,PA)) :-
  570    expand_goal(X0, X1, M, PA0, PA),
  571    X1 =@= X,
  572    X1 = X.
  573
  574                                        % 5.7.X optimizations
  575ubody(_=_, true, _,                     % singleton = Any
  576      term_position(F,T,_FF,_TT,_PA),
  577      F-T) :- !.
  578ubody(_==_, fail, _,                    % singleton/firstvar == Any
  579      term_position(F,T,_FF,_TT,_PA),
  580      F-T) :- !.
  581ubody(A1=B1, B2=A2, _,                  % Term = Var --> Var = Term
  582      term_position(F,T,FF,TT,[PA1,PA2]),
  583      term_position(F,T,FF,TT,[PA2,PA1])) :-
  584    var(B1), var(B2),
  585    (A1==B1) =@= (B2==A2),
  586    !,
  587    A1 = A2, B1=B2.
  588ubody(A1==B1, B2==A2, _,                % const == Var --> Var == const
  589      term_position(F,T,FF,TT,[PA1,PA2]),
  590      term_position(F,T,FF,TT,[PA2,PA1])) :-
  591    var(B1), var(B2),
  592    (A1==B1) =@= (B2==A2),
  593    !,
  594    A1 = A2, B1=B2.
  595ubody(A is B - C, A is B + C2, _, Pos, Pos) :-
  596    integer(C),
  597    C2 =:= -C,
  598    !.
  599
  600ubody_list([], [], [], _, [], []).
  601ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
  602    ubody_elem(AS, G0, G, M, PA0, PA),
  603    ubody_list(T0, T, ASL, M, PAT0, PAT).
  604
  605ubody_elem(0, G0, G, M, PA0, PA) :-
  606    !,
  607    ubody(G0, G, M, PA0, PA).
  608ubody_elem(_, G, G, _, PA, PA).
  609
  610conj(Goal, Pos, GoalList, PosList) :-
  611    conj(Goal, Pos, GoalList, [], PosList, []).
  612
  613conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
  614    !,
  615    conj(A, PA, GL, TGA, PL, TPA),
  616    conj(B, PB, TGA, TG, TPA, TP).
  617conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
  618    B = (_=_),
  619    !,
  620    conj(A, PA, GL, TGA, PL, TPA),
  621    T1 is T - 1,
  622    conj(B, T1-T, TGA, TG, TPA, TP).
  623conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :-
  624    nonvar(Pos),
  625    !,
  626    conj(A, Pos, GL, TG, PL, TP).
  627conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
  628    F1 is F+1,
  629    T1 is T+1.
  630conj(A, P, [A|TG], TG, [P|TP], TP).
  631
  632
  633mkconj(Goal, M, Pos, GoalList, PosList) :-
  634    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
  635
  636mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
  637    nonvar(Conj),
  638    Conj = (A,B),
  639    !,
  640    mkconj(A, M, PA, GL, TGA, PL, TPA),
  641    mkconj(B, M, PB, TGA, TG, TPA, TP).
  642mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
  643    ubody(A, A0, M, P, P0).
  644
  645
  646                 /*******************************
  647                 *    PCE STUFF (SHOULD MOVE)   *
  648                 *******************************/
  649
  650/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  651        <method>(Receiver, ... Arg ...) :->
  652                Body
  653
  654mapped to:
  655
  656        send_implementation(Id, <method>(...Arg...), Receiver)
  657
  658- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  659
  660pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
  661    !,
  662    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
  663pce_method_clause(Head, Body,
  664                  send_implementation(_Id, Msg, Receiver), PlBody,
  665                  M, TermPos0, TermPos) :-
  666    !,
  667    debug(clause_info, 'send method ...', []),
  668    arg(1, Head, Receiver),
  669    functor(Head, _, Arity),
  670    pce_method_head_arguments(2, Arity, Head, Msg),
  671    debug(clause_info, 'head ...', []),
  672    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  673pce_method_clause(Head, Body,
  674                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
  675                  M, TermPos0, TermPos) :-
  676    !,
  677    debug(clause_info, 'get method ...', []),
  678    arg(1, Head, Receiver),
  679    debug(clause_info, 'receiver ...', []),
  680    functor(Head, _, Arity),
  681    arg(Arity, Head, PceResult),
  682    debug(clause_info, '~w?~n', [PceResult = Result]),
  683    pce_unify_head_arg(PceResult, Result),
  684    Ar is Arity - 1,
  685    pce_method_head_arguments(2, Ar, Head, Msg),
  686    debug(clause_info, 'head ...', []),
  687    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  688
  689pce_method_head_arguments(N, Arity, Head, Msg) :-
  690    N =< Arity,
  691    !,
  692    arg(N, Head, PceArg),
  693    PLN is N - 1,
  694    arg(PLN, Msg, PlArg),
  695    pce_unify_head_arg(PceArg, PlArg),
  696    debug(clause_info, '~w~n', [PceArg = PlArg]),
  697    NextArg is N+1,
  698    pce_method_head_arguments(NextArg, Arity, Head, Msg).
  699pce_method_head_arguments(_, _, _, _).
  700
  701pce_unify_head_arg(V, A) :-
  702    var(V),
  703    !,
  704    V = A.
  705pce_unify_head_arg(A:_=_, A) :- !.
  706pce_unify_head_arg(A:_, A).
  707
  708%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
  709%
  710%       Unify the body of an XPCE method.  Goal-expansion makes this
  711%       rather tricky, especially as we cannot call XPCE's expansion
  712%       on an isolated method.
  713%
  714%       TermPos0 is the term-position term of the whole clause!
  715%
  716%       Further, please note that the body of the method-clauses reside
  717%       in another module than pce_principal, and therefore the body
  718%       starts with an I_CONTEXT call. This implies we need a
  719%       hypothetical term-position for the module-qualifier.
  720
  721pce_method_body(A0, A, M, TermPos0, TermPos) :-
  722    TermPos0 = term_position(F, T, FF, FT,
  723                             [ HeadPos,
  724                               BodyPos0
  725                             ]),
  726    TermPos  = term_position(F, T, FF, FT,
  727                             [ HeadPos,
  728                               term_position(0,0,0,0, [0-0,BodyPos])
  729                             ]),
  730    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
  731
  732
  733pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
  734    !,
  735    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
  736    TermPos  = BodyPos,
  737    expand_goal(A0, A, M, BodyPos0, BodyPos).
  738pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  739    A0 =.. [Func,B0,C0],
  740    control_op(Func),
  741    !,
  742    A =.. [Func,B,C],
  743    TermPos0 = term_position(F, T, FF, FT,
  744                             [ BP0,
  745                               CP0
  746                             ]),
  747    TermPos  = term_position(F, T, FF, FT,
  748                             [ BP,
  749                               CP
  750                             ]),
  751    pce_method_body2(B0, B, M, BP0, BP),
  752    expand_goal(C0, C, M, CP0, CP).
  753pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  754    expand_goal(A0, A, M, TermPos0, TermPos).
  755
  756control_op(',').
  757control_op((;)).
  758control_op((->)).
  759control_op((*->)).
  760
  761                 /*******************************
  762                 *     EXPAND_GOAL SUPPORT      *
  763                 *******************************/
  764
  765/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  766With the introduction of expand_goal, it  is increasingly hard to relate
  767the clause from the database to the actual  source. For one thing, we do
  768not know the compilation  module  of  the   clause  (unless  we  want to
  769decompile it).
  770
  771Goal expansion can translate  goals   into  control-constructs, multiple
  772clauses, or delete a subgoal.
  773
  774To keep track of the source-locations, we   have to redo the analysis of
  775the clause as defined in init.pl
  776- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  777
  778expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
  779    var(G),
  780    !.
  781expand_goal(G, G1, _, P, P) :-
  782    var(G),
  783    !,
  784    G1 = G.
  785expand_goal(M0, M, Module, P0, P) :-
  786    meta(Module, M0, S),
  787    !,
  788    P0 = term_position(F,T,FF,FT,PL0),
  789    P  = term_position(F,T,FF,FT,PL),
  790    functor(M0, Functor, Arity),
  791    functor(M,  Functor, Arity),
  792    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
  793expand_goal(A, B, Module, P0, P) :-
  794    goal_expansion(A, B0, P0, P1),
  795    !,
  796    expand_goal(B0, B, Module, P1, P).
  797expand_goal(A, A, _, P, P).
  798
  799expand_meta_args([],      [],   _,  _, _,      _,  _).
  800expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
  801    arg(I, M0, A0),
  802    arg(I, M,  A),
  803    arg(I, S,  AS),
  804    expand_arg(AS, A0, A, Module, P0, P),
  805    NI is I + 1,
  806    expand_meta_args(T0, T, NI, S, Module, M0, M).
  807
  808expand_arg(0, A0, A, Module, P0, P) :-
  809    !,
  810    expand_goal(A0, A, Module, P0, P).
  811expand_arg(_, A, A, _, P, P).
  812
  813meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
  814
  815goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
  816    compound(Msg),
  817    Msg =.. [send_super, Selector | Args],
  818    !,
  819    SuperMsg =.. [Selector|Args].
  820goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
  821    compound(Msg),
  822    Msg =.. [get_super, Selector | Args],
  823    !,
  824    SuperMsg =.. [Selector|Args].
  825goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
  826goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
  827goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
  828    compound(SendSuperN),
  829    compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]),
  830    Msg =.. [Sel|Args].
  831goal_expansion(SendN, send(R, Msg), P, P) :-
  832    compound(SendN),
  833    compound_name_arguments(SendN, send, [R,Sel|Args]),
  834    atom(Sel), Args \== [],
  835    Msg =.. [Sel|Args].
  836goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
  837    compound(GetSuperN),
  838    compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]),
  839    append(Args, [Answer], AllArgs),
  840    Msg =.. [Sel|Args].
  841goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
  842    compound(GetN),
  843    compound_name_arguments(GetN, get, [R,Sel|AllArgs]),
  844    append(Args, [Answer], AllArgs),
  845    atom(Sel), Args \== [],
  846    Msg =.. [Sel|Args].
  847goal_expansion(G0, G, P, P) :-
  848    user:goal_expansion(G0, G),     % TBD: we need the module!
  849    G0 \== G.                       % \=@=?
  850
  851
  852                 /*******************************
  853                 *        INITIALIZATION        *
  854                 *******************************/
 initialization_layout(+SourceLocation, ?InitGoal, -ReadGoal, -TermPos) is semidet
Find term-layout of :- initialization directives.
  861initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
  862    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
  863    Directive    = (:- initialization(ReadGoal)),
  864    DirectivePos = term_position(_, _, _, _, [InitPos]),
  865    InitPos      = term_position(_, _, _, _, [GoalPos]),
  866    (   ReadGoal = M:_
  867    ->  Goal = M:Goal0
  868    ;   Goal = Goal0
  869    ),
  870    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
  871    !.
  872
  873
  874                 /*******************************
  875                 *        PRINTABLE NAMES       *
  876                 *******************************/
  877
  878:- module_transparent
  879    predicate_name/2.  880:- multifile
  881    user:prolog_predicate_name/2,
  882    user:prolog_clause_name/2.  883
  884hidden_module(user).
  885hidden_module(system).
  886hidden_module(pce_principal).           % should be config
  887hidden_module(Module) :-                % SWI-Prolog specific
  888    import_module(Module, system).
  889
  890thaffix(1, st) :- !.
  891thaffix(2, nd) :- !.
  892thaffix(_, th).
 predicate_name(:Head, -PredName:string) is det
Describe a predicate as [Module:]Name/Arity.
  898predicate_name(Predicate, PName) :-
  899    strip_module(Predicate, Module, Head),
  900    (   user:prolog_predicate_name(Module:Head, PName)
  901    ->  true
  902    ;   functor(Head, Name, Arity),
  903        (   hidden_module(Module)
  904        ->  format(string(PName), '~q/~d', [Name, Arity])
  905        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
  906        )
  907    ).
 clause_name(+Ref, -Name)
Provide a suitable description of the indicated clause.
  913clause_name(Ref, Name) :-
  914    user:prolog_clause_name(Ref, Name),
  915    !.
  916clause_name(Ref, Name) :-
  917    nth_clause(Head, N, Ref),
  918    !,
  919    predicate_name(Head, PredName),
  920    thaffix(N, Th),
  921    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
  922clause_name(Ref, Name) :-
  923    clause_property(Ref, erased),
  924    !,
  925    clause_property(Ref, predicate(M:PI)),
  926    format(string(Name), 'erased clause from ~q', [M:PI]).
  927clause_name(_, '<meta-call>')