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