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-2016, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(prolog_clause,
  37          [ clause_info/4,              % +ClauseRef, -File, -TermPos, -VarNames
  38            initialization_layout/4,    % +SourceLoc, +Goal, -Term, -TermPos
  39            predicate_name/2,           % +Head, -Name
  40            clause_name/2               % +ClauseRef, -Name
  41          ]).
  42:- use_module(library(lists), [append/3]).
  43:- use_module(library(occurs), [sub_term/2]).
  44:- use_module(library(debug)).
  45:- use_module(library(option)).
  46:- use_module(library(listing)).
  47:- use_module(library(prolog_source)).
  48
  49:- public                               % called from library(trace/clause)
  50    unify_term/2,
  51    make_varnames/5,
  52    do_make_varnames/3.
  53
  54:- multifile
  55    unify_goal/5,                   % +Read, +Decomp, +M, +Pos, -Pos
  56    unify_clause_hook/5,
  57    make_varnames_hook/5,
  58    open_source/2.                  % +Input, -Stream
  59
  60:- predicate_options(prolog_clause:clause_info/5, 5,
  61                     [ variable_names(-list)
  62                     ]).
  63
  64/** <module> Get detailed source-information about a clause
  65
  66This module started life as part of the   GUI tracer. As it is generally
  67useful for debugging  purposes  it  has   moved  to  the  general Prolog
  68library.
  69
  70The tracer library library(trace/clause) adds   caching and dealing with
  71dynamic predicates using listing to  XPCE   objects  to  this. Note that
  72clause_info/4 as below can be slow.
  73*/
  74
  75%!  clause_info(+ClauseRef, -File, -TermPos, -VarOffsets) is semidet.
  76%!  clause_info(+ClauseRef, -File, -TermPos, -VarOffsets, +Options) is semidet.
  77%
  78%   Fetches source information for the  given   clause.  File is the
  79%   file from which the clause  was   loaded.  TermPos describes the
  80%   source layout in a format   compatible  to the subterm_positions
  81%   option  of  read_term/2.  VarOffsets  provides   access  to  the
  82%   variable allocation in a stack-frame.   See  make_varnames/5 for
  83%   details.
  84%
  85%   Note that positions are  _|character   positions|_,  i.e., _not_
  86%   bytes. Line endings count as a   single character, regardless of
  87%   whether the actual ending is =|\n|= or =|\r\n|_.
  88%
  89%   Defined options are:
  90%
  91%     * variable_names(-Names)
  92%     Unify Names with the variable names list (Name=Var) as
  93%     returned by read_term/3.  This argument is intended for
  94%     reporting source locations and refactoring based on
  95%     analysis of the compiled code.
  96
  97clause_info(ClauseRef, File, TermPos, NameOffset) :-
  98    clause_info(ClauseRef, File, TermPos, NameOffset, []).
  99
 100clause_info(ClauseRef, File, TermPos, NameOffset, Options) :-
 101    (   debugging(clause_info)
 102    ->  clause_name(ClauseRef, Name),
 103        debug(clause_info, 'clause_info(~w) (~w)... ',
 104              [ClauseRef, Name])
 105    ;   true
 106    ),
 107    clause_property(ClauseRef, file(File)),
 108    File \== user,                  % loaded using ?- [user].
 109    '$clause'(Head0, Body, ClauseRef, VarOffset),
 110    (   module_property(Module, file(File))
 111    ->  true
 112    ;   strip_module(user:Head0, Module, _)
 113    ),
 114    unqualify(Head0, Module, Head),
 115    (   Body == true
 116    ->  DecompiledClause = Head
 117    ;   DecompiledClause = (Head :- Body)
 118    ),
 119    clause_property(ClauseRef, line_count(LineNo)),
 120    debug(clause_info, 'from ~w:~d ... ', [File, LineNo]),
 121    read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames),
 122    option(variable_names(VarNames), Options, _),
 123    debug(clause_info, 'read ...', []),
 124    unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos),
 125    debug(clause_info, 'unified ...', []),
 126    make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset),
 127    debug(clause_info, 'got names~n', []),
 128    !.
 129
 130unqualify(Module:Head, Module, Head) :-
 131    !.
 132unqualify(Head, _, Head).
 133
 134
 135%!  unify_term(+T1, +T2)
 136%
 137%   Unify the two terms, where T2 is created by writing the term and
 138%   reading it back in, but  be   aware  that  rounding problems may
 139%   cause floating point numbers not to  unify. Also, if the initial
 140%   term has a string object, it is written   as "..." and read as a
 141%   code-list. We compensate for that.
 142%
 143%   NOTE: Called directly from  library(trace/clause)   for  the GUI
 144%   tracer.
 145
 146unify_term(X, X) :- !.
 147unify_term(X1, X2) :-
 148    compound(X1),
 149    compound(X2),
 150    functor(X1, F, Arity),
 151    functor(X2, F, Arity),
 152    !,
 153    unify_args(0, Arity, X1, X2).
 154unify_term(X, Y) :-
 155    float(X), float(Y),
 156    !.
 157unify_term(X, Y) :-
 158    string(X),
 159    is_list(Y),
 160    string_codes(X, Y),
 161    !.
 162unify_term(_, Y) :-
 163    Y == '...',
 164    !.                          % elipses left by max_depth
 165unify_term(_:X, Y) :-
 166    unify_term(X, Y),
 167    !.
 168unify_term(X, _:Y) :-
 169    unify_term(X, Y),
 170    !.
 171unify_term(X, Y) :-
 172    format('[INTERNAL ERROR: Diff:~n'),
 173    portray_clause(X),
 174    format('~N*** <->~n'),
 175    portray_clause(Y),
 176    break.
 177
 178unify_args(N, N, _, _) :- !.
 179unify_args(I, Arity, T1, T2) :-
 180    A is I + 1,
 181    arg(A, T1, A1),
 182    arg(A, T2, A2),
 183    unify_term(A1, A2),
 184    unify_args(A, Arity, T1, T2).
 185
 186
 187%!  read_term_at_line(+File, +Line, +Module,
 188%!                    -Clause, -TermPos, -VarNames) is semidet.
 189%
 190%   Read a term from File at Line.
 191
 192read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :-
 193    setup_call_cleanup(
 194        '$push_input_context'(clause_info),
 195        read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames),
 196        '$pop_input_context').
 197
 198read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :-
 199    catch(try_open_source(File, In), _, fail),
 200    set_stream(In, newline(detect)),
 201    call_cleanup(
 202        read_source_term_at_location(
 203            In, Clause,
 204            [ line(Line),
 205              module(Module),
 206              subterm_positions(TermPos),
 207              variable_names(VarNames)
 208            ]),
 209        close(In)).
 210
 211%!  open_source(+File, -Stream) is semidet.
 212%
 213%   Hook into clause_info/5 that opens the stream holding the source
 214%   for a specific clause. Thus, the query must succeed. The default
 215%   implementation calls open/3 on the `File` property.
 216%
 217%     ==
 218%     clause_property(ClauseRef, file(File)),
 219%     prolog_clause:open_source(File, Stream)
 220%     ==
 221
 222try_open_source(File, In) :-
 223    open_source(File, In),
 224    !.
 225try_open_source(File, In) :-
 226    open(File, read, In).
 227
 228
 229%!  make_varnames(+ReadClause, +DecompiledClause,
 230%!                +Offsets, +Names, -Term) is det.
 231%
 232%   Create a Term varnames(...) where each argument contains the name
 233%   of the variable at that offset.  If the read Clause is a DCG rule,
 234%   name the two last arguments <DCG_list> and <DCG_tail>
 235%
 236%   This    predicate    calles     the      multifile     predicate
 237%   make_varnames_hook/5 with the same arguments   to allow for user
 238%   extensions. Extending this predicate  is   needed  if a compiler
 239%   adds additional arguments to the clause   head that must be made
 240%   visible in the GUI tracer.
 241%
 242%   @param Offsets  List of Offset=Var
 243%   @param Names    List of Name=Var
 244
 245make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :-
 246    make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term),
 247    !.
 248make_varnames((Head --> _Body), _, Offsets, Names, Bindings) :-
 249    !,
 250    functor(Head, _, Arity),
 251    In is Arity,
 252    memberchk(In=IVar, Offsets),
 253    Names1 = ['<DCG_list>'=IVar|Names],
 254    Out is Arity + 1,
 255    memberchk(Out=OVar, Offsets),
 256    Names2 = ['<DCG_tail>'=OVar|Names1],
 257    make_varnames(xx, xx, Offsets, Names2, Bindings).
 258make_varnames(_, _, Offsets, Names, Bindings) :-
 259    length(Offsets, L),
 260    functor(Bindings, varnames, L),
 261    do_make_varnames(Offsets, Names, Bindings).
 262
 263do_make_varnames([], _, _).
 264do_make_varnames([N=Var|TO], Names, Bindings) :-
 265    (   find_varname(Var, Names, Name)
 266    ->  true
 267    ;   Name = '_'
 268    ),
 269    AN is N + 1,
 270    arg(AN, Bindings, Name),
 271    do_make_varnames(TO, Names, Bindings).
 272
 273find_varname(Var, [Name = TheVar|_], Name) :-
 274    Var == TheVar,
 275    !.
 276find_varname(Var, [_|T], Name) :-
 277    find_varname(Var, T, Name).
 278
 279%!  unify_clause(+Read, +Decompiled, +Module, +ReadTermPos,
 280%!               -RecompiledTermPos).
 281%
 282%   What you read isn't always what goes into the database. The task
 283%   of this predicate is to establish  the relation between the term
 284%   read from the file and the result from decompiling the clause.
 285%
 286%   This predicate calls the multifile predicate unify_clause_hook/5
 287%   with the same arguments to support user extensions.
 288%
 289%   @tbd    This really must be  more   flexible,  dealing with much
 290%           more complex source-translations,  falling   back  to  a
 291%           heuristic method locating as much as possible.
 292
 293unify_clause(Read, Read, _, TermPos, TermPos) :- !.
 294                                        % XPCE send-methods
 295unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :-
 296    unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos),
 297    !.
 298unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
 299    !,
 300    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
 301                                        % XPCE get-methods
 302unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :-
 303    !,
 304    pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos).
 305                                        % Unit test clauses
 306unify_clause((TH :- Body),
 307             (_:'unit body'(_, _) :- !, Body), _,
 308             TP0, TP) :-
 309    (   TH = test(_,_)
 310    ;   TH = test(_)
 311    ),
 312    !,
 313    TP0 = term_position(F,T,FF,FT,[HP,BP]),
 314    TP  = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
 315                                        % module:head :- body
 316unify_clause((Head :- Read),
 317             (Head :- _M:Compiled), Module, TermPos0, TermPos) :-
 318    unify_clause((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
 319    TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
 320    TermPos  = term_position(TA,TZ,FA,FZ,
 321                             [ PH,
 322                               term_position(0,0,0,0,[0-0,PB])
 323                             ]).
 324                                        % DCG rules
 325unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
 326    Read = (_ --> List, _),
 327    is_list(List),
 328    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
 329    Compiled2 = (DH :- _),
 330    functor(DH, _, Arity),
 331    DArg is Arity - 1,
 332    arg(DArg, DH, List),
 333    nonvar(List),
 334    TermPos1 = term_position(F,T,FF,FT,[ HP,
 335                                         term_position(_,_,_,_,[_,BP])
 336                                       ]),
 337    !,
 338    TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]),
 339    match_module(Compiled2, Compiled1, Module, TermPos2, TermPos).
 340                                        % general term-expansion
 341unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
 342    ci_expand(Read, Compiled2, Module, TermPos0, TermPos1),
 343    match_module(Compiled2, Compiled1, Module, TermPos1, TermPos).
 344                                        % I don't know ...
 345unify_clause(_, _, _, _, _) :-
 346    debug(clause_info, 'Could not unify clause', []),
 347    fail.
 348
 349unify_clause_head(H1, H2) :-
 350    strip_module(H1, _, H),
 351    strip_module(H2, _, H).
 352
 353ci_expand(Read, Compiled, Module, TermPos0, TermPos) :-
 354    catch(setup_call_cleanup(
 355              ( set_xref_flag(OldXRef),
 356                '$set_source_module'(Old, Module)
 357              ),
 358              expand_term(Read, TermPos0, Compiled, TermPos),
 359              ( '$set_source_module'(Old),
 360                set_prolog_flag(xref, OldXRef)
 361              )),
 362          E,
 363          expand_failed(E, Read)).
 364
 365set_xref_flag(Value) :-
 366    current_prolog_flag(xref, Value),
 367    !,
 368    set_prolog_flag(xref, true).
 369set_xref_flag(false) :-
 370    create_prolog_flag(xref, true, [type(boolean)]).
 371
 372match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :-
 373    !,
 374    unify_clause_head(H1, H2),
 375    unify_body(B1, B2, Module, Pos0, Pos).
 376match_module((H1 :- B1), H2, _Module, Pos0, Pos) :-
 377    B1 == true,
 378    unify_clause_head(H1, H2),
 379    Pos = Pos0,
 380    !.
 381match_module(H1, H2, _, Pos, Pos) :-    % deal with facts
 382    unify_clause_head(H1, H2).
 383
 384%!  expand_failed(+Exception, +Term)
 385%
 386%   When debugging, indicate that expansion of the term failed.
 387
 388expand_failed(E, Read) :-
 389    debugging(clause_info),
 390    message_to_string(E, Msg),
 391    debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
 392    fail.
 393
 394%!  unify_body(+Read, +Decompiled, +Module, +Pos0, -Pos)
 395%
 396%   Deal with translations implied by the compiler.  For example,
 397%   compiling (a,b),c yields the same code as compiling a,b,c.
 398%
 399%   Pos0 and Pos still include the term-position of the head.
 400
 401unify_body(B, C, _, Pos, Pos) :-
 402    B =@= C, B = C,
 403    does_not_dcg_after_binding(B, Pos),
 404    !.
 405unify_body(R, D, Module,
 406           term_position(F,T,FF,FT,[HP,BP0]),
 407           term_position(F,T,FF,FT,[HP,BP])) :-
 408    ubody(R, D, Module, BP0, BP).
 409
 410%!  does_not_dcg_after_binding(+ReadBody, +ReadPos) is semidet.
 411%
 412%   True  if  ReadPos/ReadPos  does   not    contain   DCG   delayed
 413%   unifications.
 414%
 415%   @tbd    We should pass that we are in a DCG; if we are not there
 416%           is no reason for this test.
 417
 418does_not_dcg_after_binding(B, Pos) :-
 419    \+ sub_term(brace_term_position(_,_,_), Pos),
 420    \+ (sub_term((Cut,_=_), B), Cut == !),
 421    !.
 422
 423
 424/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 425Some remarks.
 426
 427a --> { x, y, z }.
 428    This is translated into "(x,y),z), X=Y" by the DCG translator, after
 429    which the compiler creates "a(X,Y) :- x, y, z, X=Y".
 430- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 431
 432%!  unify_goal(+Read, +Decompiled, +Module,
 433%!             +TermPosRead, -TermPosDecompiled) is semidet.
 434%
 435%   This hook is called to  fix   up  source code manipulations that
 436%   result from goal expansions.
 437
 438%!  ubody(+Read, +Decompiled, +Module, +TermPosRead, -TermPosForDecompiled)
 439%
 440%   @param Read             Clause read _after_ expand_term/2
 441%   @param Decompiled       Decompiled clause
 442%   @param Module           Load module
 443%   @param TermPosRead      Sub-term positions of source
 444
 445ubody(B, DB, _, P, P) :-
 446    var(P),                        % TBD: Create compatible pos term?
 447    !,
 448    B = DB.
 449ubody(B, C, _, P, P) :-
 450    B =@= C, B = C,
 451    does_not_dcg_after_binding(B, P),
 452    !.
 453ubody(X, call(X), _,                    % X = call(X)
 454      Pos,
 455      term_position(From, To, From, To, [Pos])) :-
 456    !,
 457    arg(1, Pos, From),
 458    arg(2, Pos, To).
 459ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :-
 460    nonvar(B), B = M:R,
 461    ubody(R, D, M, RP, TPOut).
 462ubody(B0, B, M,
 463      brace_term_position(F,T,A0),
 464      Pos) :-
 465    B0 = (_,_=_),
 466    !,
 467    T1 is T - 1,
 468    ubody(B0, B, M,
 469          term_position(F,T,
 470                        F,T,
 471                        [A0,T1-T]),
 472          Pos).
 473ubody(B0, B, M,
 474      brace_term_position(F,T,A0),
 475      term_position(F,T,F,T,[A])) :-
 476    !,
 477    ubody(B0, B, M, A0, A).
 478ubody(C0, C, M, P0, P) :-
 479    nonvar(C0), nonvar(C),
 480    C0 = (_,_), C = (_,_),
 481    !,
 482    conj(C0, P0, GL, PL),
 483    mkconj(C, M, P, GL, PL).
 484ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :-
 485    unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled),
 486    !.
 487ubody(X0, X, M,
 488      term_position(F,T,FF,TT,PA0),
 489      term_position(F,T,FF,TT,PA)) :-
 490    meta(M, X0, S),
 491    !,
 492    X0 =.. [_|A0],
 493    X  =.. [_|A],
 494    S =.. [_|AS],
 495    ubody_list(A0, A, AS, M, PA0, PA).
 496ubody(X0, X, M,
 497      term_position(F,T,FF,TT,PA0),
 498      term_position(F,T,FF,TT,PA)) :-
 499    expand_goal(X0, X, M, PA0, PA).
 500
 501                                        % 5.7.X optimizations
 502ubody(_=_, true, _,                     % singleton = Any
 503      term_position(F,T,_FF,_TT,_PA),
 504      F-T) :- !.
 505ubody(_==_, fail, _,                    % singleton/firstvar == Any
 506      term_position(F,T,_FF,_TT,_PA),
 507      F-T) :- !.
 508ubody(A1=B1, B2=A2, _,                  % Term = Var --> Var = Term
 509      term_position(F,T,FF,TT,[PA1,PA2]),
 510      term_position(F,T,FF,TT,[PA2,PA1])) :-
 511    var(B1), var(B2),
 512    (A1==B1) =@= (B2==A2),
 513    !,
 514    A1 = A2, B1=B2.
 515ubody(A1==B1, B2==A2, _,                % const == Var --> Var == const
 516      term_position(F,T,FF,TT,[PA1,PA2]),
 517      term_position(F,T,FF,TT,[PA2,PA1])) :-
 518    var(B1), var(B2),
 519    (A1==B1) =@= (B2==A2),
 520    !,
 521    A1 = A2, B1=B2.
 522ubody(A is B - C, A is B + C2, _, Pos, Pos) :-
 523    integer(C),
 524    C2 =:= -C,
 525    !.
 526
 527ubody_list([], [], [], _, [], []).
 528ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :-
 529    ubody_elem(AS, G0, G, M, PA0, PA),
 530    ubody_list(T0, T, ASL, M, PAT0, PAT).
 531
 532ubody_elem(0, G0, G, M, PA0, PA) :-
 533    !,
 534    ubody(G0, G, M, PA0, PA).
 535ubody_elem(_, G, G, _, PA, PA).
 536
 537conj(Goal, Pos, GoalList, PosList) :-
 538    conj(Goal, Pos, GoalList, [], PosList, []).
 539
 540conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :-
 541    !,
 542    conj(A, PA, GL, TGA, PL, TPA),
 543    conj(B, PB, TGA, TG, TPA, TP).
 544conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
 545    B = (_=_),
 546    !,
 547    conj(A, PA, GL, TGA, PL, TPA),
 548    T1 is T - 1,
 549    conj(B, T1-T, TGA, TG, TPA, TP).
 550conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
 551    F1 is F+1,
 552    T1 is T+1.
 553conj(A, P, [A|TG], TG, [P|TP], TP).
 554
 555
 556mkconj(Goal, M, Pos, GoalList, PosList) :-
 557    mkconj(Goal, M, Pos, GoalList, [], PosList, []).
 558
 559mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
 560    nonvar(Conj),
 561    Conj = (A,B),
 562    !,
 563    mkconj(A, M, PA, GL, TGA, PL, TPA),
 564    mkconj(B, M, PB, TGA, TG, TPA, TP).
 565mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :-
 566    ubody(A, A0, M, P, P0).
 567
 568
 569                 /*******************************
 570                 *    PCE STUFF (SHOULD MOVE)   *
 571                 *******************************/
 572
 573/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 574        <method>(Receiver, ... Arg ...) :->
 575                Body
 576
 577mapped to:
 578
 579        send_implementation(Id, <method>(...Arg...), Receiver)
 580
 581- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 582
 583pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :-
 584    !,
 585    pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos).
 586pce_method_clause(Head, Body,
 587                  send_implementation(_Id, Msg, Receiver), PlBody,
 588                  M, TermPos0, TermPos) :-
 589    !,
 590    debug(clause_info, 'send method ...', []),
 591    arg(1, Head, Receiver),
 592    functor(Head, _, Arity),
 593    pce_method_head_arguments(2, Arity, Head, Msg),
 594    debug(clause_info, 'head ...', []),
 595    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
 596pce_method_clause(Head, Body,
 597                  get_implementation(_Id, Msg, Receiver, Result), PlBody,
 598                  M, TermPos0, TermPos) :-
 599    !,
 600    debug(clause_info, 'get method ...', []),
 601    arg(1, Head, Receiver),
 602    debug(clause_info, 'receiver ...', []),
 603    functor(Head, _, Arity),
 604    arg(Arity, Head, PceResult),
 605    debug(clause_info, '~w?~n', [PceResult = Result]),
 606    pce_unify_head_arg(PceResult, Result),
 607    Ar is Arity - 1,
 608    pce_method_head_arguments(2, Ar, Head, Msg),
 609    debug(clause_info, 'head ...', []),
 610    pce_method_body(Body, PlBody, M, TermPos0, TermPos).
 611
 612pce_method_head_arguments(N, Arity, Head, Msg) :-
 613    N =< Arity,
 614    !,
 615    arg(N, Head, PceArg),
 616    PLN is N - 1,
 617    arg(PLN, Msg, PlArg),
 618    pce_unify_head_arg(PceArg, PlArg),
 619    debug(clause_info, '~w~n', [PceArg = PlArg]),
 620    NextArg is N+1,
 621    pce_method_head_arguments(NextArg, Arity, Head, Msg).
 622pce_method_head_arguments(_, _, _, _).
 623
 624pce_unify_head_arg(V, A) :-
 625    var(V),
 626    !,
 627    V = A.
 628pce_unify_head_arg(A:_=_, A) :- !.
 629pce_unify_head_arg(A:_, A).
 630
 631%       pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos
 632%
 633%       Unify the body of an XPCE method.  Goal-expansion makes this
 634%       rather tricky, especially as we cannot call XPCE's expansion
 635%       on an isolated method.
 636%
 637%       TermPos0 is the term-position term of the whole clause!
 638%
 639%       Further, please note that the body of the method-clauses reside
 640%       in another module than pce_principal, and therefore the body
 641%       starts with an I_CONTEXT call. This implies we need a
 642%       hypothetical term-position for the module-qualifier.
 643
 644pce_method_body(A0, A, M, TermPos0, TermPos) :-
 645    TermPos0 = term_position(F, T, FF, FT,
 646                             [ HeadPos,
 647                               BodyPos0
 648                             ]),
 649    TermPos  = term_position(F, T, FF, FT,
 650                             [ HeadPos,
 651                               term_position(0,0,0,0, [0-0,BodyPos])
 652                             ]),
 653    pce_method_body2(A0, A, M, BodyPos0, BodyPos).
 654
 655
 656pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :-
 657    !,
 658    TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
 659    TermPos  = BodyPos,
 660    expand_goal(A0, A, M, BodyPos0, BodyPos).
 661pce_method_body2(A0, A, M, TermPos0, TermPos) :-
 662    A0 =.. [Func,B0,C0],
 663    control_op(Func),
 664    !,
 665    A =.. [Func,B,C],
 666    TermPos0 = term_position(F, T, FF, FT,
 667                             [ BP0,
 668                               CP0
 669                             ]),
 670    TermPos  = term_position(F, T, FF, FT,
 671                             [ BP,
 672                               CP
 673                             ]),
 674    pce_method_body2(B0, B, M, BP0, BP),
 675    expand_goal(C0, C, M, CP0, CP).
 676pce_method_body2(A0, A, M, TermPos0, TermPos) :-
 677    expand_goal(A0, A, M, TermPos0, TermPos).
 678
 679control_op(',').
 680control_op((;)).
 681control_op((->)).
 682control_op((*->)).
 683
 684                 /*******************************
 685                 *     EXPAND_GOAL SUPPORT      *
 686                 *******************************/
 687
 688/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 689With the introduction of expand_goal, it  is increasingly hard to relate
 690the clause from the database to the actual  source. For one thing, we do
 691not know the compilation  module  of  the   clause  (unless  we  want to
 692decompile it).
 693
 694Goal expansion can translate  goals   into  control-constructs, multiple
 695clauses, or delete a subgoal.
 696
 697To keep track of the source-locations, we   have to redo the analysis of
 698the clause as defined in init.pl
 699- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 700
 701expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :-
 702    var(G),
 703    !.
 704expand_goal(G, G, _, P, P) :-
 705    var(G),
 706    !.
 707expand_goal(M0, M, Module, P0, P) :-
 708    meta(Module, M0, S),
 709    !,
 710    P0 = term_position(F,T,FF,FT,PL0),
 711    P  = term_position(F,T,FF,FT,PL),
 712    functor(M0, Functor, Arity),
 713    functor(M,  Functor, Arity),
 714    expand_meta_args(PL0, PL, 1, S, Module, M0, M).
 715expand_goal(A, B, Module, P0, P) :-
 716    goal_expansion(A, B0, P0, P1),
 717    !,
 718    expand_goal(B0, B, Module, P1, P).
 719expand_goal(A, A, _, P, P).
 720
 721expand_meta_args([],      [],   _,  _, _,      _,  _).
 722expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :-
 723    arg(I, M0, A0),
 724    arg(I, M,  A),
 725    arg(I, S,  AS),
 726    expand_arg(AS, A0, A, Module, P0, P),
 727    NI is I + 1,
 728    expand_meta_args(T0, T, NI, S, Module, M0, M).
 729
 730expand_arg(0, A0, A, Module, P0, P) :-
 731    !,
 732    expand_goal(A0, A, Module, P0, P).
 733expand_arg(_, A, A, _, P, P).
 734
 735meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)).
 736
 737goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
 738    compound(Msg),
 739    Msg =.. [send_super, Selector | Args],
 740    !,
 741    SuperMsg =.. [Selector|Args].
 742goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
 743    compound(Msg),
 744    Msg =.. [get_super, Selector | Args],
 745    !,
 746    SuperMsg =.. [Selector|Args].
 747goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
 748goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
 749goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
 750    compound(SendSuperN),
 751    SendSuperN =.. [send_super, R, Sel | Args],
 752    Msg =.. [Sel|Args].
 753goal_expansion(SendN, send(R, Msg), P, P) :-
 754    compound(SendN),
 755    SendN =.. [send, R, Sel | Args],
 756    atom(Sel), Args \== [],
 757    Msg =.. [Sel|Args].
 758goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
 759    compound(GetSuperN),
 760    GetSuperN =.. [get_super, R, Sel | AllArgs],
 761    append(Args, [Answer], AllArgs),
 762    Msg =.. [Sel|Args].
 763goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
 764    compound(GetN),
 765    GetN =.. [get, R, Sel | AllArgs],
 766    append(Args, [Answer], AllArgs),
 767    atom(Sel), Args \== [],
 768    Msg =.. [Sel|Args].
 769goal_expansion(G0, G, P, P) :-
 770    user:goal_expansion(G0, G),     % TBD: we need the module!
 771    G0 \== G.                       % \=@=?
 772
 773
 774                 /*******************************
 775                 *        INITIALIZATION        *
 776                 *******************************/
 777
 778%!  initialization_layout(+SourceLocation, ?InitGoal,
 779%!                        -ReadGoal, -TermPos) is semidet.
 780%
 781%   Find term-layout of :- initialization directives.
 782
 783initialization_layout(File:Line, M:Goal0, Goal, TermPos) :-
 784    read_term_at_line(File, Line, M, Directive, DirectivePos, _),
 785    Directive    = (:- initialization(ReadGoal)),
 786    DirectivePos = term_position(_, _, _, _, [InitPos]),
 787    InitPos      = term_position(_, _, _, _, [GoalPos]),
 788    (   ReadGoal = M:_
 789    ->  Goal = M:Goal0
 790    ;   Goal = Goal0
 791    ),
 792    unify_body(ReadGoal, Goal, M, GoalPos, TermPos),
 793    !.
 794
 795
 796                 /*******************************
 797                 *        PRINTABLE NAMES       *
 798                 *******************************/
 799
 800:- module_transparent
 801    predicate_name/2.
 802:- multifile
 803    user:prolog_predicate_name/2,
 804    user:prolog_clause_name/2.
 805
 806hidden_module(user).
 807hidden_module(system).
 808hidden_module(pce_principal).           % should be config
 809hidden_module(Module) :-                % SWI-Prolog specific
 810    import_module(Module, system).
 811
 812thaffix(1, st) :- !.
 813thaffix(2, nd) :- !.
 814thaffix(_, th).
 815
 816%!  predicate_name(:Head, -PredName:string) is det.
 817%
 818%   Describe a predicate as [Module:]Name/Arity.
 819
 820predicate_name(Predicate, PName) :-
 821    strip_module(Predicate, Module, Head),
 822    (   user:prolog_predicate_name(Module:Head, PName)
 823    ->  true
 824    ;   functor(Head, Name, Arity),
 825        (   hidden_module(Module)
 826        ->  format(string(PName), '~q/~d', [Name, Arity])
 827        ;   format(string(PName), '~q:~q/~d', [Module, Name, Arity])
 828        )
 829    ).
 830
 831%!  clause_name(+Ref, -Name)
 832%
 833%   Provide a suitable description of the indicated clause.
 834
 835clause_name(Ref, Name) :-
 836    user:prolog_clause_name(Ref, Name),
 837    !.
 838clause_name(Ref, Name) :-
 839    nth_clause(Head, N, Ref),
 840    !,
 841    predicate_name(Head, PredName),
 842    thaffix(N, Th),
 843    format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
 844clause_name(Ref, Name) :-
 845    clause_property(Ref, erased),
 846    !,
 847    clause_property(Ref, predicate(M:PI)),
 848    format(string(Name), 'erased clause from ~q', [M:PI]).
 849clause_name(_, '<meta-call>').