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:- autoload(library(debug),[debugging/1,debug/3]).   46:- autoload(library(listing),[portray_clause/1]).   47:- autoload(library(lists),[append/3]).   48:- autoload(library(occurs),[sub_term/2]).   49:- autoload(library(option),[option/3]).   50:- autoload(library(prolog_source),[read_source_term_at_location/3]).   51
   52
   53:- public                               % called from library(trace/clause)
   54    unify_term/2,
   55    make_varnames/5,
   56    do_make_varnames/3.   57
   58:- multifile
   59    unify_goal/5,                   % +Read, +Decomp, +M, +Pos, -Pos
   60    unify_clause_hook/5,
   61    make_varnames_hook/5,
   62    open_source/2.                  % +Input, -Stream
   63
   64:- predicate_options(prolog_clause:clause_info/5, 5,
   65                     [ head(-any),
   66                       body(-any),
   67                       variable_names(-list)
   68                     ]).   69
   70/** <module> Get detailed source-information about a clause
   71
   72This module started life as part of the   GUI tracer. As it is generally
   73useful for debugging  purposes  it  has   moved  to  the  general Prolog
   74library.
   75
   76The tracer library library(trace/clause) adds   caching and dealing with
   77dynamic predicates using listing to  XPCE   objects  to  this. Note that
   78clause_info/4 as below can be slow.
   79*/
   80
   81%!  clause_info(+ClauseRef, -File, -TermPos, -VarOffsets) is semidet.
   82%!  clause_info(+ClauseRef, -File, -TermPos, -VarOffsets, +Options) is semidet.
   83%
   84%   Fetches source information for the  given   clause.  File is the
   85%   file from which the clause  was   loaded.  TermPos describes the
   86%   source layout in a format   compatible  to the subterm_positions
   87%   option  of  read_term/2.  VarOffsets  provides   access  to  the
   88%   variable allocation in a stack-frame.   See  make_varnames/5 for
   89%   details.
   90%
   91%   Note that positions are  _|character   positions|_,  i.e., _not_
   92%   bytes. Line endings count as a   single character, regardless of
   93%   whether the actual ending is =|\n|= or =|\r\n|_.
   94%
   95%   Defined options are:
   96%
   97%     * variable_names(-Names)
   98%     Unify Names with the variable names list (Name=Var) as
   99%     returned by read_term/3.  This argument is intended for
  100%     reporting source locations and refactoring based on
  101%     analysis of the compiled code.
  102
  103clause_info(ClauseRef, File, TermPos, NameOffset) :-
  104    clause_info(ClauseRef, File, TermPos, NameOffset, []).
  105
  106clause_info(ClauseRef, File, TermPos, NameOffset, Options) :-
  107    (   debugging(clause_info)
  108    ->  clause_name(ClauseRef, Name),
  109        debug(clause_info, 'clause_info(~w) (~w)... ',
  110              [ClauseRef, Name])
  111    ;   true
  112    ),
  113    clause_property(ClauseRef, file(File)),
  114    File \== user,                  % loaded using ?- [user].
  115    '$clause'(Head0, Body, ClauseRef, VarOffset),
  116    option(head(Head0), Options, _),
  117    option(body(Body), Options, _),
  118    (   module_property(Module, file(File))
  119    ->  true
  120    ;   strip_module(user:Head0, Module, _)
  121    ),
  122    unqualify(Head0, Module, Head),
  123    (   Body == true
  124    ->  DecompiledClause = Head
  125    ;   DecompiledClause = (Head :- Body)
  126    ),
  127    clause_property(ClauseRef, line_count(LineNo)),
  128    debug(clause_info, 'from ~w:~d ... ', [File, LineNo]),
  129    read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames),
  130    option(variable_names(VarNames), Options, _),
  131    debug(clause_info, 'read ...', []),
  132    unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos),
  133    debug(clause_info, 'unified ...', []),
  134    make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset),
  135    debug(clause_info, 'got names~n', []),
  136    !.
  137
  138unqualify(Module:Head, Module, Head) :-
  139    !.
  140unqualify(Head, _, Head).
  141
  142
  143%!  unify_term(+T1, +T2)
  144%
  145%   Unify the two terms, where T2 is created by writing the term and
  146%   reading it back in, but  be   aware  that  rounding problems may
  147%   cause floating point numbers not to  unify. Also, if the initial
  148%   term has a string object, it is written   as "..." and read as a
  149%   code-list. We compensate for that.
  150%
  151%   NOTE: Called directly from  library(trace/clause)   for  the GUI
  152%   tracer.
  153
  154unify_term(X, X) :- !.
  155unify_term(X1, X2) :-
  156    compound(X1),
  157    compound(X2),
  158    functor(X1, F, Arity),
  159    functor(X2, F, Arity),
  160    !,
  161    unify_args(0, Arity, X1, X2).
  162unify_term(X, Y) :-
  163    float(X), float(Y),
  164    !.
  165unify_term(X, '$BLOB'(_)) :-
  166    blob(X, _),
  167    \+ atom(X).
  168unify_term(X, Y) :-
  169    string(X),
  170    is_list(Y),
  171    string_codes(X, Y),
  172    !.
  173unify_term(_, Y) :-
  174    Y == '...',
  175    !.                          % elipses left by max_depth
  176unify_term(_:X, Y) :-
  177    unify_term(X, Y),
  178    !.
  179unify_term(X, _:Y) :-
  180    unify_term(X, Y),
  181    !.
  182unify_term(X, Y) :-
  183    format('[INTERNAL ERROR: Diff:~n'),
  184    portray_clause(X),
  185    format('~N*** <->~n'),
  186    portray_clause(Y),
  187    break.
  188
  189unify_args(N, N, _, _) :- !.
  190unify_args(I, Arity, T1, T2) :-
  191    A is I + 1,
  192    arg(A, T1, A1),
  193    arg(A, T2, A2),
  194    unify_term(A1, A2),
  195    unify_args(A, Arity, T1, T2).
  196
  197
  198%!  read_term_at_line(+File, +Line, +Module,
  199%!                    -Clause, -TermPos, -VarNames) is semidet.
  200%
  201%   Read a term from File at Line.
  202
  203read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :-
  204    setup_call_cleanup(
  205        '$push_input_context'(clause_info),
  206        read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames),
  207        '$pop_input_context').
  208
  209read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :-
  210    catch(try_open_source(File, In), error(_,_), fail),
  211    set_stream(In, newline(detect)),
  212    call_cleanup(
  213        read_source_term_at_location(
  214            In, Clause,
  215            [ line(Line),
  216              module(Module),
  217              subterm_positions(TermPos),
  218              variable_names(VarNames)
  219            ]),
  220        close(In)).
  221
  222%!  open_source(+File, -Stream) is semidet.
  223%
  224%   Hook into clause_info/5 that opens the stream holding the source
  225%   for a specific clause. Thus, the query must succeed. The default
  226%   implementation calls open/3 on the `File` property.
  227%
  228%     ==
  229%     clause_property(ClauseRef, file(File)),
  230%     prolog_clause:open_source(File, Stream)
  231%     ==
  232
  233:- public try_open_source/2.            % used by library(prolog_breakpoints).
  234
  235try_open_source(File, In) :-
  236    open_source(File, In),
  237    !.
  238try_open_source(File, In) :-
  239    open(File, read, In).
  240
  241
  242%!  make_varnames(+ReadClause, +DecompiledClause,
  243%!                +Offsets, +Names, -Term) is det.
  244%
  245%   Create a Term varnames(...) where each argument contains the name
  246%   of the variable at that offset.  If the read Clause is a DCG rule,
  247%   name the two last arguments <DCG_list> and <DCG_tail>
  248%
  249%   This    predicate    calles     the      multifile     predicate
  250%   make_varnames_hook/5 with the same arguments   to allow for user
  251%   extensions. Extending this predicate  is   needed  if a compiler
  252%   adds additional arguments to the clause   head that must be made
  253%   visible in the GUI tracer.
  254%
  255%   @param Offsets  List of Offset=Var
  256%   @param Names    List of Name=Var
  257
  258make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :-
  259    make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term),
  260    !.
  261make_varnames((Head --> _Body), _, Offsets, Names, Bindings) :-
  262    !,
  263    functor(Head, _, Arity),
  264    In is Arity,
  265    memberchk(In=IVar, Offsets),
  266    Names1 = ['<DCG_list>'=IVar|Names],
  267    Out is Arity + 1,
  268    memberchk(Out=OVar, Offsets),
  269    Names2 = ['<DCG_tail>'=OVar|Names1],
  270    make_varnames(xx, xx, Offsets, Names2, Bindings).
  271make_varnames(_, _, Offsets, Names, Bindings) :-
  272    length(Offsets, L),
  273    functor(Bindings, varnames, L),
  274    do_make_varnames(Offsets, Names, Bindings).
  275
  276do_make_varnames([], _, _).
  277do_make_varnames([N=Var|TO], Names, Bindings) :-
  278    (   find_varname(Var, Names, Name)
  279    ->  true
  280    ;   Name = '_'
  281    ),
  282    AN is N + 1,
  283    arg(AN, Bindings, Name),
  284    do_make_varnames(TO, Names, Bindings).
  285
  286find_varname(Var, [Name = TheVar|_], Name) :-
  287    Var == TheVar,
  288    !.
  289find_varname(Var, [_|T], Name) :-
  290    find_varname(Var, T, Name).
  291
  292%!  unify_clause(+Read, +Decompiled, +Module, +ReadTermPos,
  293%!               -RecompiledTermPos).
  294%
  295%   What you read isn't always what goes into the database. The task
  296%   of this predicate is to establish  the relation between the term
  297%   read from the file and the result from decompiling the clause.
  298%
  299%   This predicate calls the multifile predicate unify_clause_hook/5
  300%   with the same arguments to support user extensions.
  301%
  302%   @tbd    This really must be  more   flexible,  dealing with much
  303%           more complex source-translations,  falling   back  to  a
  304%           heuristic method locating as much as possible.
  305
  306unify_clause(Read, Decompiled, _, TermPos, TermPos) :-
  307    Read =@= Decompiled,
  308    !,
  309    Read = Decompiled.
  310                                        % XPCE send-methods
  311unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  312    unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos),
  313    !.
  314unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  315    !,
  316    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  317                                        % XPCE get-methods
  318unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  319    !,
  320    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  321                                        % Unit test clauses
  322unify_clause((TH :- Body),
  323             (_:'unit body'(_, _) :- !, Body), _,
  324             TP0, TP) :-
  325    (   TH = test(_,_)
  326    ;   TH = test(_)
  327    ),
  328    !,
  329    TP0 = term_position(F,T,FF,FT,[HP,BP]),
  330    TP  = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
  331                                        % module:head :- body
  332unify_clause((Head :- Read),
  333             (Head :- _M:Compiled), Module, TermPos0, TermPos) :-
  334    unify_clause((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
  335    TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
  336    TermPos  = term_position(TA,TZ,FA,FZ,
  337                             [ PH,
  338                               term_position(0,0,0,0,[0-0,PB])
  339                             ]).
  340                                        % DCG rules
  341unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  342    Read = (_ --> Terminal, _),
  343    is_list(Terminal),
  344    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  345    Compiled2 = (DH :- _),
  346    functor(DH, _, Arity),
  347    DArg is Arity - 1,
  348    append(Terminal, _Tail, List),
  349    arg(DArg, DH, List),
  350    TermPos1 = term_position(F,T,FF,FT,[ HP,
  351                                         term_position(_,_,_,_,[_,BP])
  352                                       ]),
  353    !,
  354    TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]),
  355    match_module(Compiled2, Compiled1, Module, TermPos2, TermPos).
  356                                        % general term-expansion
  357unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  358    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  359    match_module(Compiled2, Compiled1, Module, TermPos1, TermPos).
  360                                        % I don't know ...
  361unify_clause(_, _, _, _, _) :-
  362    debug(clause_info, 'Could not unify clause', []),
  363    fail.
  364
  365unify_clause_head(H1, H2) :-
  366    strip_module(H1, _, H),
  367    strip_module(H2, _, H).
  368
  369ci_expand(Read, Compiled, Module, TermPos0, TermPos) :-
  370    catch(setup_call_cleanup(
  371              ( set_xref_flag(OldXRef),
  372                '$set_source_module'(Old, Module)
  373              ),
  374              expand_term(Read, TermPos0, Compiled, TermPos),
  375              ( '$set_source_module'(Old),
  376                set_prolog_flag(xref, OldXRef)
  377              )),
  378          E,
  379          expand_failed(E, Read)).
  380
  381set_xref_flag(Value) :-
  382    current_prolog_flag(xref, Value),
  383    !,
  384    set_prolog_flag(xref, true).
  385set_xref_flag(false) :-
  386    create_prolog_flag(xref, true, [type(boolean)]).
  387
  388match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :-
  389    !,
  390    unify_clause_head(H1, H2),
  391    unify_body(B1, B2, Module, Pos0, Pos).
  392match_module((H1 :- B1), H2, _Module, Pos0, Pos) :-
  393    B1 == true,
  394    unify_clause_head(H1, H2),
  395    Pos = Pos0,
  396    !.
  397match_module(H1, H2, _, Pos, Pos) :-    % deal with facts
  398    unify_clause_head(H1, H2).
  399
  400%!  expand_failed(+Exception, +Term)
  401%
  402%   When debugging, indicate that expansion of the term failed.
  403
  404expand_failed(E, Read) :-
  405    debugging(clause_info),
  406    message_to_string(E, Msg),
  407    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  408    fail.
  409
  410%!  unify_body(+Read, +Decompiled, +Module, +Pos0, -Pos)
  411%
  412%   Deal with translations implied by the compiler.  For example,
  413%   compiling (a,b),c yields the same code as compiling a,b,c.
  414%
  415%   Pos0 and Pos still include the term-position of the head.
  416
  417unify_body(B, C, _, Pos, Pos) :-
  418    B =@= C, B = C,
  419    does_not_dcg_after_binding(B, Pos),
  420    !.
  421unify_body(R, D, Module,
  422           term_position(F,T,FF,FT,[HP,BP0]),
  423           term_position(F,T,FF,FT,[HP,BP])) :-
  424    ubody(R, D, Module, BP0, BP).
  425
  426%!  does_not_dcg_after_binding(+ReadBody, +ReadPos) is semidet.
  427%
  428%   True  if  ReadPos/ReadPos  does   not    contain   DCG   delayed
  429%   unifications.
  430%
  431%   @tbd    We should pass that we are in a DCG; if we are not there
  432%           is no reason for this test.
  433
  434does_not_dcg_after_binding(B, Pos) :-
  435    \+ sub_term(brace_term_position(_,_,_), Pos),
  436    \+ (sub_term((Cut,_=_), B), Cut == !),
  437    !.
  438
  439
  440/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  441Some remarks.
  442
  443a --> { x, y, z }.
  444    This is translated into "(x,y),z), X=Y" by the DCG translator, after
  445    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
  446- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  447
  448%!  unify_goal(+Read, +Decompiled, +Module,
  449%!             +TermPosRead, -TermPosDecompiled) is semidet.
  450%
  451%   This hook is called to  fix   up  source code manipulations that
  452%   result from goal expansions.
  453
  454%!  ubody(+Read, +Decompiled, +Module, +TermPosRead, -TermPosForDecompiled)
  455%
  456%   @param Read             Clause read _after_ expand_term/2
  457%   @param Decompiled       Decompiled clause
  458%   @param Module           Load module
  459%   @param TermPosRead      Sub-term positions of source
  460
  461ubody(B, DB, _, P, P) :-
  462    var(P),                        % TBD: Create compatible pos term?
  463    !,
  464    B = DB.
  465ubody(B, C, _, P, P) :-
  466    B =@= C, B = C,
  467    does_not_dcg_after_binding(B, P),
  468    !.
  469ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :-
  470    !,
  471    ubody(X0, X, M, P0, P).
  472ubody(X, call(X), _,                    % X = call(X)
  473      Pos,
  474      term_position(From, To, From, To, [Pos])) :-
  475    !,
  476    arg(1, Pos, From),
  477    arg(2, Pos, To).
  478ubody(A, B, _, P1, P2) :-
  479    nonvar(A), A = (_=_),
  480    nonvar(B), B = (LB=RB),
  481    A =@= (RB=LB),
  482    !,
  483    P1 = term_position(F,T, FF,FT, [PL,PR]),
  484    P2 = term_position(F,T, FF,FT, [PR,PL]).
  485ubody(A, B, _, P1, P2) :-
  486    nonvar(A), A = (_==_),
  487    nonvar(B), B = (LB==RB),
  488    A =@= (RB==LB),
  489    !,
  490    P1 = term_position(F,T, FF,FT, [PL,PR]),
  491    P2 = term_position(F,T, FF,FT, [PR,PL]).
  492ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :-
  493    nonvar(B), B = M:R,
  494    ubody(R, D, M, RP, TPOut).
  495ubody(B0, B, M,
  496      brace_term_position(F,T,A0),
  497      Pos) :-
  498    B0 = (_,_=_),
  499    !,
  500    T1 is T - 1,
  501    ubody(B0, B, M,
  502          term_position(F,T,
  503                        F,T,
  504                        [A0,T1-T]),
  505          Pos).
  506ubody(B0, B, M,
  507      brace_term_position(F,T,A0),
  508      term_position(F,T,F,T,[A])) :-
  509    !,
  510    ubody(B0, B, M, A0, A).
  511ubody(C0, C, M, P0, P) :-
  512    nonvar(C0), nonvar(C),
  513    C0 = (_,_), C = (_,_),
  514    !,
  515    conj(C0, P0, GL, PL),
  516    mkconj(C, M, P, GL, PL).
  517ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :-
  518    unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled),
  519    !.
  520ubody(X0, X, M,
  521      term_position(F,T,FF,TT,PA0),
  522      term_position(F,T,FF,TT,PA)) :-
  523    meta(M, X0, S),
  524    !,
  525    X0 =.. [_|A0],
  526    X  =.. [_|A],
  527    S =.. [_|AS],
  528    ubody_list(A0, A, AS, M, PA0, PA).
  529ubody(X0, X, M,
  530      term_position(F,T,FF,TT,PA0),
  531      term_position(F,T,FF,TT,PA)) :-
  532    expand_goal(X0, X1, M, PA0, PA),
  533    X1 =@= X,
  534    X1 = X.
  535
  536                                        % 5.7.X optimizations
  537ubody(_=_, true, _,                     % singleton = Any
  538      term_position(F,T,_FF,_TT,_PA),
  539      F-T) :- !.
  540ubody(_==_, fail, _,                    % singleton/firstvar == Any
  541      term_position(F,T,_FF,_TT,_PA),
  542      F-T) :- !.
  543ubody(A1=B1, B2=A2, _,                  % Term = Var --> Var = Term
  544      term_position(F,T,FF,TT,[PA1,PA2]),
  545      term_position(F,T,FF,TT,[PA2,PA1])) :-
  546    var(B1), var(B2),
  547    (A1==B1) =@= (B2==A2),
  548    !,
  549    A1 = A2, B1=B2.
  550ubody(A1==B1, B2==A2, _,                % const == Var --> Var == const
  551      term_position(F,T,FF,TT,[PA1,PA2]),
  552      term_position(F,T,FF,TT,[PA2,PA1])) :-
  553    var(B1), var(B2),
  554    (A1==B1) =@= (B2==A2),
  555    !,
  556    A1 = A2, B1=B2.
  557ubody(A is B - C, A is B + C2, _, Pos, Pos) :-
  558    integer(C),
  559    C2 =:= -C,
  560    !.
  561
  562ubody_list([], [], [], _, [], []).
  563ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
  564    ubody_elem(AS, G0, G, M, PA0, PA),
  565    ubody_list(T0, T, ASL, M, PAT0, PAT).
  566
  567ubody_elem(0, G0, G, M, PA0, PA) :-
  568    !,
  569    ubody(G0, G, M, PA0, PA).
  570ubody_elem(_, G, G, _, PA, PA).
  571
  572conj(Goal, Pos, GoalList, PosList) :-
  573    conj(Goal, Pos, GoalList, [], PosList, []).
  574
  575conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
  576    !,
  577    conj(A, PA, GL, TGA, PL, TPA),
  578    conj(B, PB, TGA, TG, TPA, TP).
  579conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
  580    B = (_=_),
  581    !,
  582    conj(A, PA, GL, TGA, PL, TPA),
  583    T1 is T - 1,
  584    conj(B, T1-T, TGA, TG, TPA, TP).
  585conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :-
  586    nonvar(Pos),
  587    !,
  588    conj(A, Pos, GL, TG, PL, TP).
  589conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
  590    F1 is F+1,
  591    T1 is T+1.
  592conj(A, P, [A|TG], TG, [P|TP], TP).
  593
  594
  595mkconj(Goal, M, Pos, GoalList, PosList) :-
  596    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
  597
  598mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
  599    nonvar(Conj),
  600    Conj = (A,B),
  601    !,
  602    mkconj(A, M, PA, GL, TGA, PL, TPA),
  603    mkconj(B, M, PB, TGA, TG, TPA, TP).
  604mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
  605    ubody(A, A0, M, P, P0).
  606
  607
  608                 /*******************************
  609                 *    PCE STUFF (SHOULD MOVE)   *
  610                 *******************************/
  611
  612/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  613        <method>(Receiver, ... Arg ...) :->
  614                Body
  615
  616mapped to:
  617
  618        send_implementation(Id, <method>(...Arg...), Receiver)
  619
  620- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  621
  622pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
  623    !,
  624    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
  625pce_method_clause(Head, Body,
  626                  send_implementation(_Id, Msg, Receiver), PlBody,
  627                  M, TermPos0, TermPos) :-
  628    !,
  629    debug(clause_info, 'send method ...', []),
  630    arg(1, Head, Receiver),
  631    functor(Head, _, Arity),
  632    pce_method_head_arguments(2, Arity, Head, Msg),
  633    debug(clause_info, 'head ...', []),
  634    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  635pce_method_clause(Head, Body,
  636                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
  637                  M, TermPos0, TermPos) :-
  638    !,
  639    debug(clause_info, 'get method ...', []),
  640    arg(1, Head, Receiver),
  641    debug(clause_info, 'receiver ...', []),
  642    functor(Head, _, Arity),
  643    arg(Arity, Head, PceResult),
  644    debug(clause_info, '~w?~n', [PceResult = Result]),
  645    pce_unify_head_arg(PceResult, Result),
  646    Ar is Arity - 1,
  647    pce_method_head_arguments(2, Ar, Head, Msg),
  648    debug(clause_info, 'head ...', []),
  649    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  650
  651pce_method_head_arguments(N, Arity, Head, Msg) :-
  652    N =< Arity,
  653    !,
  654    arg(N, Head, PceArg),
  655    PLN is N - 1,
  656    arg(PLN, Msg, PlArg),
  657    pce_unify_head_arg(PceArg, PlArg),
  658    debug(clause_info, '~w~n', [PceArg = PlArg]),
  659    NextArg is N+1,
  660    pce_method_head_arguments(NextArg, Arity, Head, Msg).
  661pce_method_head_arguments(_, _, _, _).
  662
  663pce_unify_head_arg(V, A) :-
  664    var(V),
  665    !,
  666    V = A.
  667pce_unify_head_arg(A:_=_, A) :- !.
  668pce_unify_head_arg(A:_, A).
  669
  670%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
  671%
  672%       Unify the body of an XPCE method.  Goal-expansion makes this
  673%       rather tricky, especially as we cannot call XPCE's expansion
  674%       on an isolated method.
  675%
  676%       TermPos0 is the term-position term of the whole clause!
  677%
  678%       Further, please note that the body of the method-clauses reside
  679%       in another module than pce_principal, and therefore the body
  680%       starts with an I_CONTEXT call. This implies we need a
  681%       hypothetical term-position for the module-qualifier.
  682
  683pce_method_body(A0, A, M, TermPos0, TermPos) :-
  684    TermPos0 = term_position(F, T, FF, FT,
  685                             [ HeadPos,
  686                               BodyPos0
  687                             ]),
  688    TermPos  = term_position(F, T, FF, FT,
  689                             [ HeadPos,
  690                               term_position(0,0,0,0, [0-0,BodyPos])
  691                             ]),
  692    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
  693
  694
  695pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
  696    !,
  697    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
  698    TermPos  = BodyPos,
  699    expand_goal(A0, A, M, BodyPos0, BodyPos).
  700pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  701    A0 =.. [Func,B0,C0],
  702    control_op(Func),
  703    !,
  704    A =.. [Func,B,C],
  705    TermPos0 = term_position(F, T, FF, FT,
  706                             [ BP0,
  707                               CP0
  708                             ]),
  709    TermPos  = term_position(F, T, FF, FT,
  710                             [ BP,
  711                               CP
  712                             ]),
  713    pce_method_body2(B0, B, M, BP0, BP),
  714    expand_goal(C0, C, M, CP0, CP).
  715pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  716    expand_goal(A0, A, M, TermPos0, TermPos).
  717
  718control_op(',').
  719control_op((;)).
  720control_op((->)).
  721control_op((*->)).
  722
  723                 /*******************************
  724                 *     EXPAND_GOAL SUPPORT      *
  725                 *******************************/
  726
  727/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  728With the introduction of expand_goal, it  is increasingly hard to relate
  729the clause from the database to the actual  source. For one thing, we do
  730not know the compilation  module  of  the   clause  (unless  we  want to
  731decompile it).
  732
  733Goal expansion can translate  goals   into  control-constructs, multiple
  734clauses, or delete a subgoal.
  735
  736To keep track of the source-locations, we   have to redo the analysis of
  737the clause as defined in init.pl
  738- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  739
  740expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
  741    var(G),
  742    !.
  743expand_goal(G, G1, _, P, P) :-
  744    var(G),
  745    !,
  746    G1 = G.
  747expand_goal(M0, M, Module, P0, P) :-
  748    meta(Module, M0, S),
  749    !,
  750    P0 = term_position(F,T,FF,FT,PL0),
  751    P  = term_position(F,T,FF,FT,PL),
  752    functor(M0, Functor, Arity),
  753    functor(M,  Functor, Arity),
  754    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
  755expand_goal(A, B, Module, P0, P) :-
  756    goal_expansion(A, B0, P0, P1),
  757    !,
  758    expand_goal(B0, B, Module, P1, P).
  759expand_goal(A, A, _, P, P).
  760
  761expand_meta_args([],      [],   _,  _, _,      _,  _).
  762expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
  763    arg(I, M0, A0),
  764    arg(I, M,  A),
  765    arg(I, S,  AS),
  766    expand_arg(AS, A0, A, Module, P0, P),
  767    NI is I + 1,
  768    expand_meta_args(T0, T, NI, S, Module, M0, M).
  769
  770expand_arg(0, A0, A, Module, P0, P) :-
  771    !,
  772    expand_goal(A0, A, Module, P0, P).
  773expand_arg(_, A, A, _, P, P).
  774
  775meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
  776
  777goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
  778    compound(Msg),
  779    Msg =.. [send_super, Selector | Args],
  780    !,
  781    SuperMsg =.. [Selector|Args].
  782goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
  783    compound(Msg),
  784    Msg =.. [get_super, Selector | Args],
  785    !,
  786    SuperMsg =.. [Selector|Args].
  787goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
  788goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
  789goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
  790    compound(SendSuperN),
  791    compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]),
  792    Msg =.. [Sel|Args].
  793goal_expansion(SendN, send(R, Msg), P, P) :-
  794    compound(SendN),
  795    compound_name_arguments(SendN, send, [R,Sel|Args]),
  796    atom(Sel), Args \== [],
  797    Msg =.. [Sel|Args].
  798goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
  799    compound(GetSuperN),
  800    compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]),
  801    append(Args, [Answer], AllArgs),
  802    Msg =.. [Sel|Args].
  803goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
  804    compound(GetN),
  805    compound_name_arguments(GetN, get, [R,Sel|AllArgs]),
  806    append(Args, [Answer], AllArgs),
  807    atom(Sel), Args \== [],
  808    Msg =.. [Sel|Args].
  809goal_expansion(G0, G, P, P) :-
  810    user:goal_expansion(G0, G),     % TBD: we need the module!
  811    G0 \== G.                       % \=@=?
  812
  813
  814                 /*******************************
  815                 *        INITIALIZATION        *
  816                 *******************************/
  817
  818%!  initialization_layout(+SourceLocation, ?InitGoal,
  819%!                        -ReadGoal, -TermPos) is semidet.
  820%
  821%   Find term-layout of :- initialization directives.
  822
  823initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
  824    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
  825    Directive    = (:- initialization(ReadGoal)),
  826    DirectivePos = term_position(_, _, _, _, [InitPos]),
  827    InitPos      = term_position(_, _, _, _, [GoalPos]),
  828    (   ReadGoal = M:_
  829    ->  Goal = M:Goal0
  830    ;   Goal = Goal0
  831    ),
  832    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
  833    !.
  834
  835
  836                 /*******************************
  837                 *        PRINTABLE NAMES       *
  838                 *******************************/
  839
  840:- module_transparent
  841    predicate_name/2.  842:- multifile
  843    user:prolog_predicate_name/2,
  844    user:prolog_clause_name/2.  845
  846hidden_module(user).
  847hidden_module(system).
  848hidden_module(pce_principal).           % should be config
  849hidden_module(Module) :-                % SWI-Prolog specific
  850    import_module(Module, system).
  851
  852thaffix(1, st) :- !.
  853thaffix(2, nd) :- !.
  854thaffix(_, th).
  855
  856%!  predicate_name(:Head, -PredName:string) is det.
  857%
  858%   Describe a predicate as [Module:]Name/Arity.
  859
  860predicate_name(Predicate, PName) :-
  861    strip_module(Predicate, Module, Head),
  862    (   user:prolog_predicate_name(Module:Head, PName)
  863    ->  true
  864    ;   functor(Head, Name, Arity),
  865        (   hidden_module(Module)
  866        ->  format(string(PName), '~q/~d', [Name, Arity])
  867        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
  868        )
  869    ).
  870
  871%!  clause_name(+Ref, -Name)
  872%
  873%   Provide a suitable description of the indicated clause.
  874
  875clause_name(Ref, Name) :-
  876    user:prolog_clause_name(Ref, Name),
  877    !.
  878clause_name(Ref, Name) :-
  879    nth_clause(Head, N, Ref),
  880    !,
  881    predicate_name(Head, PredName),
  882    thaffix(N, Th),
  883    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
  884clause_name(Ref, Name) :-
  885    clause_property(Ref, erased),
  886    !,
  887    clause_property(Ref, predicate(M:PI)),
  888    format(string(Name), 'erased clause from ~q', [M:PI]).
  889clause_name(_, '<meta-call>')