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