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                     ]).

 clause_info(+ClauseRef, -File, -TermPos, -VarOffsets) is semidet

 clause_info(+ClauseRef, -File, -TermPos, -VarOffsets, +Options) is semidet

Fetches source information for the given clause. File is the file from which the clause was loaded. TermPos describes the source layout in a format compatible to the subterm_positions option of read_term/2. VarOffsets provides access to the variable allocation in a stack-frame. See make_varnames/5 for details.

Note that positions are character positions, i.e., not bytes. Line endings count as a single character, regardless of whether the actual ending is \n or =|\r\n|_.

Defined options are:

variable_names(-Names)

Unify Names with the variable names list (Name=Var) as returned by read_term/3. This argument is intended for reporting source locations and refactoring based on analysis of the compiled code.

head(-Head)

body(-Body)

Get the head and body as terms. This is similar to clause/3, but a seperate call would break the variable identity.

  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).

 unify_term(+T1, +T2)

Unify the two terms, where T2 is created by writing the term and reading it back in, but be aware that rounding problems may cause floating point numbers not to unify. Also, if the initial term has a string object, it is written as "..." and read as a code-list. We compensate for that.

NOTE: Called directly from library(trace/clause) for the GUI tracer.

  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).

 read_term_at_line(+File, +Line, +Module, -Clause, -TermPos, -VarNames) is semidet

Read a term from File at Line.

  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)).

 open_source(+File, -Stream) is semidet

Hook into clause_info/5 that opens the stream holding the source for a specific clause. Thus, the query must succeed. The default implementation calls open/3 on the File property.

clause_property(ClauseRef, file(File)),
prolog_clause:open_source(File, Stream)

  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)]).

 make_varnames(+ReadClause, +DecompiledClause, +Offsets, +Names, -Term) is det

Create a Term varnames(...) where each argument contains the name of the variable at that offset. If the read Clause is a DCG rule, name the two last arguments <DCG_list> and <DCG_tail>

This predicate calles the multifile predicate make_varnames_hook/5 with the same arguments to allow for user extensions. Extending this predicate is needed if a compiler adds additional arguments to the clause head that must be made visible in the GUI tracer.

Arguments:

Offsets	- List of Offset=Var
Names	- List of Name=Var

  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).

 unify_clause(+Read, +Decompiled, +Module, +ReadTermPos, -RecompiledTermPos)

What you read isn't always what goes into the database. The task of this predicate is to establish the relation between the term read from the file and the result from decompiling the clause.

This predicate calls the multifile predicate unify_clause_hook/5 with the same arguments to support user extensions.

Arguments:

Module

- is the source module that was active when loading this clause, which is the same as prolog_load_context/2 using the module context. If this cannot be established it is the module to which the clause itself is associated. The argument may be used to determine whether or not a specific user transformation is in scope. See also term_expansion/2,4 and goal_expansion/2,4.

To be done

- This really must be more flexible, dealing with much more complex source-translations, falling back to a heuristic method locating as much as possible.

  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).

 unify_clause2(+Read, +Decompiled, +Module, +TermPosIn, -TermPosOut)

Stratified version to be used after the first match

  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.

 inlined_unification(+BodyRead, +BodyCompiled, -BodyReadOut, -BodyCompiledOut, +HeadRead, +BodyPosIn, -BodyPosOut) is det

  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.

 inlineable_head_var(+Head, -Var) is nondet

True when Var is a variable in Head that may be used for inline unification. Currently we only inline direct arguments to the head.

  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).

 expand_failed(+Exception, +Term)

When debugging, indicate that expansion of the term failed.

  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.

 unify_body(+Read, +Decompiled, +Module, +Pos0, -Pos)

Deal with translations implied by the compiler. For example, compiling (a,b),c yields the same code as compiling a,b,c.

Pos0 and Pos still include the term-position of the head.

  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).

 does_not_dcg_after_binding(+ReadBody, +ReadPos) is semidet

True if ReadPos/ReadPos does not contain DCG delayed unifications.

To be done

- We should pass that we are in a DCG; if we are not there is no reason for this test.

  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- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

 unify_goal(+Read, +Decompiled, +Module, +TermPosRead, -TermPosDecompiled) is semidet

This hook is called to fix up source code manipulations that result from goal expansions.

 ubody(+Read, +Decompiled, +Module, +TermPosRead, -TermPosForDecompiled)

Arguments:

Read	- Clause read after expand_term/2
Decompiled	- Decompiled clause
Module	- Load module
TermPosRead	- Sub-term positions of source

  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).

 conj(+GoalTerm, +PositionTerm, -GoalList, -PositionList)

Turn a conjunctive body into a list of goals and their positions, i.e., removing the positions of the (,)/2 terms.

  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).

 mkconj(+Decompiled, +Module, -Position, +ReadGoals, +ReadPositions)

  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).

 argpos(+N, +PositionTerm, -ArgPositionTerm) is det

Get the position for the nth argument of PositionTerm.

  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                 *******************************/

 initialization_layout(+SourceLocation, ?InitGoal, -ReadGoal, -TermPos) is semidet

Find term-layout of :- initialization directives.

 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).

 predicate_name(:Head, -PredName:string) is det

Describe a predicate as [Module:]Name/Arity.

 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    ).

 clause_name(+Ref, -Name)

Provide a suitable description of the indicated clause.

 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>')