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

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

  153unify_term(X, X) :- !.
  154unify_term(X1, X2) :-
  155    compound(X1),
  156    compound(X2),
  157    functor(X1, F, Arity),
  158    functor(X2, F, Arity),
  159    !,
  160    unify_args(0, Arity, X1, X2).
  161unify_term(X, Y) :-
  162    float(X), float(Y),
  163    !.
  164unify_term(X, Y) :-
  165    string(X),
  166    is_list(Y),
  167    string_codes(X, Y),
  168    !.
  169unify_term(_, Y) :-
  170    Y == '...',
  171    !.                          % elipses left by max_depth
  172unify_term(_:X, Y) :-
  173    unify_term(X, Y),
  174    !.
  175unify_term(X, _:Y) :-
  176    unify_term(X, Y),
  177    !.
  178unify_term(X, Y) :-
  179    format('[INTERNAL ERROR: Diff:~n'),
  180    portray_clause(X),
  181    format('~N*** <->~n'),
  182    portray_clause(Y),
  183    break.
  184
  185unify_args(N, N, _, _) :- !.
  186unify_args(I, Arity, T1, T2) :-
  187    A is I + 1,
  188    arg(A, T1, A1),
  189    arg(A, T2, A2),
  190    unify_term(A1, A2),
  191    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.
  199read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :-
  200    setup_call_cleanup(
  201        '$push_input_context'(clause_info),
  202        read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames),
  203        '$pop_input_context').
  204
  205read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :-
  206    catch(try_open_source(File, In), error(_,_), fail),
  207    set_stream(In, newline(detect)),
  208    call_cleanup(
  209        read_source_term_at_location(
  210            In, Clause,
  211            [ line(Line),
  212              module(Module),
  213              subterm_positions(TermPos),
  214              variable_names(VarNames)
  215            ]),
  216        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)
  229:- public try_open_source/2.            % used by library(prolog_breakpoints).
  230
  231try_open_source(File, In) :-
  232    open_source(File, In),
  233    !.
  234try_open_source(File, In) :-
  235    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
  254make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :-
  255    make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term),
  256    !.
  257make_varnames((Head --> _Body), _, Offsets, Names, Bindings) :-
  258    !,
  259    functor(Head, _, Arity),
  260    In is Arity,
  261    memberchk(In=IVar, Offsets),
  262    Names1 = ['<DCG_list>'=IVar|Names],
  263    Out is Arity + 1,
  264    memberchk(Out=OVar, Offsets),
  265    Names2 = ['<DCG_tail>'=OVar|Names1],
  266    make_varnames(xx, xx, Offsets, Names2, Bindings).
  267make_varnames(_, _, Offsets, Names, Bindings) :-
  268    length(Offsets, L),
  269    functor(Bindings, varnames, L),
  270    do_make_varnames(Offsets, Names, Bindings).
  271
  272do_make_varnames([], _, _).
  273do_make_varnames([N=Var|TO], Names, Bindings) :-
  274    (   find_varname(Var, Names, Name)
  275    ->  true
  276    ;   Name = '_'
  277    ),
  278    AN is N + 1,
  279    arg(AN, Bindings, Name),
  280    do_make_varnames(TO, Names, Bindings).
  281
  282find_varname(Var, [Name = TheVar|_], Name) :-
  283    Var == TheVar,
  284    !.
  285find_varname(Var, [_|T], Name) :-
  286    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.

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.
  302unify_clause(Read, Read, _, TermPos, TermPos) :-
  303    acyclic_term(Read),
  304    !.
  305                                        % XPCE send-methods
  306unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  307    unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos),
  308    !.
  309unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  310    !,
  311    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  312                                        % XPCE get-methods
  313unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  314    !,
  315    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  316                                        % Unit test clauses
  317unify_clause((TH :- Body),
  318             (_:'unit body'(_, _) :- !, Body), _,
  319             TP0, TP) :-
  320    (   TH = test(_,_)
  321    ;   TH = test(_)
  322    ),
  323    !,
  324    TP0 = term_position(F,T,FF,FT,[HP,BP]),
  325    TP  = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
  326                                        % module:head :- body
  327unify_clause((Head :- Read),
  328             (Head :- _M:Compiled), Module, TermPos0, TermPos) :-
  329    unify_clause((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
  330    TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
  331    TermPos  = term_position(TA,TZ,FA,FZ,
  332                             [ PH,
  333                               term_position(0,0,0,0,[0-0,PB])
  334                             ]).
  335                                        % DCG rules
  336unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  337    Read = (_ --> Terminal, _),
  338    is_list(Terminal),
  339    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  340    Compiled2 = (DH :- _),
  341    functor(DH, _, Arity),
  342    DArg is Arity - 1,
  343    append(Terminal, _Tail, List),
  344    arg(DArg, DH, List),
  345    TermPos1 = term_position(F,T,FF,FT,[ HP,
  346                                         term_position(_,_,_,_,[_,BP])
  347                                       ]),
  348    !,
  349    TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]),
  350    match_module(Compiled2, Compiled1, Module, TermPos2, TermPos).
  351                                        % general term-expansion
  352unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  353    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  354    match_module(Compiled2, Compiled1, Module, TermPos1, TermPos).
  355                                        % I don't know ...
  356unify_clause(_, _, _, _, _) :-
  357    debug(clause_info, 'Could not unify clause', []),
  358    fail.
  359
  360unify_clause_head(H1, H2) :-
  361    strip_module(H1, _, H),
  362    strip_module(H2, _, H).
  363
  364ci_expand(Read, Compiled, Module, TermPos0, TermPos) :-
  365    catch(setup_call_cleanup(
  366              ( set_xref_flag(OldXRef),
  367                '$set_source_module'(Old, Module)
  368              ),
  369              expand_term(Read, TermPos0, Compiled, TermPos),
  370              ( '$set_source_module'(Old),
  371                set_prolog_flag(xref, OldXRef)
  372              )),
  373          E,
  374          expand_failed(E, Read)).
  375
  376set_xref_flag(Value) :-
  377    current_prolog_flag(xref, Value),
  378    !,
  379    set_prolog_flag(xref, true).
  380set_xref_flag(false) :-
  381    create_prolog_flag(xref, true, [type(boolean)]).
  382
  383match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :-
  384    !,
  385    unify_clause_head(H1, H2),
  386    unify_body(B1, B2, Module, Pos0, Pos).
  387match_module((H1 :- B1), H2, _Module, Pos0, Pos) :-
  388    B1 == true,
  389    unify_clause_head(H1, H2),
  390    Pos = Pos0,
  391    !.
  392match_module(H1, H2, _, Pos, Pos) :-    % deal with facts
  393    unify_clause_head(H1, H2).
 expand_failed(+Exception, +Term)
When debugging, indicate that expansion of the term failed.
  399expand_failed(E, Read) :-
  400    debugging(clause_info),
  401    message_to_string(E, Msg),
  402    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  403    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.

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