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

 clause_info(+ClauseRef, -File, -TermPos, -VarOffsets) is semidet

 clause_info(+ClauseRef, -File, -TermPos, -VarOffsets, +Options) is semidet

Fetches source information for the given clause. File is the file from which the clause was loaded. TermPos describes the source layout in a format compatible to the subterm_positions option of read_term/2. VarOffsets provides access to the variable allocation in a stack-frame. See make_varnames/5 for details.

Note that positions are character positions, i.e., not bytes. Line endings count as a single character, regardless of whether the actual ending is \n or =|\r\n|_.

Defined options are:

variable_names(-Names)

Unify Names with the variable names list (Name=Var) as returned by read_term/3. This argument is intended for reporting source locations and refactoring based on analysis of the compiled code.

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

 unify_term(+T1, +T2)

Unify the two terms, where T2 is created by writing the term and reading it back in, but be aware that rounding problems may cause floating point numbers not to unify. Also, if the initial term has a string object, it is written as "..." and read as a code-list. We compensate for that.

NOTE: Called directly from library(trace/clause) for the GUI tracer.

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

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

Read a term from File at Line.

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

 open_source(+File, -Stream) is semidet

Hook into clause_info/5 that opens the stream holding the source for a specific clause. Thus, the query must succeed. The default implementation calls open/3 on the File property.

clause_property(ClauseRef, file(File)),
prolog_clause:open_source(File, Stream)

  234:- public try_open_source/2.            % used by library(prolog_breakpoints).
  235
  236try_open_source(File, In) :-
  237    open_source(File, In),
  238    !.
  239try_open_source(File, In) :-
  240    open(File, read, In).

 make_varnames(+ReadClause, +DecompiledClause, +Offsets, +Names, -Term) is det

Create a Term varnames(...) where each argument contains the name of the variable at that offset. If the read Clause is a DCG rule, name the two last arguments <DCG_list> and <DCG_tail>

This predicate calles the multifile predicate make_varnames_hook/5 with the same arguments to allow for user extensions. Extending this predicate is needed if a compiler adds additional arguments to the clause head that must be made visible in the GUI tracer.

Arguments:

Offsets	- List of Offset=Var
Names	- List of Name=Var

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

 unify_clause(+Read, +Decompiled, +Module, +ReadTermPos, -RecompiledTermPos)

What you read isn't always what goes into the database. The task of this predicate is to establish the relation between the term read from the file and the result from decompiling the clause.

This predicate calls the multifile predicate unify_clause_hook/5 with the same arguments to support user extensions.

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.

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

 expand_failed(+Exception, +Term)

When debugging, indicate that expansion of the term failed.

  430expand_failed(E, Read) :-
  431    debugging(clause_info),
  432    message_to_string(E, Msg),
  433    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  434    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.

  443unify_body(B, C, _, Pos, Pos) :-
  444    B =@= C, B = C,
  445    does_not_dcg_after_binding(B, Pos),
  446    !.
  447unify_body(R, D, Module,
  448           term_position(F,T,FF,FT,[HP,BP0]),
  449           term_position(F,T,FF,FT,[HP,BP])) :-
  450    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.

  460does_not_dcg_after_binding(B, Pos) :-
  461    \+ sub_term(brace_term_position(_,_,_), Pos),
  462    \+ (sub_term((Cut,_=_), B), Cut == !),
  463    !.
  464
  465
  466/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  467Some remarks.
  468
  469a --> { x, y, z }.
  470    This is translated into "(x,y),z), X=Y" by the DCG translator, after
  471    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
  472- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

 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

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

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

Find term-layout of :- initialization directives.

  851initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
  852    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
  853    Directive    = (:- initialization(ReadGoal)),
  854    DirectivePos = term_position(_, _, _, _, [InitPos]),
  855    InitPos      = term_position(_, _, _, _, [GoalPos]),
  856    (   ReadGoal = M:_
  857    ->  Goal = M:Goal0
  858    ;   Goal = Goal0
  859    ),
  860    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
  861    !.
  862
  863
  864                 /*******************************
  865                 *        PRINTABLE NAMES       *
  866                 *******************************/
  867
  868:- module_transparent
  869    predicate_name/2.  870:- multifile
  871    user:prolog_predicate_name/2,
  872    user:prolog_clause_name/2.  873
  874hidden_module(user).
  875hidden_module(system).
  876hidden_module(pce_principal).           % should be config
  877hidden_module(Module) :-                % SWI-Prolog specific
  878    import_module(Module, system).
  879
  880thaffix(1, st) :- !.
  881thaffix(2, nd) :- !.
  882thaffix(_, th).

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

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

  888predicate_name(Predicate, PName) :-
  889    strip_module(Predicate, Module, Head),
  890    (   user:prolog_predicate_name(Module:Head, PName)
  891    ->  true
  892    ;   functor(Head, Name, Arity),
  893        (   hidden_module(Module)
  894        ->  format(string(PName), '~q/~d', [Name, Arity])
  895        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
  896        )
  897    ).

 clause_name(+Ref, -Name)

Provide a suitable description of the indicated clause.

  903clause_name(Ref, Name) :-
  904    user:prolog_clause_name(Ref, Name),
  905    !.
  906clause_name(Ref, Name) :-
  907    nth_clause(Head, N, Ref),
  908    !,
  909    predicate_name(Head, PredName),
  910    thaffix(N, Th),
  911    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
  912clause_name(Ref, Name) :-
  913    clause_property(Ref, erased),
  914    !,
  915    clause_property(Ref, predicate(M:PI)),
  916    format(string(Name), 'erased clause from ~q', [M:PI]).
  917clause_name(_, '<meta-call>')