prolog_clause.pl

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