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-2024, 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:- use_module(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%     - head(-Head)
  104%     - body(-Body)
  105%       Get the head and body as terms.   This is similar to
  106%       clause/3, but a seperate call would break the variable
  107%       identity.
  108
  109clause_info(ClauseRef, File, TermPos, NameOffset) :-
  110    clause_info(ClauseRef, File, TermPos, NameOffset, []).
  111
  112clause_info(ClauseRef, File, TermPos, NameOffset, Options) :-
  113    (   debugging(clause_info)
  114    ->  clause_name(ClauseRef, Name),
  115        debug(clause_info, 'clause_info(~w) (~w)... ',
  116              [ClauseRef, Name])
  117    ;   true
  118    ),
  119    clause_property(ClauseRef, file(File)),
  120    File \== user,                  % loaded using ?- [user].
  121    '$clause'(Head0, Body, ClauseRef, VarOffset),
  122    option(head(Head0), Options, _),
  123    option(body(Body), Options, _),
  124    (   module_property(Module, file(File))
  125    ->  true
  126    ;   strip_module(user:Head0, Module, _)
  127    ),
  128    unqualify(Head0, Module, Head),
  129    (   Body == true
  130    ->  DecompiledClause = Head
  131    ;   DecompiledClause = (Head :- Body)
  132    ),
  133    clause_property(ClauseRef, line_count(LineNo)),
  134    debug(clause_info, 'from ~w:~d ... ', [File, LineNo]),
  135    read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames),
  136    option(variable_names(VarNames), Options, _),
  137    debug(clause_info, 'read ...', []),
  138    unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos),
  139    debug(clause_info, 'unified ...', []),
  140    make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset),
  141    debug(clause_info, 'got names~n', []),
  142    !.
  143
  144unqualify(Module:Head, Module, Head) :-
  145    !.
  146unqualify(Head, _, Head).
  147
  148
  149%!  unify_term(+T1, +T2)
  150%
  151%   Unify the two terms, where T2 is created by writing the term and
  152%   reading it back in, but  be   aware  that  rounding problems may
  153%   cause floating point numbers not to  unify. Also, if the initial
  154%   term has a string object, it is written   as "..." and read as a
  155%   code-list. We compensate for that.
  156%
  157%   NOTE: Called directly from  library(trace/clause)   for  the GUI
  158%   tracer.
  159
  160unify_term(X, X) :- !.
  161unify_term(X1, X2) :-
  162    compound(X1),
  163    compound(X2),
  164    functor(X1, F, Arity),
  165    functor(X2, F, Arity),
  166    !,
  167    unify_args(0, Arity, X1, X2).
  168unify_term(X, Y) :-
  169    float(X), float(Y),
  170    !.
  171unify_term(X, '$BLOB'(_)) :-
  172    blob(X, _),
  173    \+ atom(X).
  174unify_term(X, Y) :-
  175    string(X),
  176    is_list(Y),
  177    string_codes(X, Y),
  178    !.
  179unify_term(_, Y) :-
  180    Y == '...',
  181    !.                          % elipses left by max_depth
  182unify_term(_:X, Y) :-
  183    unify_term(X, Y),
  184    !.
  185unify_term(X, _:Y) :-
  186    unify_term(X, Y),
  187    !.
  188unify_term(X, Y) :-
  189    format('[INTERNAL ERROR: Diff:~n'),
  190    portray_clause(X),
  191    format('~N*** <->~n'),
  192    portray_clause(Y),
  193    break.
  194
  195unify_args(N, N, _, _) :- !.
  196unify_args(I, Arity, T1, T2) :-
  197    A is I + 1,
  198    arg(A, T1, A1),
  199    arg(A, T2, A2),
  200    unify_term(A1, A2),
  201    unify_args(A, Arity, T1, T2).
  202
  203
  204%!  read_term_at_line(+File, +Line, +Module,
  205%!                    -Clause, -TermPos, -VarNames) is semidet.
  206%
  207%   Read a term from File at Line.
  208
  209read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :-
  210    setup_call_cleanup(
  211        '$push_input_context'(clause_info),
  212        read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames),
  213        '$pop_input_context').
  214
  215read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :-
  216    catch(try_open_source(File, In), error(_,_), fail),
  217    set_stream(In, newline(detect)),
  218    call_cleanup(
  219        read_source_term_at_location(
  220            In, Clause,
  221            [ line(Line),
  222              module(Module),
  223              subterm_positions(TermPos),
  224              variable_names(VarNames)
  225            ]),
  226        close(In)).
  227
  228%!  open_source(+File, -Stream) is semidet.
  229%
  230%   Hook into clause_info/5 that opens the stream holding the source
  231%   for a specific clause. Thus, the query must succeed. The default
  232%   implementation calls open/3 on the `File` property.
  233%
  234%     ==
  235%     clause_property(ClauseRef, file(File)),
  236%     prolog_clause:open_source(File, Stream)
  237%     ==
  238
  239:- public try_open_source/2.            % used by library(prolog_breakpoints).
  240
  241try_open_source(File, In) :-
  242    open_source(File, In),
  243    !.
  244try_open_source(File, In) :-
  245    open(File, read, In, [reposition(true)]).
  246
  247
  248%!  make_varnames(+ReadClause, +DecompiledClause,
  249%!                +Offsets, +Names, -Term) is det.
  250%
  251%   Create a Term varnames(...) where each argument contains the name
  252%   of the variable at that offset.  If the read Clause is a DCG rule,
  253%   name the two last arguments <DCG_list> and <DCG_tail>
  254%
  255%   This    predicate    calles     the      multifile     predicate
  256%   make_varnames_hook/5 with the same arguments   to allow for user
  257%   extensions. Extending this predicate  is   needed  if a compiler
  258%   adds additional arguments to the clause   head that must be made
  259%   visible in the GUI tracer.
  260%
  261%   @param Offsets  List of Offset=Var
  262%   @param Names    List of Name=Var
  263
  264make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :-
  265    make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term),
  266    !.
  267make_varnames(ReadClause, _, Offsets, Names, Bindings) :-
  268    dcg_head(ReadClause, Head),
  269    !,
  270    functor(Head, _, Arity),
  271    In is Arity,
  272    memberchk(In=IVar, Offsets),
  273    Names1 = ['<DCG_list>'=IVar|Names],
  274    Out is Arity + 1,
  275    memberchk(Out=OVar, Offsets),
  276    Names2 = ['<DCG_tail>'=OVar|Names1],
  277    make_varnames(xx, xx, Offsets, Names2, Bindings).
  278make_varnames(_, _, Offsets, Names, Bindings) :-
  279    length(Offsets, L),
  280    functor(Bindings, varnames, L),
  281    do_make_varnames(Offsets, Names, Bindings).
  282
  283dcg_head((Head,_ --> _Body), Head).
  284dcg_head((Head   --> _Body), Head).
  285dcg_head((Head,_ ==> _Body), Head).
  286dcg_head((Head   ==> _Body), Head).
  287
  288do_make_varnames([], _, _).
  289do_make_varnames([N=Var|TO], Names, Bindings) :-
  290    (   find_varname(Var, Names, Name)
  291    ->  true
  292    ;   Name = '_'
  293    ),
  294    AN is N + 1,
  295    arg(AN, Bindings, Name),
  296    do_make_varnames(TO, Names, Bindings).
  297
  298find_varname(Var, [Name = TheVar|_], Name) :-
  299    Var == TheVar,
  300    !.
  301find_varname(Var, [_|T], Name) :-
  302    find_varname(Var, T, Name).
  303
  304%!  unify_clause(+Read, +Decompiled, +Module, +ReadTermPos,
  305%!               -RecompiledTermPos).
  306%
  307%   What you read isn't always what goes into the database. The task
  308%   of this predicate is to establish  the relation between the term
  309%   read from the file and the result from decompiling the clause.
  310%
  311%   This predicate calls the multifile predicate unify_clause_hook/5
  312%   with the same arguments to support user extensions.
  313%
  314%   @arg Module is the source module that   was active when loading this
  315%   clause,  which  is  the  same  as  prolog_load_context/2  using  the
  316%   `module` context. If this cannot be established  it is the module to
  317%   which the clause itself is associated.   The argument may be used to
  318%   determine whether or not a specific user transformation is in scope.
  319%   See also term_expansion/2,4 and goal_expansion/2,4.
  320%
  321%   @tbd    This really must be  more   flexible,  dealing with much
  322%           more complex source-translations,  falling   back  to  a
  323%           heuristic method locating as much as possible.
  324
  325unify_clause(Read, _, _, _, _) :-
  326    var(Read),
  327    !,
  328    fail.
  329unify_clause((RHead :- RBody), (CHead :- CBody), Module, TermPos1, TermPos) :-
  330    '$expand':f2_pos(TermPos1, HPos, BPos1,
  331                     TermPos2, HPos, BPos2),
  332    inlined_unification(RBody, CBody, RBody1, CBody1, RHead,
  333                        BPos1, BPos2),
  334    RBody1 \== RBody,
  335    !,
  336    unify_clause2((RHead :- RBody1), (CHead :- CBody1), Module,
  337                  TermPos2, TermPos).
  338unify_clause(Read, Decompiled, _, TermPos, TermPos) :-
  339    Read =@= Decompiled,
  340    !,
  341    Read = Decompiled.
  342unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  343    unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos),
  344    !.
  345                                        % XPCE send-methods
  346unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  347    !,
  348    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  349                                        % XPCE get-methods
  350unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
  351    !,
  352    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
  353                                        % Unit test clauses
  354unify_clause((TH :- RBody), (CH :- !, CBody), Module, TP0, TP) :-
  355    plunit_source_head(TH),
  356    plunit_compiled_head(CH),
  357    !,
  358    TP0 = term_position(F,T,FF,FT,[HP,BP0]),
  359    ubody(RBody, CBody, Module, BP0, BP),
  360    TP  = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
  361                                        % module:head :- body
  362unify_clause((Head :- Read),
  363             (Head :- _M:Compiled), Module, TermPos0, TermPos) :-
  364    unify_clause2((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
  365    TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
  366    TermPos  = term_position(TA,TZ,FA,FZ,
  367                             [ PH,
  368                               term_position(0,0,0,0,[0-0,PB])
  369                             ]).
  370                                        % DCG rules
  371unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  372    Read = (_ --> Terminal, _),
  373    is_list(Terminal),
  374    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  375    Compiled2 = (DH :- _),
  376    functor(DH, _, Arity),
  377    DArg is Arity - 1,
  378    append(Terminal, _Tail, List),
  379    arg(DArg, DH, List),
  380    TermPos1 = term_position(F,T,FF,FT,[ HP,
  381                                         term_position(_,_,_,_,[_,BP])
  382                                       ]),
  383    !,
  384    TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]),
  385    match_module(Compiled2, Compiled1, Module, TermPos2, TermPos).
  386                                               % SSU rules
  387unify_clause((Head,RCond => Body), (CHead :- CCondAndBody), Module,
  388             term_position(F,T,FF,FT,
  389                           [ term_position(_,_,_,_,[HP,CP]),
  390                             BP
  391                           ]),
  392             TermPos) :-
  393    split_on_cut(CCondAndBody, CCond, CBody0),
  394    !,
  395    inlined_unification(RCond, CCond, RCond1, CCond1, Head, CP, CP1),
  396    TermPos1 = term_position(F,T,FF,FT, [HP, BP1]),
  397    BP2 = term_position(_,_,_,_, [FF-FT, BP]), % Represent (!, Body), placing
  398    (   CCond1 == true                         % ! at =>
  399    ->  BP1 = BP2,                             % Whole guard is inlined
  400        unify_clause2((Head :- !, Body), (CHead :- !, CBody0),
  401                      Module, TermPos1, TermPos)
  402    ;   mkconj_pos(RCond1, CP1, (!,Body), BP2, RBody, BP1),
  403        mkconj_npos(CCond1, (!,CBody0), CBody),
  404        unify_clause2((Head :- RBody), (CHead :- CBody),
  405                      Module, TermPos1, TermPos)
  406    ).
  407unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :-
  408    !,
  409    unify_clause2((Head :- Body), Compiled1, Module, TermPos0, TermPos).
  410unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
  411    Read = (_ ==> _),
  412    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  413    Compiled2 \= (_ ==> _),
  414    !,
  415    unify_clause(Compiled2, Compiled1, Module, TermPos1, TermPos).
  416unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
  417    unify_clause2(Read, Decompiled, Module, TermPos0, TermPos).
  418
  419% mkconj, but also unify position info
  420mkconj_pos((A,B), term_position(F,T,FF,FT,[PA,PB]), Ex, ExPos, Code, Pos) =>
  421    Code = (A,B1),
  422    Pos = term_position(F,T,FF,FT,[PA,PB1]),
  423    mkconj_pos(B, PB, Ex, ExPos, B1, PB1).
  424mkconj_pos(Last, LastPos, Ex, ExPos, Code, Pos) =>
  425    Code = (Last,Ex),
  426    Pos = term_position(_,_,_,_,[LastPos,ExPos]).
  427
  428% similar to mkconj, but we should __not__ optimize `true` away.
  429mkconj_npos((A,B), Ex, Code) =>
  430    Code = (A,B1),
  431    mkconj_npos(B, Ex, B1).
  432mkconj_npos(A, Ex, Code) =>
  433    Code = (A,Ex).
  434
  435%!  unify_clause2(+Read, +Decompiled, +Module, +TermPosIn, -TermPosOut)
  436%
  437%   Stratified version to be used after the first match
  438
  439unify_clause2(Read, Decompiled, _, TermPos, TermPos) :-
  440    Read =@= Decompiled,
  441    !,
  442    Read = Decompiled.
  443unify_clause2(Read, Compiled1, Module, TermPos0, TermPos) :-
  444    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
  445    match_module(Compiled2, Compiled1, Module, TermPos1, TermPos).
  446                                        % I don't know ...
  447unify_clause2(_, _, _, _, _) :-
  448    debug(clause_info, 'Could not unify clause', []),
  449    fail.
  450
  451unify_clause_head(H1, H2) :-
  452    strip_module(H1, _, H),
  453    strip_module(H2, _, H).
  454
  455plunit_source_head(test(_,_)) => true.
  456plunit_source_head(test(_)) => true.
  457plunit_source_head(_) => fail.
  458
  459plunit_compiled_head(_:'unit body'(_, _)) => true.
  460plunit_compiled_head('unit body'(_, _)) => true.
  461plunit_compiled_head(_) => fail.
  462
  463%!  inlined_unification(+BodyRead, +BodyCompiled,
  464%!                      -BodyReadOut, -BodyCompiledOut,
  465%!                      +HeadRead,
  466%!                      +BodyPosIn, -BodyPosOut) is det.
  467
  468inlined_unification((V=T,RBody0), (CV=CT,CBody0),
  469                    RBody, CBody, RHead, BPos1, BPos),
  470    inlineable_head_var(RHead, V2),
  471    V == V2,
  472    (V=T) =@= (CV=CT) =>
  473    argpos(2, BPos1, BPos2),
  474    inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos).
  475inlined_unification((V=T), (CV=CT),
  476                    RBody, CBody, RHead, BPos1, BPos),
  477    inlineable_head_var(RHead, V2),
  478    V == V2,
  479    (V=T) =@= (CV=CT) =>
  480    RBody = true,
  481    CBody = true,
  482    argpos(2, BPos1, BPos).
  483inlined_unification((V=T,RBody0), CBody0,
  484                    RBody, CBody, RHead, BPos1, BPos),
  485    inlineable_head_var(RHead, V2),
  486    V == V2,
  487    \+ (CBody0 = (G1,_), G1 =@= (V=T)) =>
  488    argpos(2, BPos1, BPos2),
  489    inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos).
  490inlined_unification((V=_), true,
  491                    RBody, CBody, RHead, BPos1, BPos),
  492    inlineable_head_var(RHead, V2),
  493    V == V2 =>
  494    RBody = true,
  495    CBody = true,
  496    argpos(2, BPos1, BPos).
  497inlined_unification(RBody0, CBody0, RBody, CBody, _RHead,
  498                    BPos0, BPos) =>
  499    RBody = RBody0,
  500    BPos  = BPos0,
  501    CBody = CBody0.
  502
  503%!  inlineable_head_var(+Head, -Var) is nondet
  504%
  505%   True when Var is a variable in  Head   that  may  be used for inline
  506%   unification. Currently we only inline direct arguments to the head.
  507
  508inlineable_head_var(Head, Var) :-
  509    compound(Head),
  510    arg(_, Head, Var).
  511
  512split_on_cut((Cond0,!,Body0), Cond, Body) =>
  513    Cond = Cond0,
  514    Body = Body0.
  515split_on_cut((!,Body0), Cond, Body) =>
  516    Cond = true,
  517    Body = Body0.
  518split_on_cut((A,B), Cond, Body) =>
  519    Cond = (A,Cond1),
  520    split_on_cut(B, Cond1, Body).
  521split_on_cut(_, _, _) =>
  522    fail.
  523
  524ci_expand(Read, Compiled, Module, TermPos0, TermPos) :-
  525    catch(setup_call_cleanup(
  526              ( set_xref_flag(OldXRef),
  527                '$set_source_module'(Old, Module)
  528              ),
  529              expand_term(Read, TermPos0, Compiled, TermPos),
  530              ( '$set_source_module'(Old),
  531                set_prolog_flag(xref, OldXRef)
  532              )),
  533          E,
  534          expand_failed(E, Read)),
  535    compound(TermPos),                  % make sure somthing is filled.
  536    arg(1, TermPos, A1), nonvar(A1),
  537    arg(2, TermPos, A2), nonvar(A2).
  538
  539set_xref_flag(Value) :-
  540    current_prolog_flag(xref, Value),
  541    !,
  542    set_prolog_flag(xref, true).
  543set_xref_flag(false) :-
  544    create_prolog_flag(xref, true, [type(boolean)]).
  545
  546match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :-
  547    !,
  548    unify_clause_head(H1, H2),
  549    unify_body(B1, B2, Module, Pos0, Pos).
  550match_module((H1 :- B1), H2, _Module, Pos0, Pos) :-
  551    B1 == true,
  552    unify_clause_head(H1, H2),
  553    Pos = Pos0,
  554    !.
  555match_module(H1, H2, _, Pos, Pos) :-    % deal with facts
  556    unify_clause_head(H1, H2).
  557
  558%!  expand_failed(+Exception, +Term)
  559%
  560%   When debugging, indicate that expansion of the term failed.
  561
  562expand_failed(E, Read) :-
  563    debugging(clause_info),
  564    message_to_string(E, Msg),
  565    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
  566    fail.
  567
  568%!  unify_body(+Read, +Decompiled, +Module, +Pos0, -Pos)
  569%
  570%   Deal with translations implied by the compiler.  For example,
  571%   compiling (a,b),c yields the same code as compiling a,b,c.
  572%
  573%   Pos0 and Pos still include the term-position of the head.
  574
  575unify_body(B, C, _, Pos, Pos) :-
  576    B =@= C, B = C,
  577    does_not_dcg_after_binding(B, Pos),
  578    !.
  579unify_body(R, D, Module,
  580           term_position(F,T,FF,FT,[HP,BP0]),
  581           term_position(F,T,FF,FT,[HP,BP])) :-
  582    ubody(R, D, Module, BP0, BP).
  583
  584%!  does_not_dcg_after_binding(+ReadBody, +ReadPos) is semidet.
  585%
  586%   True  if  ReadPos/ReadPos  does   not    contain   DCG   delayed
  587%   unifications.
  588%
  589%   @tbd    We should pass that we are in a DCG; if we are not there
  590%           is no reason for this test.
  591
  592does_not_dcg_after_binding(B, Pos) :-
  593    \+ sub_term(brace_term_position(_,_,_), Pos),
  594    \+ (sub_term((Cut,_=_), B), Cut == !),
  595    !.
  596
  597
  598/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  599Some remarks.
  600
  601a --> { x, y, z }.
  602    This is translated into "(x,y),z), X=Y" by the DCG translator, after
  603    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
  604- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  605
  606%!  unify_goal(+Read, +Decompiled, +Module,
  607%!             +TermPosRead, -TermPosDecompiled) is semidet.
  608%
  609%   This hook is called to  fix   up  source code manipulations that
  610%   result from goal expansions.
  611
  612%!  ubody(+Read, +Decompiled, +Module, +TermPosRead, -TermPosForDecompiled)
  613%
  614%   @arg Read             Clause read _after_ expand_term/2
  615%   @arg Decompiled       Decompiled clause
  616%   @arg Module           Load module
  617%   @arg TermPosRead      Sub-term positions of source
  618
  619ubody(B, DB, _, P, P) :-
  620    var(P),                        % TBD: Create compatible pos term?
  621    !,
  622    B = DB.
  623ubody(B, C, _, P, P) :-
  624    B =@= C, B = C,
  625    does_not_dcg_after_binding(B, P),
  626    !.
  627ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :-
  628    !,
  629    ubody(X0, X, M, P0, P).
  630ubody(X, Y, _,                    % X = call(X)
  631      Pos,
  632      term_position(From, To, From, To, [Pos])) :-
  633    nonvar(Y),
  634    Y = call(X),
  635    !,
  636    arg(1, Pos, From),
  637    arg(2, Pos, To).
  638ubody(A, B, _, P1, P2) :-
  639    nonvar(A), A = (_=_),
  640    nonvar(B), B = (LB=RB),
  641    A =@= (RB=LB),
  642    !,
  643    P1 = term_position(F,T, FF,FT, [PL,PR]),
  644    P2 = term_position(F,T, FF,FT, [PR,PL]).
  645ubody(A, B, _, P1, P2) :-
  646    nonvar(A), A = (_==_),
  647    nonvar(B), B = (LB==RB),
  648    A =@= (RB==LB),
  649    !,
  650    P1 = term_position(F,T, FF,FT, [PL,PR]),
  651    P2 = term_position(F,T, FF,FT, [PR,PL]).
  652ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :-
  653    nonvar(B), B = M:R,
  654    ubody(R, D, M, RP, TPOut).
  655ubody(B, D, M, term_position(_,_,_,_,[RP0,RP1]), TPOut) :-
  656    nonvar(B), B = (B0,B1),
  657    (   maybe_optimized(B0),
  658        ubody(B1, D, M, RP1, TPOut)
  659    ->  true
  660    ;   maybe_optimized(B1),
  661        ubody(B0, D, M, RP0, TPOut)
  662    ),
  663    !.
  664ubody(B0, B, M,
  665      brace_term_position(F,T,A0),
  666      Pos) :-
  667    B0 = (_,_=_),
  668    !,
  669    T1 is T - 1,
  670    ubody(B0, B, M,
  671          term_position(F,T,
  672                        F,T,
  673                        [A0,T1-T]),
  674          Pos).
  675ubody(B0, B, M,
  676      brace_term_position(F,T,A0),
  677      term_position(F,T,F,T,[A])) :-
  678    !,
  679    ubody(B0, B, M, A0, A).
  680ubody(C0, C, M, P0, P) :-
  681    nonvar(C0), nonvar(C),
  682    C0 = (_,_), C = (_,_),
  683    !,
  684    conj(C0, P0, GL, PL),
  685    mkconj(C, M, P, GL, PL).
  686ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :-
  687    unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled),
  688    !.
  689ubody(X0, X, M,
  690      term_position(F,T,FF,TT,PA0),
  691      term_position(F,T,FF,TT,PA)) :-
  692    callable(X0),
  693    callable(X),
  694    meta(M, X0, S),
  695    !,
  696    X0 =.. [_|A0],
  697    X  =.. [_|A],
  698    S =.. [_|AS],
  699    ubody_list(A0, A, AS, M, PA0, PA).
  700ubody(X0, X, M,
  701      term_position(F,T,FF,TT,PA0),
  702      term_position(F,T,FF,TT,PA)) :-
  703    expand_goal(X0, X1, M, PA0, PA),
  704    X1 =@= X,
  705    X1 = X.
  706
  707                                        % 5.7.X optimizations
  708ubody(_=_, true, _,                     % singleton = Any
  709      term_position(F,T,_FF,_TT,_PA),
  710      F-T) :- !.
  711ubody(_==_, fail, _,                    % singleton/firstvar == Any
  712      term_position(F,T,_FF,_TT,_PA),
  713      F-T) :- !.
  714ubody(A1=B1, B2=A2, _,                  % Term = Var --> Var = Term
  715      term_position(F,T,FF,TT,[PA1,PA2]),
  716      term_position(F,T,FF,TT,[PA2,PA1])) :-
  717    var(B1), var(B2),
  718    (A1==B1) =@= (B2==A2),
  719    !,
  720    A1 = A2, B1=B2.
  721ubody(A1==B1, B2==A2, _,                % const == Var --> Var == const
  722      term_position(F,T,FF,TT,[PA1,PA2]),
  723      term_position(F,T,FF,TT,[PA2,PA1])) :-
  724    var(B1), var(B2),
  725    (A1==B1) =@= (B2==A2),
  726    !,
  727    A1 = A2, B1=B2.
  728ubody(A is B - C, A is B + C2, _, Pos, Pos) :-
  729    integer(C),
  730    C2 =:= -C,
  731    !.
  732
  733ubody_list([], [], [], _, [], []).
  734ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
  735    ubody_elem(AS, G0, G, M, PA0, PA),
  736    ubody_list(T0, T, ASL, M, PAT0, PAT).
  737
  738ubody_elem(0, G0, G, M, PA0, PA) :-
  739    !,
  740    ubody(G0, G, M, PA0, PA).
  741ubody_elem(_, G, G, _, PA, PA).
  742
  743%!  conj(+GoalTerm, +PositionTerm, -GoalList, -PositionList)
  744%
  745%   Turn a conjunctive body into a list   of  goals and their positions,
  746%   i.e., removing the positions of the (,)/2 terms.
  747
  748conj(Goal, Pos, GoalList, PosList) :-
  749    conj(Goal, Pos, GoalList, [], PosList, []).
  750
  751conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
  752    !,
  753    conj(A, PA, GL, TGA, PL, TPA),
  754    conj(B, PB, TGA, TG, TPA, TP).
  755conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
  756    B = (_=_),
  757    !,
  758    conj(A, PA, GL, TGA, PL, TPA),
  759    T1 is T - 1,
  760    conj(B, T1-T, TGA, TG, TPA, TP).
  761conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :-
  762    nonvar(Pos),
  763    !,
  764    conj(A, Pos, GL, TG, PL, TP).
  765conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
  766    F1 is F+1,
  767    T1 is T+1.
  768conj(A, P, [A|TG], TG, [P|TP], TP).
  769
  770
  771%!  mkconj(+Decompiled, +Module, -Position, +ReadGoals, +ReadPositions)
  772
  773mkconj(Goal, M, Pos, GoalList, PosList) :-
  774    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
  775
  776mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
  777    nonvar(Conj),
  778    Conj = (A,B),
  779    !,
  780    mkconj(A, M, PA, GL, TGA, PL, TPA),
  781    mkconj(B, M, PB, TGA, TG, TPA, TP).
  782mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
  783    ubody(A, A0, M, P, P0),
  784    !.
  785mkconj(A0, M, P0, [RG|TG0], TG, [_|TP0], TP) :-
  786    maybe_optimized(RG),
  787    mkconj(A0, M, P0, TG0, TG, TP0, TP).
  788
  789maybe_optimized(debug(_,_,_)).
  790maybe_optimized(assertion(_)).
  791maybe_optimized(true).
  792
  793%!  argpos(+N, +PositionTerm, -ArgPositionTerm) is det.
  794%
  795%   Get the position for the nth argument of PositionTerm.
  796
  797argpos(N, parentheses_term_position(_,_,PosIn), Pos) =>
  798    argpos(N, PosIn, Pos).
  799argpos(N, term_position(_,_,_,_,ArgPos), Pos) =>
  800    nth1(N, ArgPos, Pos).
  801argpos(_, _, _) => true.
  802
  803
  804                 /*******************************
  805                 *    PCE STUFF (SHOULD MOVE)   *
  806                 *******************************/
  807
  808/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  809        <method>(Receiver, ... Arg ...) :->
  810                Body
  811
  812mapped to:
  813
  814        send_implementation(Id, <method>(...Arg...), Receiver)
  815
  816- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  817
  818pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
  819    !,
  820    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
  821pce_method_clause(Head, Body,
  822                  send_implementation(_Id, Msg, Receiver), PlBody,
  823                  M, TermPos0, TermPos) :-
  824    !,
  825    debug(clause_info, 'send method ...', []),
  826    arg(1, Head, Receiver),
  827    functor(Head, _, Arity),
  828    pce_method_head_arguments(2, Arity, Head, Msg),
  829    debug(clause_info, 'head ...', []),
  830    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  831pce_method_clause(Head, Body,
  832                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
  833                  M, TermPos0, TermPos) :-
  834    !,
  835    debug(clause_info, 'get method ...', []),
  836    arg(1, Head, Receiver),
  837    debug(clause_info, 'receiver ...', []),
  838    functor(Head, _, Arity),
  839    arg(Arity, Head, PceResult),
  840    debug(clause_info, '~w?~n', [PceResult = Result]),
  841    pce_unify_head_arg(PceResult, Result),
  842    Ar is Arity - 1,
  843    pce_method_head_arguments(2, Ar, Head, Msg),
  844    debug(clause_info, 'head ...', []),
  845    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
  846
  847pce_method_head_arguments(N, Arity, Head, Msg) :-
  848    N =< Arity,
  849    !,
  850    arg(N, Head, PceArg),
  851    PLN is N - 1,
  852    arg(PLN, Msg, PlArg),
  853    pce_unify_head_arg(PceArg, PlArg),
  854    debug(clause_info, '~w~n', [PceArg = PlArg]),
  855    NextArg is N+1,
  856    pce_method_head_arguments(NextArg, Arity, Head, Msg).
  857pce_method_head_arguments(_, _, _, _).
  858
  859pce_unify_head_arg(V, A) :-
  860    var(V),
  861    !,
  862    V = A.
  863pce_unify_head_arg(A:_=_, A) :- !.
  864pce_unify_head_arg(A:_, A).
  865
  866%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
  867%
  868%       Unify the body of an XPCE method.  Goal-expansion makes this
  869%       rather tricky, especially as we cannot call XPCE's expansion
  870%       on an isolated method.
  871%
  872%       TermPos0 is the term-position term of the whole clause!
  873%
  874%       Further, please note that the body of the method-clauses reside
  875%       in another module than pce_principal, and therefore the body
  876%       starts with an I_CONTEXT call. This implies we need a
  877%       hypothetical term-position for the module-qualifier.
  878
  879pce_method_body(A0, A, M, TermPos0, TermPos) :-
  880    TermPos0 = term_position(F, T, FF, FT,
  881                             [ HeadPos,
  882                               BodyPos0
  883                             ]),
  884    TermPos  = term_position(F, T, FF, FT,
  885                             [ HeadPos,
  886                               term_position(0,0,0,0, [0-0,BodyPos])
  887                             ]),
  888    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
  889
  890
  891pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
  892    !,
  893    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
  894    TermPos  = BodyPos,
  895    expand_goal(A0, A, M, BodyPos0, BodyPos).
  896pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  897    A0 =.. [Func,B0,C0],
  898    control_op(Func),
  899    !,
  900    A =.. [Func,B,C],
  901    TermPos0 = term_position(F, T, FF, FT,
  902                             [ BP0,
  903                               CP0
  904                             ]),
  905    TermPos  = term_position(F, T, FF, FT,
  906                             [ BP,
  907                               CP
  908                             ]),
  909    pce_method_body2(B0, B, M, BP0, BP),
  910    expand_goal(C0, C, M, CP0, CP).
  911pce_method_body2(A0, A, M, TermPos0, TermPos) :-
  912    expand_goal(A0, A, M, TermPos0, TermPos).
  913
  914control_op(',').
  915control_op((;)).
  916control_op((->)).
  917control_op((*->)).
  918
  919                 /*******************************
  920                 *     EXPAND_GOAL SUPPORT      *
  921                 *******************************/
  922
  923/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  924With the introduction of expand_goal, it  is increasingly hard to relate
  925the clause from the database to the actual  source. For one thing, we do
  926not know the compilation  module  of  the   clause  (unless  we  want to
  927decompile it).
  928
  929Goal expansion can translate  goals   into  control-constructs, multiple
  930clauses, or delete a subgoal.
  931
  932To keep track of the source-locations, we   have to redo the analysis of
  933the clause as defined in init.pl
  934- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  935
  936expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
  937    var(G),
  938    !.
  939expand_goal(G, G1, _, P, P) :-
  940    var(G),
  941    !,
  942    G1 = G.
  943expand_goal(M0, M, Module, P0, P) :-
  944    meta(Module, M0, S),
  945    !,
  946    P0 = term_position(F,T,FF,FT,PL0),
  947    P  = term_position(F,T,FF,FT,PL),
  948    functor(M0, Functor, Arity),
  949    functor(M,  Functor, Arity),
  950    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
  951expand_goal(A, B, Module, P0, P) :-
  952    goal_expansion(A, B0, P0, P1),
  953    !,
  954    expand_goal(B0, B, Module, P1, P).
  955expand_goal(A, A, _, P, P).
  956
  957expand_meta_args([],      [],   _,  _, _,      _,  _).
  958expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
  959    arg(I, M0, A0),
  960    arg(I, M,  A),
  961    arg(I, S,  AS),
  962    expand_arg(AS, A0, A, Module, P0, P),
  963    NI is I + 1,
  964    expand_meta_args(T0, T, NI, S, Module, M0, M).
  965
  966expand_arg(0, A0, A, Module, P0, P) :-
  967    !,
  968    expand_goal(A0, A, Module, P0, P).
  969expand_arg(_, A, A, _, P, P).
  970
  971meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
  972
  973goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
  974    compound(Msg),
  975    Msg =.. [send_super, Selector | Args],
  976    !,
  977    SuperMsg =.. [Selector|Args].
  978goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
  979    compound(Msg),
  980    Msg =.. [get_super, Selector | Args],
  981    !,
  982    SuperMsg =.. [Selector|Args].
  983goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
  984goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
  985goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
  986    compound(SendSuperN),
  987    compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]),
  988    Msg =.. [Sel|Args].
  989goal_expansion(SendN, send(R, Msg), P, P) :-
  990    compound(SendN),
  991    compound_name_arguments(SendN, send, [R,Sel|Args]),
  992    atom(Sel), Args \== [],
  993    Msg =.. [Sel|Args].
  994goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
  995    compound(GetSuperN),
  996    compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]),
  997    append(Args, [Answer], AllArgs),
  998    Msg =.. [Sel|Args].
  999goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
 1000    compound(GetN),
 1001    compound_name_arguments(GetN, get, [R,Sel|AllArgs]),
 1002    append(Args, [Answer], AllArgs),
 1003    atom(Sel), Args \== [],
 1004    Msg =.. [Sel|Args].
 1005goal_expansion(G0, G, P, P) :-
 1006    user:goal_expansion(G0, G),     % TBD: we need the module!
 1007    G0 \== G.                       % \=@=?
 1008
 1009
 1010                 /*******************************
 1011                 *        INITIALIZATION        *
 1012                 *******************************/
 1013
 1014%!  initialization_layout(+SourceLocation, ?InitGoal,
 1015%!                        -ReadGoal, -TermPos) is semidet.
 1016%
 1017%   Find term-layout of :- initialization directives.
 1018
 1019initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
 1020    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
 1021    Directive    = (:- initialization(ReadGoal)),
 1022    DirectivePos = term_position(_, _, _, _, [InitPos]),
 1023    InitPos      = term_position(_, _, _, _, [GoalPos]),
 1024    (   ReadGoal = M:_
 1025    ->  Goal = M:Goal0
 1026    ;   Goal = Goal0
 1027    ),
 1028    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
 1029    !.
 1030
 1031
 1032                 /*******************************
 1033                 *        PRINTABLE NAMES       *
 1034                 *******************************/
 1035
 1036:- module_transparent
 1037    predicate_name/2. 1038:- multifile
 1039    user:prolog_predicate_name/2,
 1040    user:prolog_clause_name/2. 1041
 1042hidden_module(user).
 1043hidden_module(system).
 1044hidden_module(pce_principal).           % should be config
 1045hidden_module(Module) :-                % SWI-Prolog specific
 1046    import_module(Module, system).
 1047
 1048thaffix(1, st) :- !.
 1049thaffix(2, nd) :- !.
 1050thaffix(_, th).
 1051
 1052%!  predicate_name(:Head, -PredName:string) is det.
 1053%
 1054%   Describe a predicate as [Module:]Name/Arity.
 1055
 1056predicate_name(Predicate, PName) :-
 1057    strip_module(Predicate, Module, Head),
 1058    (   user:prolog_predicate_name(Module:Head, PName)
 1059    ->  true
 1060    ;   functor(Head, Name, Arity),
 1061        (   hidden_module(Module)
 1062        ->  format(string(PName), '~q/~d', [Name, Arity])
 1063        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
 1064        )
 1065    ).
 1066
 1067%!  clause_name(+Ref, -Name)
 1068%
 1069%   Provide a suitable description of the indicated clause.
 1070
 1071clause_name(Ref, Name) :-
 1072    user:prolog_clause_name(Ref, Name),
 1073    !.
 1074clause_name(Ref, Name) :-
 1075    nth_clause(Head, N, Ref),
 1076    !,
 1077    predicate_name(Head, PredName),
 1078    thaffix(N, Th),
 1079    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
 1080clause_name(Ref, Name) :-
 1081    clause_property(Ref, erased),
 1082    !,
 1083    clause_property(Ref, predicate(M:PI)),
 1084    format(string(Name), 'erased clause from ~q', [M:PI]).
 1085clause_name(_, '<meta-call>')