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, [reposition(true)]).
  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%   @arg Module is the source module that   was active when loading this
  304%   clause,  which  is  the  same  as  prolog_load_context/2  using  the
  305%   `module` context. If this cannot be established  it is the module to
  306%   which the clause itself is associated.   The argument may be used to
  307%   determine whether or not a specific user transformation is in scope.
  308%   See also term_expansion/2,4 and goal_expansion/2,4.
  309%
  310%   @tbd    This really must be  more   flexible,  dealing with much
  311%           more complex source-translations,  falling   back  to  a
  312%           heuristic method locating as much as possible.
  313
  314unify_clause(Read, _, _, _, _) :-
  315    var(Read),
  316    !,
  317    fail.
  318unify_clause((RHead :- RBody), (CHead :- CBody), Module, TermPos1, TermPos) :-
  319    '$expand':f2_pos(TermPos1, HPos, BPos1,
  320                     TermPos2, HPos, BPos2),
  321    inlined_unification(RBody, CBody, RBody1, CBody1, RHead,
  322                        BPos1, BPos2),
  323    RBody1 \== RBody,
  324    !,
  325    unify_clause2((RHead :- RBody1), (CHead :- CBody1), Module,
  326                  TermPos2, TermPos).
  327unify_clause(Read, Decompiled, _, TermPos, TermPos) :-
  328    Read =@= Decompiled,
  329    !,
  330    Read = Decompiled.
  331unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  332    unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos),
  333    !.
  334                                        % XPCE send-methods
  335unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  336    !,
  337    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  338                                        % XPCE get-methods
  339unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  340    !,
  341    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  342                                        % Unit test clauses
  343unify_clause((TH :- Body),
  344             (_:'unit body'(_, _) :- !, Body), _,
  345             TP0, TP) :-
  346    (   TH = test(_,_)
  347    ;   TH = test(_)
  348    ),
  349    !,
  350    TP0 = term_position(F,T,FF,FT,[HP,BP]),
  351    TP  = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
  352                                        % module:head :- body
  353unify_clause((Head :- Read),
  354             (Head :- _M:Compiled), Module, TermPos0, TermPos) :-
  355    unify_clause2((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
  356    TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
  357    TermPos  = term_position(TA,TZ,FA,FZ,
  358                             [ PH,
  359                               term_position(0,0,0,0,[0-0,PB])
  360                             ]).
  361                                        % DCG rules
  362unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  363    Read = (_ --> Terminal, _),
  364    is_list(Terminal),
  365    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  366    Compiled2 = (DH :- _),
  367    functor(DH, _, Arity),
  368    DArg is Arity - 1,
  369    append(Terminal, _Tail, List),
  370    arg(DArg, DH, List),
  371    TermPos1 = term_position(F,T,FF,FT,[ HP,
  372                                         term_position(_,_,_,_,[_,BP])
  373                                       ]),
  374    !,
  375    TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]),
  376    match_module(Compiled2, Compiled1, Module, TermPos2, TermPos).
  377                                               % SSU rules
  378unify_clause((Head,RCond => Body), (CHead :- CCondAndBody), Module,
  379             term_position(F,T,FF,FT,
  380                           [ term_position(_,_,_,_,[HP,CP]),
  381                             BP
  382                           ]),
  383             TermPos) :-
  384    split_on_cut(CCondAndBody, CCond, CBody0),
  385    !,
  386    inlined_unification(RCond, CCond, RCond1, CCond1, Head, CP, CP1),
  387    TermPos1 = term_position(F,T,FF,FT, [HP, BP1]),
  388    BP2 = term_position(_,_,_,_, [FF-FT, BP]), % Represent (!, Body), placing
  389    (   CCond1 == true                         % ! at =>
  390    ->  BP1 = BP2,                             % Whole guard is inlined
  391        unify_clause2((Head :- !, Body), (CHead :- !, CBody0),
  392                      Module, TermPos1, TermPos)
  393    ;   mkconj_pos(RCond1, CP1, (!,Body), BP2, RBody, BP1),
  394        mkconj_npos(CCond1, (!,CBody0), CBody),
  395        unify_clause2((Head :- RBody), (CHead :- CBody),
  396                      Module, TermPos1, TermPos)
  397    ).
  398unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :-
  399    !,
  400    unify_clause2(Head :- Body, Compiled1, Module, TermPos0, TermPos).
  401unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  402    unify_clause2(Read, Decompiled, Module, TermPos0, TermPos).
  403
  404% mkconj, but also unify position info
  405mkconj_pos((A,B), term_position(F,T,FF,FT,[PA,PB]), Ex, ExPos, Code, Pos) =>
  406    Code = (A,B1),
  407    Pos = term_position(F,T,FF,FT,[PA,PB1]),
  408    mkconj_pos(B, PB, Ex, ExPos, B1, PB1).
  409mkconj_pos(Last, LastPos, Ex, ExPos, Code, Pos) =>
  410    Code = (Last,Ex),
  411    Pos = term_position(_,_,_,_,[LastPos,ExPos]).
  412
  413% similar to mkconj, but we should __not__ optimize `true` away.
  414mkconj_npos((A,B), Ex, Code) =>
  415    Code = (A,B1),
  416    mkconj_npos(B, Ex, B1).
  417mkconj_npos(A, Ex, Code) =>
  418    Code = (A,Ex).
  419
  420%!  unify_clause2(+Read, +Decompiled, +Module, +TermPosIn, -TermPosOut)
  421%
  422%   Stratified version to be used after the first match
  423
  424unify_clause2(Read, Decompiled, _, TermPos, TermPos) :-
  425    Read =@= Decompiled,
  426    !,
  427    Read = Decompiled.
  428unify_clause2(Read, Compiled1, Module, TermPos0, TermPos) :-
  429    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  430    match_module(Compiled2, Compiled1, Module, TermPos1, TermPos).
  431                                        % I don't know ...
  432unify_clause2(_, _, _, _, _) :-
  433    debug(clause_info, 'Could not unify clause', []),
  434    fail.
  435
  436unify_clause_head(H1, H2) :-
  437    strip_module(H1, _, H),
  438    strip_module(H2, _, H).
  439
  440%!  inlined_unification(+BodyRead, +BodyCompiled,
  441%!                      -BodyReadOut, -BodyCompiledOut,
  442%!                      +HeadRead,
  443%!                      +BodyPosIn, -BodyPosOut) is det.
  444
  445inlined_unification((V=T,RBody0), (CV=CT,CBody0),
  446                    RBody, CBody, RHead, BPos1, BPos),
  447    inlineable_head_var(RHead, V2),
  448    V == V2,
  449    (V=T) =@= (CV=CT) =>
  450    argpos(2, BPos1, BPos2),
  451    inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos).
  452inlined_unification((V=T), (CV=CT),
  453                    RBody, CBody, RHead, BPos1, BPos),
  454    inlineable_head_var(RHead, V2),
  455    V == V2,
  456    (V=T) =@= (CV=CT) =>
  457    RBody = true,
  458    CBody = true,
  459    argpos(2, BPos1, BPos).
  460inlined_unification((V=T,RBody0), CBody0,
  461                    RBody, CBody, RHead, BPos1, BPos),
  462    inlineable_head_var(RHead, V2),
  463    V == V2,
  464    \+ (CBody0 = (G1,_), G1 \=@= (V=T)) =>
  465    argpos(2, BPos1, BPos2),
  466    inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos).
  467inlined_unification((V=_), true,
  468                    RBody, CBody, RHead, BPos1, BPos),
  469    inlineable_head_var(RHead, V2),
  470    V == V2 =>
  471    RBody = true,
  472    CBody = true,
  473    argpos(2, BPos1, BPos).
  474inlined_unification(RBody0, CBody0, RBody, CBody, _RHead,
  475                    BPos0, BPos) =>
  476    RBody = RBody0,
  477    BPos  = BPos0,
  478    CBody = CBody0.
  479
  480%!  inlineable_head_var(+Head, -Var) is nondet
  481%
  482%   True when Var is a variable in  Head   that  may  be used for inline
  483%   unification. Currently we only inline direct arguments to the head.
  484
  485inlineable_head_var(Head, Var) :-
  486    compound(Head),
  487    arg(_, Head, Var).
  488
  489split_on_cut((Cond0,!,Body0), Cond, Body) =>
  490    Cond = Cond0,
  491    Body = Body0.
  492split_on_cut((!,Body0), Cond, Body) =>
  493    Cond = true,
  494    Body = Body0.
  495split_on_cut((A,B), Cond, Body) =>
  496    Cond = (A,Cond1),
  497    split_on_cut(B, Cond1, Body).
  498split_on_cut(_, _, _) =>
  499    fail.
  500
  501ci_expand(Read, Compiled, Module, TermPos0, TermPos) :-
  502    catch(setup_call_cleanup(
  503              ( set_xref_flag(OldXRef),
  504                '$set_source_module'(Old, Module)
  505              ),
  506              expand_term(Read, TermPos0, Compiled, TermPos),
  507              ( '$set_source_module'(Old),
  508                set_prolog_flag(xref, OldXRef)
  509              )),
  510          E,
  511          expand_failed(E, Read)),
  512    compound(TermPos),                  % make sure somthing is filled.
  513    arg(1, TermPos, A1), nonvar(A1),
  514    arg(2, TermPos, A2), nonvar(A2).
  515
  516set_xref_flag(Value) :-
  517    current_prolog_flag(xref, Value),
  518    !,
  519    set_prolog_flag(xref, true).
  520set_xref_flag(false) :-
  521    create_prolog_flag(xref, true, [type(boolean)]).
  522
  523match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :-
  524    !,
  525    unify_clause_head(H1, H2),
  526    unify_body(B1, B2, Module, Pos0, Pos).
  527match_module((H1 :- B1), H2, _Module, Pos0, Pos) :-
  528    B1 == true,
  529    unify_clause_head(H1, H2),
  530    Pos = Pos0,
  531    !.
  532match_module(H1, H2, _, Pos, Pos) :-    % deal with facts
  533    unify_clause_head(H1, H2).
  534
  535%!  expand_failed(+Exception, +Term)
  536%
  537%   When debugging, indicate that expansion of the term failed.
  538
  539expand_failed(E, Read) :-
  540    debugging(clause_info),
  541    message_to_string(E, Msg),
  542    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  543    fail.
  544
  545%!  unify_body(+Read, +Decompiled, +Module, +Pos0, -Pos)
  546%
  547%   Deal with translations implied by the compiler.  For example,
  548%   compiling (a,b),c yields the same code as compiling a,b,c.
  549%
  550%   Pos0 and Pos still include the term-position of the head.
  551
  552unify_body(B, C, _, Pos, Pos) :-
  553    B =@= C, B = C,
  554    does_not_dcg_after_binding(B, Pos),
  555    !.
  556unify_body(R, D, Module,
  557           term_position(F,T,FF,FT,[HP,BP0]),
  558           term_position(F,T,FF,FT,[HP,BP])) :-
  559    ubody(R, D, Module, BP0, BP).
  560
  561%!  does_not_dcg_after_binding(+ReadBody, +ReadPos) is semidet.
  562%
  563%   True  if  ReadPos/ReadPos  does   not    contain   DCG   delayed
  564%   unifications.
  565%
  566%   @tbd    We should pass that we are in a DCG; if we are not there
  567%           is no reason for this test.
  568
  569does_not_dcg_after_binding(B, Pos) :-
  570    \+ sub_term(brace_term_position(_,_,_), Pos),
  571    \+ (sub_term((Cut,_=_), B), Cut == !),
  572    !.
  573
  574
  575/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  576Some remarks.
  577
  578a --> { x, y, z }.
  579    This is translated into "(x,y),z), X=Y" by the DCG translator, after
  580    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
  581- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  582
  583%!  unify_goal(+Read, +Decompiled, +Module,
  584%!             +TermPosRead, -TermPosDecompiled) is semidet.
  585%
  586%   This hook is called to  fix   up  source code manipulations that
  587%   result from goal expansions.
  588
  589%!  ubody(+Read, +Decompiled, +Module, +TermPosRead, -TermPosForDecompiled)
  590%
  591%   @param Read             Clause read _after_ expand_term/2
  592%   @param Decompiled       Decompiled clause
  593%   @param Module           Load module
  594%   @param TermPosRead      Sub-term positions of source
  595
  596ubody(B, DB, _, P, P) :-
  597    var(P),                        % TBD: Create compatible pos term?
  598    !,
  599    B = DB.
  600ubody(B, C, _, P, P) :-
  601    B =@= C, B = C,
  602    does_not_dcg_after_binding(B, P),
  603    !.
  604ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :-
  605    !,
  606    ubody(X0, X, M, P0, P).
  607ubody(X, Y, _,                    % X = call(X)
  608      Pos,
  609      term_position(From, To, From, To, [Pos])) :-
  610    nonvar(Y),
  611    Y = call(X),
  612    !,
  613    arg(1, Pos, From),
  614    arg(2, Pos, To).
  615ubody(A, B, _, P1, P2) :-
  616    nonvar(A), A = (_=_),
  617    nonvar(B), B = (LB=RB),
  618    A =@= (RB=LB),
  619    !,
  620    P1 = term_position(F,T, FF,FT, [PL,PR]),
  621    P2 = term_position(F,T, FF,FT, [PR,PL]).
  622ubody(A, B, _, P1, P2) :-
  623    nonvar(A), A = (_==_),
  624    nonvar(B), B = (LB==RB),
  625    A =@= (RB==LB),
  626    !,
  627    P1 = term_position(F,T, FF,FT, [PL,PR]),
  628    P2 = term_position(F,T, FF,FT, [PR,PL]).
  629ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :-
  630    nonvar(B), B = M:R,
  631    ubody(R, D, M, RP, TPOut).
  632ubody(B, D, M, term_position(_,_,_,_,[RP0,RP1]), TPOut) :-
  633    nonvar(B), B = (B0,B1),
  634    (   maybe_optimized(B0),
  635        ubody(B1, D, M, RP1, TPOut)
  636    ->  true
  637    ;   maybe_optimized(B1),
  638        ubody(B0, D, M, RP0, TPOut)
  639    ),
  640    !.
  641ubody(B0, B, M,
  642      brace_term_position(F,T,A0),
  643      Pos) :-
  644    B0 = (_,_=_),
  645    !,
  646    T1 is T - 1,
  647    ubody(B0, B, M,
  648          term_position(F,T,
  649                        F,T,
  650                        [A0,T1-T]),
  651          Pos).
  652ubody(B0, B, M,
  653      brace_term_position(F,T,A0),
  654      term_position(F,T,F,T,[A])) :-
  655    !,
  656    ubody(B0, B, M, A0, A).
  657ubody(C0, C, M, P0, P) :-
  658    nonvar(C0), nonvar(C),
  659    C0 = (_,_), C = (_,_),
  660    !,
  661    conj(C0, P0, GL, PL),
  662    mkconj(C, M, P, GL, PL).
  663ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :-
  664    unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled),
  665    !.
  666ubody(X0, X, M,
  667      term_position(F,T,FF,TT,PA0),
  668      term_position(F,T,FF,TT,PA)) :-
  669    callable(X0),
  670    callable(X),
  671    meta(M, X0, S),
  672    !,
  673    X0 =.. [_|A0],
  674    X  =.. [_|A],
  675    S =.. [_|AS],
  676    ubody_list(A0, A, AS, M, PA0, PA).
  677ubody(X0, X, M,
  678      term_position(F,T,FF,TT,PA0),
  679      term_position(F,T,FF,TT,PA)) :-
  680    expand_goal(X0, X1, M, PA0, PA),
  681    X1 =@= X,
  682    X1 = X.
  683
  684                                        % 5.7.X optimizations
  685ubody(_=_, true, _,                     % singleton = Any
  686      term_position(F,T,_FF,_TT,_PA),
  687      F-T) :- !.
  688ubody(_==_, fail, _,                    % singleton/firstvar == Any
  689      term_position(F,T,_FF,_TT,_PA),
  690      F-T) :- !.
  691ubody(A1=B1, B2=A2, _,                  % Term = Var --> Var = Term
  692      term_position(F,T,FF,TT,[PA1,PA2]),
  693      term_position(F,T,FF,TT,[PA2,PA1])) :-
  694    var(B1), var(B2),
  695    (A1==B1) =@= (B2==A2),
  696    !,
  697    A1 = A2, B1=B2.
  698ubody(A1==B1, B2==A2, _,                % const == Var --> Var == const
  699      term_position(F,T,FF,TT,[PA1,PA2]),
  700      term_position(F,T,FF,TT,[PA2,PA1])) :-
  701    var(B1), var(B2),
  702    (A1==B1) =@= (B2==A2),
  703    !,
  704    A1 = A2, B1=B2.
  705ubody(A is B - C, A is B + C2, _, Pos, Pos) :-
  706    integer(C),
  707    C2 =:= -C,
  708    !.
  709
  710ubody_list([], [], [], _, [], []).
  711ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
  712    ubody_elem(AS, G0, G, M, PA0, PA),
  713    ubody_list(T0, T, ASL, M, PAT0, PAT).
  714
  715ubody_elem(0, G0, G, M, PA0, PA) :-
  716    !,
  717    ubody(G0, G, M, PA0, PA).
  718ubody_elem(_, G, G, _, PA, PA).
  719
  720%!  conj(+GoalTerm, +PositionTerm, -GoalList, -PositionList)
  721%
  722%   Turn a conjunctive body into a list   of  goals and their positions,
  723%   i.e., removing the positions of the (,)/2 terms.
  724
  725conj(Goal, Pos, GoalList, PosList) :-
  726    conj(Goal, Pos, GoalList, [], PosList, []).
  727
  728conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
  729    !,
  730    conj(A, PA, GL, TGA, PL, TPA),
  731    conj(B, PB, TGA, TG, TPA, TP).
  732conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
  733    B = (_=_),
  734    !,
  735    conj(A, PA, GL, TGA, PL, TPA),
  736    T1 is T - 1,
  737    conj(B, T1-T, TGA, TG, TPA, TP).
  738conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :-
  739    nonvar(Pos),
  740    !,
  741    conj(A, Pos, GL, TG, PL, TP).
  742conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
  743    F1 is F+1,
  744    T1 is T+1.
  745conj(A, P, [A|TG], TG, [P|TP], TP).
  746
  747
  748%!  mkconj(+Decompiled, +Module, -Position, +ReadGoals, +ReadPositions)
  749
  750mkconj(Goal, M, Pos, GoalList, PosList) :-
  751    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
  752
  753mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
  754    nonvar(Conj),
  755    Conj = (A,B),
  756    !,
  757    mkconj(A, M, PA, GL, TGA, PL, TPA),
  758    mkconj(B, M, PB, TGA, TG, TPA, TP).
  759mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
  760    ubody(A, A0, M, P, P0),
  761    !.
  762mkconj(A0, M, P0, [RG|TG0], TG, [_|TP0], TP) :-
  763    maybe_optimized(RG),
  764    mkconj(A0, M, P0, TG0, TG, TP0, TP).
  765
  766maybe_optimized(debug(_,_,_)).
  767maybe_optimized(assertion(_)).
  768maybe_optimized(true).
  769
  770%!  argpos(+N, +PositionTerm, -ArgPositionTerm) is det.
  771%
  772%   Get the position for the nth argument of PositionTerm.
  773
  774argpos(N, parentheses_term_position(_,_,PosIn), Pos) =>
  775    argpos(N, PosIn, Pos).
  776argpos(N, term_position(_,_,_,_,ArgPos), Pos) =>
  777    nth1(N, ArgPos, Pos).
  778argpos(_, _, _) => true.
  779
  780
  781                 /*******************************
  782                 *    PCE STUFF (SHOULD MOVE)   *
  783                 *******************************/
  784
  785/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  786        <method>(Receiver, ... Arg ...) :->
  787                Body
  788
  789mapped to:
  790
  791        send_implementation(Id, <method>(...Arg...), Receiver)
  792
  793- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  794
  795pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
  796    !,
  797    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
  798pce_method_clause(Head, Body,
  799                  send_implementation(_Id, Msg, Receiver), PlBody,
  800                  M, TermPos0, TermPos) :-
  801    !,
  802    debug(clause_info, 'send method ...', []),
  803    arg(1, Head, Receiver),
  804    functor(Head, _, Arity),
  805    pce_method_head_arguments(2, Arity, Head, Msg),
  806    debug(clause_info, 'head ...', []),
  807    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  808pce_method_clause(Head, Body,
  809                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
  810                  M, TermPos0, TermPos) :-
  811    !,
  812    debug(clause_info, 'get method ...', []),
  813    arg(1, Head, Receiver),
  814    debug(clause_info, 'receiver ...', []),
  815    functor(Head, _, Arity),
  816    arg(Arity, Head, PceResult),
  817    debug(clause_info, '~w?~n', [PceResult = Result]),
  818    pce_unify_head_arg(PceResult, Result),
  819    Ar is Arity - 1,
  820    pce_method_head_arguments(2, Ar, Head, Msg),
  821    debug(clause_info, 'head ...', []),
  822    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  823
  824pce_method_head_arguments(N, Arity, Head, Msg) :-
  825    N =< Arity,
  826    !,
  827    arg(N, Head, PceArg),
  828    PLN is N - 1,
  829    arg(PLN, Msg, PlArg),
  830    pce_unify_head_arg(PceArg, PlArg),
  831    debug(clause_info, '~w~n', [PceArg = PlArg]),
  832    NextArg is N+1,
  833    pce_method_head_arguments(NextArg, Arity, Head, Msg).
  834pce_method_head_arguments(_, _, _, _).
  835
  836pce_unify_head_arg(V, A) :-
  837    var(V),
  838    !,
  839    V = A.
  840pce_unify_head_arg(A:_=_, A) :- !.
  841pce_unify_head_arg(A:_, A).
  842
  843%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
  844%
  845%       Unify the body of an XPCE method.  Goal-expansion makes this
  846%       rather tricky, especially as we cannot call XPCE's expansion
  847%       on an isolated method.
  848%
  849%       TermPos0 is the term-position term of the whole clause!
  850%
  851%       Further, please note that the body of the method-clauses reside
  852%       in another module than pce_principal, and therefore the body
  853%       starts with an I_CONTEXT call. This implies we need a
  854%       hypothetical term-position for the module-qualifier.
  855
  856pce_method_body(A0, A, M, TermPos0, TermPos) :-
  857    TermPos0 = term_position(F, T, FF, FT,
  858                             [ HeadPos,
  859                               BodyPos0
  860                             ]),
  861    TermPos  = term_position(F, T, FF, FT,
  862                             [ HeadPos,
  863                               term_position(0,0,0,0, [0-0,BodyPos])
  864                             ]),
  865    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
  866
  867
  868pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
  869    !,
  870    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
  871    TermPos  = BodyPos,
  872    expand_goal(A0, A, M, BodyPos0, BodyPos).
  873pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  874    A0 =.. [Func,B0,C0],
  875    control_op(Func),
  876    !,
  877    A =.. [Func,B,C],
  878    TermPos0 = term_position(F, T, FF, FT,
  879                             [ BP0,
  880                               CP0
  881                             ]),
  882    TermPos  = term_position(F, T, FF, FT,
  883                             [ BP,
  884                               CP
  885                             ]),
  886    pce_method_body2(B0, B, M, BP0, BP),
  887    expand_goal(C0, C, M, CP0, CP).
  888pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  889    expand_goal(A0, A, M, TermPos0, TermPos).
  890
  891control_op(',').
  892control_op((;)).
  893control_op((->)).
  894control_op((*->)).
  895
  896                 /*******************************
  897                 *     EXPAND_GOAL SUPPORT      *
  898                 *******************************/
  899
  900/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  901With the introduction of expand_goal, it  is increasingly hard to relate
  902the clause from the database to the actual  source. For one thing, we do
  903not know the compilation  module  of  the   clause  (unless  we  want to
  904decompile it).
  905
  906Goal expansion can translate  goals   into  control-constructs, multiple
  907clauses, or delete a subgoal.
  908
  909To keep track of the source-locations, we   have to redo the analysis of
  910the clause as defined in init.pl
  911- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  912
  913expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
  914    var(G),
  915    !.
  916expand_goal(G, G1, _, P, P) :-
  917    var(G),
  918    !,
  919    G1 = G.
  920expand_goal(M0, M, Module, P0, P) :-
  921    meta(Module, M0, S),
  922    !,
  923    P0 = term_position(F,T,FF,FT,PL0),
  924    P  = term_position(F,T,FF,FT,PL),
  925    functor(M0, Functor, Arity),
  926    functor(M,  Functor, Arity),
  927    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
  928expand_goal(A, B, Module, P0, P) :-
  929    goal_expansion(A, B0, P0, P1),
  930    !,
  931    expand_goal(B0, B, Module, P1, P).
  932expand_goal(A, A, _, P, P).
  933
  934expand_meta_args([],      [],   _,  _, _,      _,  _).
  935expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
  936    arg(I, M0, A0),
  937    arg(I, M,  A),
  938    arg(I, S,  AS),
  939    expand_arg(AS, A0, A, Module, P0, P),
  940    NI is I + 1,
  941    expand_meta_args(T0, T, NI, S, Module, M0, M).
  942
  943expand_arg(0, A0, A, Module, P0, P) :-
  944    !,
  945    expand_goal(A0, A, Module, P0, P).
  946expand_arg(_, A, A, _, P, P).
  947
  948meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
  949
  950goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
  951    compound(Msg),
  952    Msg =.. [send_super, Selector | Args],
  953    !,
  954    SuperMsg =.. [Selector|Args].
  955goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
  956    compound(Msg),
  957    Msg =.. [get_super, Selector | Args],
  958    !,
  959    SuperMsg =.. [Selector|Args].
  960goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
  961goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
  962goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
  963    compound(SendSuperN),
  964    compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]),
  965    Msg =.. [Sel|Args].
  966goal_expansion(SendN, send(R, Msg), P, P) :-
  967    compound(SendN),
  968    compound_name_arguments(SendN, send, [R,Sel|Args]),
  969    atom(Sel), Args \== [],
  970    Msg =.. [Sel|Args].
  971goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
  972    compound(GetSuperN),
  973    compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]),
  974    append(Args, [Answer], AllArgs),
  975    Msg =.. [Sel|Args].
  976goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
  977    compound(GetN),
  978    compound_name_arguments(GetN, get, [R,Sel|AllArgs]),
  979    append(Args, [Answer], AllArgs),
  980    atom(Sel), Args \== [],
  981    Msg =.. [Sel|Args].
  982goal_expansion(G0, G, P, P) :-
  983    user:goal_expansion(G0, G),     % TBD: we need the module!
  984    G0 \== G.                       % \=@=?
  985
  986
  987                 /*******************************
  988                 *        INITIALIZATION        *
  989                 *******************************/
  990
  991%!  initialization_layout(+SourceLocation, ?InitGoal,
  992%!                        -ReadGoal, -TermPos) is semidet.
  993%
  994%   Find term-layout of :- initialization directives.
  995
  996initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
  997    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
  998    Directive    = (:- initialization(ReadGoal)),
  999    DirectivePos = term_position(_, _, _, _, [InitPos]),
 1000    InitPos      = term_position(_, _, _, _, [GoalPos]),
 1001    (   ReadGoal = M:_
 1002    ->  Goal = M:Goal0
 1003    ;   Goal = Goal0
 1004    ),
 1005    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
 1006    !.
 1007
 1008
 1009                 /*******************************
 1010                 *        PRINTABLE NAMES       *
 1011                 *******************************/
 1012
 1013:- module_transparent
 1014    predicate_name/2. 1015:- multifile
 1016    user:prolog_predicate_name/2,
 1017    user:prolog_clause_name/2. 1018
 1019hidden_module(user).
 1020hidden_module(system).
 1021hidden_module(pce_principal).           % should be config
 1022hidden_module(Module) :-                % SWI-Prolog specific
 1023    import_module(Module, system).
 1024
 1025thaffix(1, st) :- !.
 1026thaffix(2, nd) :- !.
 1027thaffix(_, th).
 1028
 1029%!  predicate_name(:Head, -PredName:string) is det.
 1030%
 1031%   Describe a predicate as [Module:]Name/Arity.
 1032
 1033predicate_name(Predicate, PName) :-
 1034    strip_module(Predicate, Module, Head),
 1035    (   user:prolog_predicate_name(Module:Head, PName)
 1036    ->  true
 1037    ;   functor(Head, Name, Arity),
 1038        (   hidden_module(Module)
 1039        ->  format(string(PName), '~q/~d', [Name, Arity])
 1040        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
 1041        )
 1042    ).
 1043
 1044%!  clause_name(+Ref, -Name)
 1045%
 1046%   Provide a suitable description of the indicated clause.
 1047
 1048clause_name(Ref, Name) :-
 1049    user:prolog_clause_name(Ref, Name),
 1050    !.
 1051clause_name(Ref, Name) :-
 1052    nth_clause(Head, N, Ref),
 1053    !,
 1054    predicate_name(Head, PredName),
 1055    thaffix(N, Th),
 1056    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
 1057clause_name(Ref, Name) :-
 1058    clause_property(Ref, erased),
 1059    !,
 1060    clause_property(Ref, predicate(M:PI)),
 1061    format(string(Name), 'erased clause from ~q', [M:PI]).
 1062clause_name(_, '<meta-call>')