1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 2005-2026, 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 ]). (utf8). 47:- use_module(library(debug),[debugging/1,debug/3]). 48:- autoload(library(listing),[portray_clause/1]). 49:- autoload(library(lists),[append/3]). 50:- autoload(library(occurs),[sub_term/2]). 51:- autoload(library(option),[option/3]). 52:- autoload(library(prolog_source),[read_source_term_at_location/3]). 53 54 55:- public % called from library(trace/clause) 56 unify_term/2, 57 make_varnames/5, 58 do_make_varnames/3. 59 60:- multifile 61 unify_goal/5, % +Read, +Decomp, +M, +Pos, -Pos 62 unify_clause_hook/5, 63 make_varnames_hook/5, 64 open_source/2. % +Input, -Stream 65 66:- predicate_options(prolog_clause:clause_info/5, 5, 67 [ head(-any), 68 body(-any), 69 variable_names(-list) 70 ]).
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:
110clause_info(ClauseRef, File, TermPos, NameOffset) :- 111 clause_info(ClauseRef, File, TermPos, NameOffset, []). 112 113clause_info(ClauseRef, File, TermPos, NameOffset, Options) :- 114 ( debugging(clause_info) 115 -> clause_name(ClauseRef, Name), 116 debug(clause_info, 'clause_info(~w) (~w)... ', 117 [ClauseRef, Name]) 118 ; true 119 ), 120 clause_property(ClauseRef, file(File)), 121 File \== user, % loaded using ?- [user]. 122 '$clause'(Head0, Body, ClauseRef, VarOffset), 123 option(head(Head0), Options, _), 124 option(body(Body), Options, _), 125 ( module_property(Module, file(File)) 126 -> true 127 ; strip_module(user:Head0, Module, _) 128 ), 129 unqualify(Head0, Module, Head), 130 ( Body == true 131 -> DecompiledClause = Head 132 ; DecompiledClause = (Head :- Body) 133 ), 134 clause_property(ClauseRef, line_count(LineNo)), 135 debug(clause_info, 'from ~w:~d ... ', [File, LineNo]), 136 read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames), 137 option(variable_names(VarNames), Options, _), 138 debug(clause_info, 'read ...', []), 139 unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos), 140 debug(clause_info, 'unified ...', []), 141 make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset), 142 debug(clause_info, 'got names~n', []), 143 !. 144 145unqualify(Module:Head, Module, Head) :- 146 !. 147unqualify(Head, _, Head).
NOTE: Called directly from library(trace/clause) for the GUI
tracer.
161unify_term(X, X) :- !. 162unify_term(X1, X2) :- 163 compound(X1), 164 compound(X2), 165 compound_name_arity(X1, F, Arity), 166 compound_name_arity(X2, F, Arity), 167 !, 168 unify_args(0, Arity, X1, X2). 169unify_term(X, Y) :- 170 number(X), number(Y), 171 X =:= Y, 172 !. 173unify_term(X, Y) :- 174 float(X), float(Y), 175 !. 176unify_term(X, '$BLOB'(_)) :- 177 blob(X, _), 178 \+ atom(X). 179unify_term(X, Y) :- 180 string(X), 181 is_list(Y), 182 string_codes(X, Y), 183 !. 184unify_term(_, Y) :- 185 Y == '...', 186 !. % elipses left by max_depth 187unify_term(_, Y) :- 188 Y == '…', 189 !. % Unicode elipses left by max_depth 190unify_term(_:X, Y) :- 191 unify_term(X, Y), 192 !. 193unify_term(X, _:Y) :- 194 unify_term(X, Y), 195 !. 196unify_term(X, Y) :- 197 format('[INTERNAL ERROR: Diff:~n'), 198 portray_clause(X), 199 format('~N*** <->~n'), 200 portray_clause(Y), 201 break. 202 203unify_args(N, N, _, _) :- !. 204unify_args(I, Arity, T1, T2) :- 205 A is I + 1, 206 arg(A, T1, A1), 207 arg(A, T2, A2), 208 unify_term(A1, A2), 209 unify_args(A, Arity, T1, T2).
217read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :- 218 setup_call_cleanup( 219 '$push_input_context'(clause_info), 220 read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames), 221 '$pop_input_context'). 222 223read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :- 224 catch(try_open_source(File, In), error(_,_), fail), 225 set_stream(In, newline(detect)), 226 call_cleanup( 227 read_source_term_at_location( 228 In, Clause, 229 [ line(Line), 230 module(Module), 231 subterm_positions(TermPos), 232 variable_names(VarNames) 233 ]), 234 close(In)).
clause_property(ClauseRef, file(File)), prolog_clause:open_source(File, Stream)
247:- public try_open_source/2. % used by library(prolog_breakpoints). 248 249try_open_source(File, In) :- 250 open_source(File, In), 251 !. 252try_open_source(File, In) :- 253 open(File, read, In, [reposition(true)]).
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.
272make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :- 273 make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term), 274 !. 275make_varnames(ReadClause, _, Offsets, Names, Bindings) :- 276 dcg_head(ReadClause, Head), 277 !, 278 functor(Head, _, Arity), 279 In is Arity, 280 memberchk(In=IVar, Offsets), 281 Names1 = ['<DCG_list>'=IVar|Names], 282 Out is Arity + 1, 283 memberchk(Out=OVar, Offsets), 284 Names2 = ['<DCG_tail>'=OVar|Names1], 285 make_varnames(xx, xx, Offsets, Names2, Bindings). 286make_varnames(_, _, Offsets, Names, Bindings) :- 287 length(Offsets, L), 288 functor(Bindings, varnames, L), 289 do_make_varnames(Offsets, Names, Bindings). 290 291dcg_head((Head,_ --> _Body), Head). 292dcg_head((Head --> _Body), Head). 293dcg_head((Head,_ ==> _Body), Head). 294dcg_head((Head ==> _Body), Head). 295 296do_make_varnames([], _, _). 297do_make_varnames([N=Var|TO], Names, Bindings) :- 298 ( find_varname(Var, Names, Name) 299 -> true 300 ; Name = '_' 301 ), 302 AN is N + 1, 303 arg(AN, Bindings, Name), 304 do_make_varnames(TO, Names, Bindings). 305 306find_varname(Var, [Name = TheVar|_], Name) :- 307 Var == TheVar, 308 !. 309find_varname(Var, [_|T], Name) :- 310 find_varname(Var, T, Name).
This predicate calls the multifile predicate unify_clause_hook/5 with the same arguments to support user extensions.
333unify_clause(Read, _, _, _, _) :- 334 var(Read), 335 !, 336 fail. 337unify_clause((RHead :- RBody), (CHead :- CBody), Module, TermPos1, TermPos) :- 338 '$expand':f2_pos(TermPos1, HPos, BPos1, 339 TermPos2, HPos, BPos2), 340 inlined_unification(RBody, CBody, RBody1, CBody1, RHead, 341 BPos1, BPos2), 342 RBody1 \== RBody, 343 !, 344 unify_clause2((RHead :- RBody1), (CHead :- CBody1), Module, 345 TermPos2, TermPos). 346unify_clause(Read, Decompiled, _, TermPos, TermPos) :- 347 Read =@= Decompiled, 348 !, 349 Read = Decompiled. 350unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :- 351 unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos), 352 !. 353 % XPCE send-methods 354unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :- 355 !, 356 pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos). 357 % XPCE get-methods 358unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :- 359 !, 360 pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos). 361 % Unit test clauses 362unify_clause((TH :- RBody), (CH :- !, CBody), Module, TP0, TP) :- 363 plunit_source_head(TH), 364 plunit_compiled_head(CH), 365 !, 366 TP0 = term_position(F,T,FF,FT,[HP,BP0]), 367 ubody(RBody, CBody, Module, BP0, BP), 368 TP = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]). 369 % module:head :- body 370unify_clause((Head :- Read), 371 (Head :- _M:Compiled), Module, TermPos0, TermPos) :- 372 unify_clause2((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1), 373 TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]), 374 TermPos = term_position(TA,TZ,FA,FZ, 375 [ PH, 376 term_position(0,0,0,0,[0-0,PB]) 377 ]). 378 % DCG rules 379unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :- 380 Read = (_ --> Terminal0, _), 381 ( is_list(Terminal0) 382 -> Terminal = Terminal0 383 ; string(Terminal0) 384 -> string_codes(Terminal0, Terminal) 385 ), 386 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 387 ( dcg_unify_in_head(Compiled2, Compiled3) 388 -> true 389 ; Compiled2 = (DH :- _CBody), 390 functor(DH, _, Arity), 391 DArg is Arity - 1, 392 append(Terminal, _Tail, List), 393 arg(DArg, DH, List), 394 Compiled3 = Compiled2 395 ), 396 TermPos1 = term_position(F,T,FF,FT,[ HP, 397 term_position(_,_,_,_,[_,BP]) 398 ]), 399 !, 400 TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]), 401 match_module(Compiled3, Compiled1, Module, TermPos2, TermPos). 402 % SSU rules 403unify_clause((Head,RCond => Body), (CHead :- CCondAndBody), Module, 404 term_position(F,T,FF,FT, 405 [ term_position(_,_,_,_,[HP,CP]), 406 BP 407 ]), 408 TermPos) :- 409 split_on_cut(CCondAndBody, CCond, CBody0), 410 !, 411 inlined_unification(RCond, CCond, RCond1, CCond1, Head, CP, CP1), 412 TermPos1 = term_position(F,T,FF,FT, [HP, BP1]), 413 BP2 = term_position(_,_,_,_, [FF-FT, BP]), % Represent (!, Body), placing 414 ( CCond1 == true % ! at => 415 -> BP1 = BP2, % Whole guard is inlined 416 unify_clause2((Head :- !, Body), (CHead :- !, CBody0), 417 Module, TermPos1, TermPos) 418 ; mkconj_pos(RCond1, CP1, (!,Body), BP2, RBody, BP1), 419 mkconj_npos(CCond1, (!,CBody0), CBody), 420 unify_clause2((Head :- RBody), (CHead :- CBody), 421 Module, TermPos1, TermPos) 422 ). 423unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :- 424 !, 425 unify_clause2((Head :- Body), Compiled1, Module, TermPos0, TermPos). 426unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :- 427 Read = (_ ==> _), 428 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 429 Compiled2 \= (_ ==> _), 430 !, 431 unify_clause(Compiled2, Compiled1, Module, TermPos1, TermPos). 432unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :- 433 unify_clause2(Read, Decompiled, Module, TermPos0, TermPos). 434 435dcg_unify_in_head((Head :- L1=L2, Body), (Head :- Body)) :- 436 functor(Head, _, Arity), 437 DArg is Arity - 1, 438 arg(DArg, Head, L0), 439 L0 == L1, 440 L1 = L2. 441 442% mkconj, but also unify position info 443mkconj_pos((A,B), term_position(F,T,FF,FT,[PA,PB]), Ex, ExPos, Code, Pos) => 444 Code = (A,B1), 445 Pos = term_position(F,T,FF,FT,[PA,PB1]), 446 mkconj_pos(B, PB, Ex, ExPos, B1, PB1). 447mkconj_pos(Last, LastPos, Ex, ExPos, Code, Pos) => 448 Code = (Last,Ex), 449 Pos = term_position(_,_,_,_,[LastPos,ExPos]). 450 451% similar to mkconj, but we should __not__ optimize `true` away. 452mkconj_npos((A,B), Ex, Code) => 453 Code = (A,B1), 454 mkconj_npos(B, Ex, B1). 455mkconj_npos(A, Ex, Code) => 456 Code = (A,Ex).
462unify_clause2(Read, Decompiled, _, TermPos, TermPos) :- 463 Read =@= Decompiled, 464 !, 465 Read = Decompiled. 466unify_clause2(Read, Compiled1, Module, TermPos0, TermPos) :- 467 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 468 match_module(Compiled2, Compiled1, Module, TermPos1, TermPos), 469 !. 470unify_clause2(_, _, _, _, _) :- % I don't know ... 471 debug(clause_info, 'Could not unify clause', []), 472 fail. 473 474unify_clause_head(H1, H2) :- 475 strip_module(H1, _, H), 476 strip_module(H2, _, H). 477 478plunit_source_head(test(_,_)) => true. 479plunit_source_head(test(_)) => true. 480plunit_source_head(_) => fail. 481 482plunit_compiled_head(_:'unit body'(_, _)) => true. 483plunit_compiled_head('unit body'(_, _)) => true. 484plunit_compiled_head(_) => fail.
491inlined_unification((V=T,RBody0), (CV=CT,CBody0), 492 RBody, CBody, RHead, BPos1, BPos), 493 inlineable_head_var(RHead, V2), 494 V == V2, 495 (V=T) =@= (CV=CT) => 496 argpos(2, BPos1, BPos2), 497 inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos). 498inlined_unification((V=T), (CV=CT), 499 RBody, CBody, RHead, BPos1, BPos), 500 inlineable_head_var(RHead, V2), 501 V == V2, 502 (V=T) =@= (CV=CT) => 503 RBody = true, 504 CBody = true, 505 argpos(2, BPos1, BPos). 506inlined_unification((V=T,RBody0), CBody0, 507 RBody, CBody, RHead, BPos1, BPos), 508 inlineable_head_var(RHead, V2), 509 V == V2, 510 \+ (CBody0 = (G1,_), G1 =@= (V=T)) => 511 argpos(2, BPos1, BPos2), 512 inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos). 513inlined_unification((V=_), true, 514 RBody, CBody, RHead, BPos1, BPos), 515 inlineable_head_var(RHead, V2), 516 V == V2 => 517 RBody = true, 518 CBody = true, 519 argpos(2, BPos1, BPos). 520inlined_unification(RBody0, CBody0, RBody, CBody, _RHead, 521 BPos0, BPos) => 522 RBody = RBody0, 523 BPos = BPos0, 524 CBody = CBody0.
531inlineable_head_var(Head, Var) :- 532 compound(Head), 533 arg(_, Head, Var). 534 535split_on_cut((Cond0,!,Body0), Cond, Body) => 536 Cond = Cond0, 537 Body = Body0. 538split_on_cut((!,Body0), Cond, Body) => 539 Cond = true, 540 Body = Body0. 541split_on_cut((A,B), Cond, Body) => 542 Cond = (A,Cond1), 543 split_on_cut(B, Cond1, Body). 544split_on_cut(_, _, _) => 545 fail. 546 547ci_expand(Read, Compiled, Module, TermPos0, TermPos) :- 548 catch(setup_call_cleanup( 549 ( set_xref_flag(OldXRef), 550 '$set_source_module'(Old, Module) 551 ), 552 expand_term(Read, TermPos0, Compiled, TermPos), 553 ( '$set_source_module'(Old), 554 set_prolog_flag(xref, OldXRef) 555 )), 556 E, 557 expand_failed(E, Read)), 558 compound(TermPos), % make sure somthing is filled. 559 arg(1, TermPos, A1), nonvar(A1), 560 arg(2, TermPos, A2), nonvar(A2). 561 562set_xref_flag(Value) :- 563 current_prolog_flag(xref, Value), 564 !, 565 set_prolog_flag(xref, true). 566set_xref_flag(false) :- 567 create_prolog_flag(xref, true, [type(boolean)]). 568 569match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :- 570 !, 571 unify_clause_head(H1, H2), 572 unify_body(B1, B2, Module, Pos0, Pos). 573match_module((H1 :- B1), H2, _Module, Pos0, Pos) :- 574 B1 == true, 575 unify_clause_head(H1, H2), 576 Pos = Pos0, 577 !. 578match_module(H1, H2, _, Pos, Pos) :- % deal with facts 579 unify_clause_head(H1, H2).
585expand_failed(E, Read) :-
586 debugging(clause_info),
587 message_to_string(E, Msg),
588 debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
589 fail.Pos0 and Pos still include the term-position of the head.
598unify_body(B, C, _, Pos, Pos) :- 599 B =@= C, B = C, 600 does_not_dcg_after_binding(B, Pos), 601 !. 602unify_body(R, D, Module, 603 term_position(F,T,FF,FT,[HP,BP0]), 604 term_position(F,T,FF,FT,[HP,BP])) :- 605 ubody(R, D, Module, BP0, BP).
615does_not_dcg_after_binding(B, Pos) :- 616 \+ sub_term(brace_term_position(_,_,_), Pos), 617 \+ (sub_term((Cut,_=_), B), Cut == !), 618 !. 619 620 621/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 622Some remarks. 623 624a --> { x, y, z }. 625 This is translated into "(x,y),z), X=Y" by the DCG translator, after 626 which the compiler creates "a(X,Y) :- x, y, z, X=Y". 627- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
642ubody(B, DB, _, P, P) :- 643 var(P), % TBD: Create compatible pos term? 644 !, 645 B = DB. 646ubody(B, C, _, P, P) :- 647 B =@= C, B = C, 648 does_not_dcg_after_binding(B, P), 649 !. 650ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :- 651 !, 652 ubody(X0, X, M, P0, P). 653ubody(X, Y, _, % X = call(X) 654 Pos, 655 term_position(From, To, From, To, [Pos])) :- 656 nonvar(Y), 657 Y = call(X), 658 !, 659 arg(1, Pos, From), 660 arg(2, Pos, To). 661ubody(A, B, _, P1, P2) :- 662 nonvar(A), A = (_=_), 663 nonvar(B), B = (LB=RB), 664 A =@= (RB=LB), 665 !, 666 P1 = term_position(F,T, FF,FT, [PL,PR]), 667 P2 = term_position(F,T, FF,FT, [PR,PL]). 668ubody(A, B, _, P1, P2) :- 669 nonvar(A), A = (_==_), 670 nonvar(B), B = (LB==RB), 671 A =@= (RB==LB), 672 !, 673 P1 = term_position(F,T, FF,FT, [PL,PR]), 674 P2 = term_position(F,T, FF,FT, [PR,PL]). 675ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :- 676 nonvar(B), B = M:R, 677 ubody(R, D, M, RP, TPOut). 678ubody(B, D, M, term_position(_,_,_,_,[RP0,RP1]), TPOut) :- 679 nonvar(B), B = (B0,B1), 680 ( maybe_optimized(B0), 681 ubody(B1, D, M, RP1, TPOut) 682 -> true 683 ; maybe_optimized(B1), 684 ubody(B0, D, M, RP0, TPOut) 685 ), 686 !. 687ubody(B0, B, M, 688 brace_term_position(F,T,A0), 689 Pos) :- 690 B0 = (_,_=_), 691 !, 692 T1 is T - 1, 693 ubody(B0, B, M, 694 term_position(F,T, 695 F,T, 696 [A0,T1-T]), 697 Pos). 698ubody(B0, B, M, 699 brace_term_position(F,T,A0), 700 term_position(F,T,F,T,[A])) :- 701 !, 702 ubody(B0, B, M, A0, A). 703ubody(C0, C, M, P0, P) :- 704 nonvar(C0), nonvar(C), 705 C0 = (_,_), C = (_,_), 706 !, 707 conj(C0, P0, GL, PL), 708 mkconj(C, M, P, GL, PL). 709ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :- 710 unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled), 711 !. 712ubody(X0, X, M, 713 term_position(F,T,FF,TT,PA0), 714 term_position(F,T,FF,TT,PA)) :- 715 callable(X0), 716 callable(X), 717 meta(M, X0, S), 718 !, 719 X0 =.. [_|A0], 720 X =.. [_|A], 721 S =.. [_|AS], 722 ubody_list(A0, A, AS, M, PA0, PA). 723ubody(X0, X, M, 724 term_position(F,T,FF,TT,PA0), 725 term_position(F,T,FF,TT,PA)) :- 726 expand_goal(X0, X1, M, PA0, PA), 727 X1 =@= X, 728 X1 = X. 729 730 % 5.7.X optimizations 731ubody(_=_, true, _, % singleton = Any 732 term_position(F,T,_FF,_TT,_PA), 733 F-T) :- !. 734ubody(_==_, fail, _, % singleton/firstvar == Any 735 term_position(F,T,_FF,_TT,_PA), 736 F-T) :- !. 737ubody(A1=B1, B2=A2, _, % Term = Var --> Var = Term 738 term_position(F,T,FF,TT,[PA1,PA2]), 739 term_position(F,T,FF,TT,[PA2,PA1])) :- 740 var(B1), var(B2), 741 (A1==B1) =@= (B2==A2), 742 !, 743 A1 = A2, B1=B2. 744ubody(A1==B1, B2==A2, _, % const == Var --> Var == const 745 term_position(F,T,FF,TT,[PA1,PA2]), 746 term_position(F,T,FF,TT,[PA2,PA1])) :- 747 var(B1), var(B2), 748 (A1==B1) =@= (B2==A2), 749 !, 750 A1 = A2, B1=B2. 751ubody(A is B - C, A is B + C2, _, Pos, Pos) :- 752 integer(C), 753 C2 =:= -C, 754 !. 755 756ubody_list([], [], [], _, [], []). 757ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :- 758 ubody_elem(AS, G0, G, M, PA0, PA), 759 ubody_list(T0, T, ASL, M, PAT0, PAT). 760 761ubody_elem(0, G0, G, M, PA0, PA) :- 762 !, 763 ubody(G0, G, M, PA0, PA). 764ubody_elem(_, G, G, _, PA, PA).
771conj(Goal, Pos, GoalList, PosList) :- 772 conj(Goal, Pos, GoalList, [], PosList, []). 773 774conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :- 775 !, 776 conj(A, PA, GL, TGA, PL, TPA), 777 conj(B, PB, TGA, TG, TPA, TP). 778conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :- 779 B = (_=_), 780 !, 781 conj(A, PA, GL, TGA, PL, TPA), 782 T1 is T - 1, 783 conj(B, T1-T, TGA, TG, TPA, TP). 784conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :- 785 nonvar(Pos), 786 !, 787 conj(A, Pos, GL, TG, PL, TP). 788conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :- 789 F1 is F+1, 790 T1 is T+1. 791conj(A, P, [A|TG], TG, [P|TP], TP).
796mkconj(Goal, M, Pos, GoalList, PosList) :- 797 mkconj(Goal, M, Pos, GoalList, [], PosList, []). 798 799mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :- 800 nonvar(Conj), 801 Conj = (A,B), 802 !, 803 mkconj(A, M, PA, GL, TGA, PL, TPA), 804 mkconj(B, M, PB, TGA, TG, TPA, TP). 805mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :- 806 ubody(A, A0, M, P, P0), 807 !. 808mkconj(A0, M, P0, [RG|TG0], TG, [_|TP0], TP) :- 809 maybe_optimized(RG), 810 mkconj(A0, M, P0, TG0, TG, TP0, TP). 811 812maybe_optimized(debug(_,_,_)). 813maybe_optimized(assertion(_)). 814maybe_optimized(true).
820argpos(N, parentheses_term_position(_,_,PosIn), Pos) => 821 argpos(N, PosIn, Pos). 822argpos(N, term_position(_,_,_,_,ArgPos), Pos) => 823 nth1(N, ArgPos, Pos). 824argpos(_, _, _) => true. 825 826 827 /******************************* 828 * PCE STUFF (SHOULD MOVE) * 829 *******************************/ 830 831/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 832 <method>(Receiver, ... Arg ...) :-> 833 Body 834 835mapped to: 836 837 send_implementation(Id, <method>(...Arg...), Receiver) 838 839- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 840 841pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :- 842 !, 843 pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos). 844pce_method_clause(Head, Body, 845 send_implementation(_Id, Msg, Receiver), PlBody, 846 M, TermPos0, TermPos) :- 847 !, 848 debug(clause_info, 'send method ...', []), 849 arg(1, Head, Receiver), 850 functor(Head, _, Arity), 851 pce_method_head_arguments(2, Arity, Head, Msg), 852 debug(clause_info, 'head ...', []), 853 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 854pce_method_clause(Head, Body, 855 get_implementation(_Id, Msg, Receiver, Result), PlBody, 856 M, TermPos0, TermPos) :- 857 !, 858 debug(clause_info, 'get method ...', []), 859 arg(1, Head, Receiver), 860 debug(clause_info, 'receiver ...', []), 861 functor(Head, _, Arity), 862 arg(Arity, Head, PceResult), 863 debug(clause_info, '~w?~n', [PceResult = Result]), 864 pce_unify_head_arg(PceResult, Result), 865 Ar is Arity - 1, 866 pce_method_head_arguments(2, Ar, Head, Msg), 867 debug(clause_info, 'head ...', []), 868 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 869 870pce_method_head_arguments(N, Arity, Head, Msg) :- 871 N =< Arity, 872 !, 873 arg(N, Head, PceArg), 874 PLN is N - 1, 875 arg(PLN, Msg, PlArg), 876 pce_unify_head_arg(PceArg, PlArg), 877 debug(clause_info, '~w~n', [PceArg = PlArg]), 878 NextArg is N+1, 879 pce_method_head_arguments(NextArg, Arity, Head, Msg). 880pce_method_head_arguments(_, _, _, _). 881 882pce_unify_head_arg(V, A) :- 883 var(V), 884 !, 885 V = A. 886pce_unify_head_arg(A:_=_, A) :- !. 887pce_unify_head_arg(A:_, A). 888 889% pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos 890% 891% Unify the body of an XPCE method. Goal-expansion makes this 892% rather tricky, especially as we cannot call XPCE's expansion 893% on an isolated method. 894% 895% TermPos0 is the term-position term of the whole clause! 896% 897% Further, please note that the body of the method-clauses reside 898% in another module than pce_principal, and therefore the body 899% starts with an I_CONTEXT call. This implies we need a 900% hypothetical term-position for the module-qualifier. 901 902pce_method_body(A0, A, M, TermPos0, TermPos) :- 903 TermPos0 = term_position(F, T, FF, FT, 904 [ HeadPos, 905 BodyPos0 906 ]), 907 TermPos = term_position(F, T, FF, FT, 908 [ HeadPos, 909 term_position(0,0,0,0, [0-0,BodyPos]) 910 ]), 911 pce_method_body2(A0, A, M, BodyPos0, BodyPos). 912 913 914pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :- 915 !, 916 TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]), 917 TermPos = BodyPos, 918 expand_goal(A0, A, M, BodyPos0, BodyPos). 919pce_method_body2(A0, A, M, TermPos0, TermPos) :- 920 A0 =.. [Func,B0,C0], 921 control_op(Func), 922 !, 923 A =.. [Func,B,C], 924 TermPos0 = term_position(F, T, FF, FT, 925 [ BP0, 926 CP0 927 ]), 928 TermPos = term_position(F, T, FF, FT, 929 [ BP, 930 CP 931 ]), 932 pce_method_body2(B0, B, M, BP0, BP), 933 expand_goal(C0, C, M, CP0, CP). 934pce_method_body2(A0, A, M, TermPos0, TermPos) :- 935 expand_goal(A0, A, M, TermPos0, TermPos). 936 937control_op(','). 938control_op((;)). 939control_op((->)). 940control_op((*->)). 941 942 /******************************* 943 * EXPAND_GOAL SUPPORT * 944 *******************************/ 945 946/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 947With the introduction of expand_goal, it is increasingly hard to relate 948the clause from the database to the actual source. For one thing, we do 949not know the compilation module of the clause (unless we want to 950decompile it). 951 952Goal expansion can translate goals into control-constructs, multiple 953clauses, or delete a subgoal. 954 955To keep track of the source-locations, we have to redo the analysis of 956the clause as defined in init.pl 957- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 958 959expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :- 960 var(G), 961 !. 962expand_goal(G, G1, _, P, P) :- 963 var(G), 964 !, 965 G1 = G. 966expand_goal(M0, M, Module, P0, P) :- 967 meta(Module, M0, S), 968 !, 969 P0 = term_position(F,T,FF,FT,PL0), 970 P = term_position(F,T,FF,FT,PL), 971 functor(M0, Functor, Arity), 972 functor(M, Functor, Arity), 973 expand_meta_args(PL0, PL, 1, S, Module, M0, M). 974expand_goal(A, B, Module, P0, P) :- 975 goal_expansion(A, B0, P0, P1), 976 !, 977 expand_goal(B0, B, Module, P1, P). 978expand_goal(A, A, _, P, P). 979 980expand_meta_args([], [], _, _, _, _, _). 981expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :- 982 arg(I, M0, A0), 983 arg(I, M, A), 984 arg(I, S, AS), 985 expand_arg(AS, A0, A, Module, P0, P), 986 NI is I + 1, 987 expand_meta_args(T0, T, NI, S, Module, M0, M). 988 989expand_arg(0, A0, A, Module, P0, P) :- 990 !, 991 expand_goal(A0, A, Module, P0, P). 992expand_arg(_, A, A, _, P, P). 993 994meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)). 995 996goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :- 997 compound(Msg), 998 Msg =.. [send_super, Selector | Args], 999 !, 1000 SuperMsg =.. [Selector|Args]. 1001goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :- 1002 compound(Msg), 1003 Msg =.. [get_super, Selector | Args], 1004 !, 1005 SuperMsg =.. [Selector|Args]. 1006goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P). 1007goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P). 1008goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :- 1009 compound(SendSuperN), 1010 compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]), 1011 Msg =.. [Sel|Args]. 1012goal_expansion(SendN, send(R, Msg), P, P) :- 1013 compound(SendN), 1014 compound_name_arguments(SendN, send, [R,Sel|Args]), 1015 atom(Sel), Args \== [], 1016 Msg =.. [Sel|Args]. 1017goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :- 1018 compound(GetSuperN), 1019 compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]), 1020 append(Args, [Answer], AllArgs), 1021 Msg =.. [Sel|Args]. 1022goal_expansion(GetN, get(R, Msg, Answer), P, P) :- 1023 compound(GetN), 1024 compound_name_arguments(GetN, get, [R,Sel|AllArgs]), 1025 append(Args, [Answer], AllArgs), 1026 atom(Sel), Args \== [], 1027 Msg =.. [Sel|Args]. 1028goal_expansion(G0, G, P, P) :- 1029 user:goal_expansion(G0, G), % TBD: we need the module! 1030 G0 \== G. % \=@=? 1031 1032 1033 /******************************* 1034 * INITIALIZATION * 1035 *******************************/
1042initialization_layout(File:Line, M:Goal0, Goal, TermPos) :- 1043 read_term_at_line(File, Line, M, Directive, DirectivePos, _), 1044 Directive = (:- initialization(ReadGoal)), 1045 DirectivePos = term_position(_, _, _, _, [InitPos]), 1046 InitPos = term_position(_, _, _, _, [GoalPos]), 1047 ( ReadGoal = M:_ 1048 -> Goal = M:Goal0 1049 ; Goal = Goal0 1050 ), 1051 unify_body(ReadGoal, Goal, M, GoalPos, TermPos), 1052 !. 1053 1054 1055 /******************************* 1056 * PRINTABLE NAMES * 1057 *******************************/ 1058 1059:- module_transparent 1060 predicate_name/2. 1061:- multifile 1062 user:prolog_predicate_name/2, 1063 user:prolog_clause_name/2. 1064 (user). 1066hidden_module(system). 1067hidden_module(pce_principal). % should be config 1068hidden_module(Module) :- % SWI-Prolog specific 1069 import_module(Module, system). 1070 1071thaffix(1, st) :- !. 1072thaffix(2, nd) :- !. 1073thaffix(_, th).
1079predicate_name(Predicate, PName) :-
1080 strip_module(Predicate, Module, Head),
1081 ( user:prolog_predicate_name(Module:Head, PName)
1082 -> true
1083 ; functor(Head, Name, Arity),
1084 ( hidden_module(Module)
1085 -> format(string(PName), '~q/~d', [Name, Arity])
1086 ; format(string(PName), '~q:~q/~d', [Module, Name, Arity])
1087 )
1088 ).1094clause_name(Ref, Name) :- 1095 user:prolog_clause_name(Ref, Name), 1096 !. 1097clause_name(Ref, Name) :- 1098 nth_clause(Head, N, Ref), 1099 !, 1100 predicate_name(Head, PredName), 1101 thaffix(N, Th), 1102 format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]). 1103clause_name(Ref, Name) :- 1104 clause_property(Ref, erased), 1105 !, 1106 clause_property(Ref, predicate(M:PI)), 1107 format(string(Name), 'erased clause from ~q', [M:PI]). 1108clause_name(_, '<meta-call>')
Get detailed source-information about a clause
This module started life as part of the GUI tracer. As it is generally useful for debugging purposes it has moved to the general Prolog library.
The tracer library
library(trace/clause)adds caching and dealing with dynamic predicates using listing to XPCE objects to this. Note that clause_info/4 as below can be slow.