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

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

 expand_failed(+Exception, +Term)

When debugging, indicate that expansion of the term failed.

  397expand_failed(E, Read) :-
  398    debugging(clause_info),
  399    message_to_string(E, Msg),
  400    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  401    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.

  410unify_body(B, C, _, Pos, Pos) :-
  411    B =@= C, B = C,
  412    does_not_dcg_after_binding(B, Pos),
  413    !.
  414unify_body(R, D, Module,
  415           term_position(F,T,FF,FT,[HP,BP0]),
  416           term_position(F,T,FF,FT,[HP,BP])) :-
  417    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.

  427does_not_dcg_after_binding(B, Pos) :-
  428    \+ sub_term(brace_term_position(_,_,_), Pos),
  429    \+ (sub_term((Cut,_=_), B), Cut == !),
  430    !.
  431
  432
  433/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  434Some remarks.
  435
  436a --> { x, y, z }.
  437    This is translated into "(x,y),z), X=Y" by the DCG translator, after
  438    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
  439- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

 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

  454ubody(B, DB, _, P, P) :-
  455    var(P),                        % TBD: Create compatible pos term?
  456    !,
  457    B = DB.
  458ubody(B, C, _, P, P) :-
  459    B =@= C, B = C,
  460    does_not_dcg_after_binding(B, P),
  461    !.
  462ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :-
  463    !,
  464    ubody(X0, X, M, P0, P).
  465ubody(X, call(X), _,                    % X = call(X)
  466      Pos,
  467      term_position(From, To, From, To, [Pos])) :-
  468    !,
  469    arg(1, Pos, From),
  470    arg(2, Pos, To).
  471ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :-
  472    nonvar(B), B = M:R,
  473    ubody(R, D, M, RP, TPOut).
  474ubody(B0, B, M,
  475      brace_term_position(F,T,A0),
  476      Pos) :-
  477    B0 = (_,_=_),
  478    !,
  479    T1 is T - 1,
  480    ubody(B0, B, M,
  481          term_position(F,T,
  482                        F,T,
  483                        [A0,T1-T]),
  484          Pos).
  485ubody(B0, B, M,
  486      brace_term_position(F,T,A0),
  487      term_position(F,T,F,T,[A])) :-
  488    !,
  489    ubody(B0, B, M, A0, A).
  490ubody(C0, C, M, P0, P) :-
  491    nonvar(C0), nonvar(C),
  492    C0 = (_,_), C = (_,_),
  493    !,
  494    conj(C0, P0, GL, PL),
  495    mkconj(C, M, P, GL, PL).
  496ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :-
  497    unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled),
  498    !.
  499ubody(X0, X, M,
  500      term_position(F,T,FF,TT,PA0),
  501      term_position(F,T,FF,TT,PA)) :-
  502    meta(M, X0, S),
  503    !,
  504    X0 =.. [_|A0],
  505    X  =.. [_|A],
  506    S =.. [_|AS],
  507    ubody_list(A0, A, AS, M, PA0, PA).
  508ubody(X0, X, M,
  509      term_position(F,T,FF,TT,PA0),
  510      term_position(F,T,FF,TT,PA)) :-
  511    expand_goal(X0, X, M, PA0, PA).
  512
  513                                        % 5.7.X optimizations
  514ubody(_=_, true, _,                     % singleton = Any
  515      term_position(F,T,_FF,_TT,_PA),
  516      F-T) :- !.
  517ubody(_==_, fail, _,                    % singleton/firstvar == Any
  518      term_position(F,T,_FF,_TT,_PA),
  519      F-T) :- !.
  520ubody(A1=B1, B2=A2, _,                  % Term = Var --> Var = Term
  521      term_position(F,T,FF,TT,[PA1,PA2]),
  522      term_position(F,T,FF,TT,[PA2,PA1])) :-
  523    var(B1), var(B2),
  524    (A1==B1) =@= (B2==A2),
  525    !,
  526    A1 = A2, B1=B2.
  527ubody(A1==B1, B2==A2, _,                % const == Var --> Var == const
  528      term_position(F,T,FF,TT,[PA1,PA2]),
  529      term_position(F,T,FF,TT,[PA2,PA1])) :-
  530    var(B1), var(B2),
  531    (A1==B1) =@= (B2==A2),
  532    !,
  533    A1 = A2, B1=B2.
  534ubody(A is B - C, A is B + C2, _, Pos, Pos) :-
  535    integer(C),
  536    C2 =:= -C,
  537    !.
  538
  539ubody_list([], [], [], _, [], []).
  540ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
  541    ubody_elem(AS, G0, G, M, PA0, PA),
  542    ubody_list(T0, T, ASL, M, PAT0, PAT).
  543
  544ubody_elem(0, G0, G, M, PA0, PA) :-
  545    !,
  546    ubody(G0, G, M, PA0, PA).
  547ubody_elem(_, G, G, _, PA, PA).
  548
  549conj(Goal, Pos, GoalList, PosList) :-
  550    conj(Goal, Pos, GoalList, [], PosList, []).
  551
  552conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
  553    !,
  554    conj(A, PA, GL, TGA, PL, TPA),
  555    conj(B, PB, TGA, TG, TPA, TP).
  556conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
  557    B = (_=_),
  558    !,
  559    conj(A, PA, GL, TGA, PL, TPA),
  560    T1 is T - 1,
  561    conj(B, T1-T, TGA, TG, TPA, TP).
  562conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :-
  563    nonvar(Pos),
  564    !,
  565    conj(A, Pos, GL, TG, PL, TP).
  566conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
  567    F1 is F+1,
  568    T1 is T+1.
  569conj(A, P, [A|TG], TG, [P|TP], TP).
  570
  571
  572mkconj(Goal, M, Pos, GoalList, PosList) :-
  573    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
  574
  575mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
  576    nonvar(Conj),
  577    Conj = (A,B),
  578    !,
  579    mkconj(A, M, PA, GL, TGA, PL, TPA),
  580    mkconj(B, M, PB, TGA, TG, TPA, TP).
  581mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
  582    ubody(A, A0, M, P, P0).
  583
  584
  585                 /*******************************
  586                 *    PCE STUFF (SHOULD MOVE)   *
  587                 *******************************/
  588
  589/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  590        <method>(Receiver, ... Arg ...) :->
  591                Body
  592
  593mapped to:
  594
  595        send_implementation(Id, <method>(...Arg...), Receiver)
  596
  597- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  598
  599pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
  600    !,
  601    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
  602pce_method_clause(Head, Body,
  603                  send_implementation(_Id, Msg, Receiver), PlBody,
  604                  M, TermPos0, TermPos) :-
  605    !,
  606    debug(clause_info, 'send method ...', []),
  607    arg(1, Head, Receiver),
  608    functor(Head, _, Arity),
  609    pce_method_head_arguments(2, Arity, Head, Msg),
  610    debug(clause_info, 'head ...', []),
  611    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  612pce_method_clause(Head, Body,
  613                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
  614                  M, TermPos0, TermPos) :-
  615    !,
  616    debug(clause_info, 'get method ...', []),
  617    arg(1, Head, Receiver),
  618    debug(clause_info, 'receiver ...', []),
  619    functor(Head, _, Arity),
  620    arg(Arity, Head, PceResult),
  621    debug(clause_info, '~w?~n', [PceResult = Result]),
  622    pce_unify_head_arg(PceResult, Result),
  623    Ar is Arity - 1,
  624    pce_method_head_arguments(2, Ar, Head, Msg),
  625    debug(clause_info, 'head ...', []),
  626    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  627
  628pce_method_head_arguments(N, Arity, Head, Msg) :-
  629    N =< Arity,
  630    !,
  631    arg(N, Head, PceArg),
  632    PLN is N - 1,
  633    arg(PLN, Msg, PlArg),
  634    pce_unify_head_arg(PceArg, PlArg),
  635    debug(clause_info, '~w~n', [PceArg = PlArg]),
  636    NextArg is N+1,
  637    pce_method_head_arguments(NextArg, Arity, Head, Msg).
  638pce_method_head_arguments(_, _, _, _).
  639
  640pce_unify_head_arg(V, A) :-
  641    var(V),
  642    !,
  643    V = A.
  644pce_unify_head_arg(A:_=_, A) :- !.
  645pce_unify_head_arg(A:_, A).
  646
  647%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
  648%
  649%       Unify the body of an XPCE method.  Goal-expansion makes this
  650%       rather tricky, especially as we cannot call XPCE's expansion
  651%       on an isolated method.
  652%
  653%       TermPos0 is the term-position term of the whole clause!
  654%
  655%       Further, please note that the body of the method-clauses reside
  656%       in another module than pce_principal, and therefore the body
  657%       starts with an I_CONTEXT call. This implies we need a
  658%       hypothetical term-position for the module-qualifier.
  659
  660pce_method_body(A0, A, M, TermPos0, TermPos) :-
  661    TermPos0 = term_position(F, T, FF, FT,
  662                             [ HeadPos,
  663                               BodyPos0
  664                             ]),
  665    TermPos  = term_position(F, T, FF, FT,
  666                             [ HeadPos,
  667                               term_position(0,0,0,0, [0-0,BodyPos])
  668                             ]),
  669    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
  670
  671
  672pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
  673    !,
  674    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
  675    TermPos  = BodyPos,
  676    expand_goal(A0, A, M, BodyPos0, BodyPos).
  677pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  678    A0 =.. [Func,B0,C0],
  679    control_op(Func),
  680    !,
  681    A =.. [Func,B,C],
  682    TermPos0 = term_position(F, T, FF, FT,
  683                             [ BP0,
  684                               CP0
  685                             ]),
  686    TermPos  = term_position(F, T, FF, FT,
  687                             [ BP,
  688                               CP
  689                             ]),
  690    pce_method_body2(B0, B, M, BP0, BP),
  691    expand_goal(C0, C, M, CP0, CP).
  692pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  693    expand_goal(A0, A, M, TermPos0, TermPos).
  694
  695control_op(',').
  696control_op((;)).
  697control_op((->)).
  698control_op((*->)).
  699
  700                 /*******************************
  701                 *     EXPAND_GOAL SUPPORT      *
  702                 *******************************/
  703
  704/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  705With the introduction of expand_goal, it  is increasingly hard to relate
  706the clause from the database to the actual  source. For one thing, we do
  707not know the compilation  module  of  the   clause  (unless  we  want to
  708decompile it).
  709
  710Goal expansion can translate  goals   into  control-constructs, multiple
  711clauses, or delete a subgoal.
  712
  713To keep track of the source-locations, we   have to redo the analysis of
  714the clause as defined in init.pl
  715- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  716
  717expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
  718    var(G),
  719    !.
  720expand_goal(G, G, _, P, P) :-
  721    var(G),
  722    !.
  723expand_goal(M0, M, Module, P0, P) :-
  724    meta(Module, M0, S),
  725    !,
  726    P0 = term_position(F,T,FF,FT,PL0),
  727    P  = term_position(F,T,FF,FT,PL),
  728    functor(M0, Functor, Arity),
  729    functor(M,  Functor, Arity),
  730    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
  731expand_goal(A, B, Module, P0, P) :-
  732    goal_expansion(A, B0, P0, P1),
  733    !,
  734    expand_goal(B0, B, Module, P1, P).
  735expand_goal(A, A, _, P, P).
  736
  737expand_meta_args([],      [],   _,  _, _,      _,  _).
  738expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
  739    arg(I, M0, A0),
  740    arg(I, M,  A),
  741    arg(I, S,  AS),
  742    expand_arg(AS, A0, A, Module, P0, P),
  743    NI is I + 1,
  744    expand_meta_args(T0, T, NI, S, Module, M0, M).
  745
  746expand_arg(0, A0, A, Module, P0, P) :-
  747    !,
  748    expand_goal(A0, A, Module, P0, P).
  749expand_arg(_, A, A, _, P, P).
  750
  751meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
  752
  753goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
  754    compound(Msg),
  755    Msg =.. [send_super, Selector | Args],
  756    !,
  757    SuperMsg =.. [Selector|Args].
  758goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
  759    compound(Msg),
  760    Msg =.. [get_super, Selector | Args],
  761    !,
  762    SuperMsg =.. [Selector|Args].
  763goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
  764goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
  765goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
  766    compound(SendSuperN),
  767    compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]),
  768    Msg =.. [Sel|Args].
  769goal_expansion(SendN, send(R, Msg), P, P) :-
  770    compound(SendN),
  771    compound_name_arguments(SendN, send, [R,Sel|Args]),
  772    atom(Sel), Args \== [],
  773    Msg =.. [Sel|Args].
  774goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
  775    compound(GetSuperN),
  776    compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]),
  777    append(Args, [Answer], AllArgs),
  778    Msg =.. [Sel|Args].
  779goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
  780    compound(GetN),
  781    compound_name_arguments(GetN, get, [R,Sel|AllArgs]),
  782    append(Args, [Answer], AllArgs),
  783    atom(Sel), Args \== [],
  784    Msg =.. [Sel|Args].
  785goal_expansion(G0, G, P, P) :-
  786    user:goal_expansion(G0, G),     % TBD: we need the module!
  787    G0 \== G.                       % \=@=?
  788
  789
  790                 /*******************************
  791                 *        INITIALIZATION        *
  792                 *******************************/

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

Find term-layout of :- initialization directives.

  799initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
  800    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
  801    Directive    = (:- initialization(ReadGoal)),
  802    DirectivePos = term_position(_, _, _, _, [InitPos]),
  803    InitPos      = term_position(_, _, _, _, [GoalPos]),
  804    (   ReadGoal = M:_
  805    ->  Goal = M:Goal0
  806    ;   Goal = Goal0
  807    ),
  808    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
  809    !.
  810
  811
  812                 /*******************************
  813                 *        PRINTABLE NAMES       *
  814                 *******************************/
  815
  816:- module_transparent
  817    predicate_name/2.  818:- multifile
  819    user:prolog_predicate_name/2,
  820    user:prolog_clause_name/2.  821
  822hidden_module(user).
  823hidden_module(system).
  824hidden_module(pce_principal).           % should be config
  825hidden_module(Module) :-                % SWI-Prolog specific
  826    import_module(Module, system).
  827
  828thaffix(1, st) :- !.
  829thaffix(2, nd) :- !.
  830thaffix(_, th).

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

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

  836predicate_name(Predicate, PName) :-
  837    strip_module(Predicate, Module, Head),
  838    (   user:prolog_predicate_name(Module:Head, PName)
  839    ->  true
  840    ;   functor(Head, Name, Arity),
  841        (   hidden_module(Module)
  842        ->  format(string(PName), '~q/~d', [Name, Arity])
  843        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
  844        )
  845    ).

 clause_name(+Ref, -Name)

Provide a suitable description of the indicated clause.

  851clause_name(Ref, Name) :-
  852    user:prolog_clause_name(Ref, Name),
  853    !.
  854clause_name(Ref, Name) :-
  855    nth_clause(Head, N, Ref),
  856    !,
  857    predicate_name(Head, PredName),
  858    thaffix(N, Th),
  859    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
  860clause_name(Ref, Name) :-
  861    clause_property(Ref, erased),
  862    !,
  863    clause_property(Ref, predicate(M:PI)),
  864    format(string(Name), 'erased clause from ~q', [M:PI]).
  865clause_name(_, '<meta-call>')