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