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