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

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