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