1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2005-2023, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module(prolog_clause, 39 [ clause_info/4, % +ClauseRef, -File, -TermPos, -VarNames 40 clause_info/5, % +ClauseRef, -File, -TermPos, -VarNames, 41 % +Options 42 initialization_layout/4, % +SourceLoc, +Goal, -Term, -TermPos 43 predicate_name/2, % +Head, -Name 44 clause_name/2 % +ClauseRef, -Name 45 ]). 46:- use_module(library(debug),[debugging/1,debug/3]). 47:- autoload(library(listing),[portray_clause/1]). 48:- autoload(library(lists),[append/3]). 49:- autoload(library(occurs),[sub_term/2]). 50:- autoload(library(option),[option/3]). 51:- autoload(library(prolog_source),[read_source_term_at_location/3]). 52 53 54:- public % called from library(trace/clause) 55 unify_term/2, 56 make_varnames/5, 57 do_make_varnames/3. 58 59:- multifile 60 unify_goal/5, % +Read, +Decomp, +M, +Pos, -Pos 61 unify_clause_hook/5, 62 make_varnames_hook/5, 63 open_source/2. % +Input, -Stream 64 65:- predicate_options(prolog_clause:clause_info/5, 5, 66 [ head(-any), 67 body(-any), 68 variable_names(-list) 69 ]).
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:
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).
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).
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)).
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)]).
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.
264make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :- 265 make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term), 266 !. 267make_varnames((Head --> _Body), _, Offsets, Names, Bindings) :- 268 !, 269 functor(Head, _, Arity), 270 In is Arity, 271 memberchk(In=IVar, Offsets), 272 Names1 = ['<DCG_list>'=IVar|Names], 273 Out is Arity + 1, 274 memberchk(Out=OVar, Offsets), 275 Names2 = ['<DCG_tail>'=OVar|Names1], 276 make_varnames(xx, xx, Offsets, Names2, Bindings). 277make_varnames(_, _, Offsets, Names, Bindings) :- 278 length(Offsets, L), 279 functor(Bindings, varnames, L), 280 do_make_varnames(Offsets, Names, Bindings). 281 282do_make_varnames([], _, _). 283do_make_varnames([N=Var|TO], Names, Bindings) :- 284 ( find_varname(Var, Names, Name) 285 -> true 286 ; Name = '_' 287 ), 288 AN is N + 1, 289 arg(AN, Bindings, Name), 290 do_make_varnames(TO, Names, Bindings). 291 292find_varname(Var, [Name = TheVar|_], Name) :- 293 Var == TheVar, 294 !. 295find_varname(Var, [_|T], Name) :- 296 find_varname(Var, T, Name).
This predicate calls the multifile predicate unify_clause_hook/5 with the same arguments to support user extensions.
319unify_clause(Read, _, _, _, _) :- 320 var(Read), 321 !, 322 fail. 323unify_clause((RHead :- RBody), (CHead :- CBody), Module, TermPos1, TermPos) :- 324 '$expand':f2_pos(TermPos1, HPos, BPos1, 325 TermPos2, HPos, BPos2), 326 inlined_unification(RBody, CBody, RBody1, CBody1, RHead, 327 BPos1, BPos2), 328 RBody1 \== RBody, 329 !, 330 unify_clause2((RHead :- RBody1), (CHead :- CBody1), Module, 331 TermPos2, TermPos). 332unify_clause(Read, Decompiled, _, TermPos, TermPos) :- 333 Read =@= Decompiled, 334 !, 335 Read = Decompiled. 336unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :- 337 unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos), 338 !. 339 % XPCE send-methods 340unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :- 341 !, 342 pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos). 343 % XPCE get-methods 344unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :- 345 !, 346 pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos). 347 % Unit test clauses 348unify_clause((TH :- RBody), (CH :- !, CBody), Module, TP0, TP) :- 349 plunit_source_head(TH), 350 plunit_compiled_head(CH), 351 !, 352 TP0 = term_position(F,T,FF,FT,[HP,BP0]), 353 ubody(RBody, CBody, Module, BP0, BP), 354 TP = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]). 355 % module:head :- body 356unify_clause((Head :- Read), 357 (Head :- _M:Compiled), Module, TermPos0, TermPos) :- 358 unify_clause2((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1), 359 TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]), 360 TermPos = term_position(TA,TZ,FA,FZ, 361 [ PH, 362 term_position(0,0,0,0,[0-0,PB]) 363 ]). 364 % DCG rules 365unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :- 366 Read = (_ --> Terminal, _), 367 is_list(Terminal), 368 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 369 Compiled2 = (DH :- _), 370 functor(DH, _, Arity), 371 DArg is Arity - 1, 372 append(Terminal, _Tail, List), 373 arg(DArg, DH, List), 374 TermPos1 = term_position(F,T,FF,FT,[ HP, 375 term_position(_,_,_,_,[_,BP]) 376 ]), 377 !, 378 TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]), 379 match_module(Compiled2, Compiled1, Module, TermPos2, TermPos). 380 % SSU rules 381unify_clause((Head,RCond => Body), (CHead :- CCondAndBody), Module, 382 term_position(F,T,FF,FT, 383 [ term_position(_,_,_,_,[HP,CP]), 384 BP 385 ]), 386 TermPos) :- 387 split_on_cut(CCondAndBody, CCond, CBody0), 388 !, 389 inlined_unification(RCond, CCond, RCond1, CCond1, Head, CP, CP1), 390 TermPos1 = term_position(F,T,FF,FT, [HP, BP1]), 391 BP2 = term_position(_,_,_,_, [FF-FT, BP]), % Represent (!, Body), placing 392 ( CCond1 == true % ! at => 393 -> BP1 = BP2, % Whole guard is inlined 394 unify_clause2((Head :- !, Body), (CHead :- !, CBody0), 395 Module, TermPos1, TermPos) 396 ; mkconj_pos(RCond1, CP1, (!,Body), BP2, RBody, BP1), 397 mkconj_npos(CCond1, (!,CBody0), CBody), 398 unify_clause2((Head :- RBody), (CHead :- CBody), 399 Module, TermPos1, TermPos) 400 ). 401unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :- 402 !, 403 unify_clause2(Head :- Body, Compiled1, Module, TermPos0, TermPos). 404unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :- 405 unify_clause2(Read, Decompiled, Module, TermPos0, TermPos). 406 407% mkconj, but also unify position info 408mkconj_pos((A,B), term_position(F,T,FF,FT,[PA,PB]), Ex, ExPos, Code, Pos) => 409 Code = (A,B1), 410 Pos = term_position(F,T,FF,FT,[PA,PB1]), 411 mkconj_pos(B, PB, Ex, ExPos, B1, PB1). 412mkconj_pos(Last, LastPos, Ex, ExPos, Code, Pos) => 413 Code = (Last,Ex), 414 Pos = term_position(_,_,_,_,[LastPos,ExPos]). 415 416% similar to mkconj, but we should __not__ optimize `true` away. 417mkconj_npos((A,B), Ex, Code) => 418 Code = (A,B1), 419 mkconj_npos(B, Ex, B1). 420mkconj_npos(A, Ex, Code) => 421 Code = (A,Ex).
427unify_clause2(Read, Decompiled, _, TermPos, TermPos) :- 428 Read =@= Decompiled, 429 !, 430 Read = Decompiled. 431unify_clause2(Read, Compiled1, Module, TermPos0, TermPos) :- 432 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 433 match_module(Compiled2, Compiled1, Module, TermPos1, TermPos). 434 % I don't know ... 435unify_clause2(_, _, _, _, _) :- 436 debug(clause_info, 'Could not unify clause', []), 437 fail. 438 439unify_clause_head(H1, H2) :- 440 strip_module(H1, _, H), 441 strip_module(H2, _, H). 442 443plunit_source_head(test(_,_)) => true. 444plunit_source_head(test(_)) => true. 445plunit_source_head(_) => fail. 446 447plunit_compiled_head(_:'unit body'(_, _)) => true. 448plunit_compiled_head('unit body'(_, _)) => true. 449plunit_compiled_head(_) => fail.
456inlined_unification((V=T,RBody0), (CV=CT,CBody0), 457 RBody, CBody, RHead, BPos1, BPos), 458 inlineable_head_var(RHead, V2), 459 V == V2, 460 (V=T) =@= (CV=CT) => 461 argpos(2, BPos1, BPos2), 462 inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos). 463inlined_unification((V=T), (CV=CT), 464 RBody, CBody, RHead, BPos1, BPos), 465 inlineable_head_var(RHead, V2), 466 V == V2, 467 (V=T) =@= (CV=CT) => 468 RBody = true, 469 CBody = true, 470 argpos(2, BPos1, BPos). 471inlined_unification((V=T,RBody0), CBody0, 472 RBody, CBody, RHead, BPos1, BPos), 473 inlineable_head_var(RHead, V2), 474 V == V2, 475 \+ (CBody0 = (G1,_), G1 =@= (V=T)) => 476 argpos(2, BPos1, BPos2), 477 inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos). 478inlined_unification((V=_), true, 479 RBody, CBody, RHead, BPos1, BPos), 480 inlineable_head_var(RHead, V2), 481 V == V2 => 482 RBody = true, 483 CBody = true, 484 argpos(2, BPos1, BPos). 485inlined_unification(RBody0, CBody0, RBody, CBody, _RHead, 486 BPos0, BPos) => 487 RBody = RBody0, 488 BPos = BPos0, 489 CBody = CBody0.
496inlineable_head_var(Head, Var) :- 497 compound(Head), 498 arg(_, Head, Var). 499 500split_on_cut((Cond0,!,Body0), Cond, Body) => 501 Cond = Cond0, 502 Body = Body0. 503split_on_cut((!,Body0), Cond, Body) => 504 Cond = true, 505 Body = Body0. 506split_on_cut((A,B), Cond, Body) => 507 Cond = (A,Cond1), 508 split_on_cut(B, Cond1, Body). 509split_on_cut(_, _, _) => 510 fail. 511 512ci_expand(Read, Compiled, Module, TermPos0, TermPos) :- 513 catch(setup_call_cleanup( 514 ( set_xref_flag(OldXRef), 515 '$set_source_module'(Old, Module) 516 ), 517 expand_term(Read, TermPos0, Compiled, TermPos), 518 ( '$set_source_module'(Old), 519 set_prolog_flag(xref, OldXRef) 520 )), 521 E, 522 expand_failed(E, Read)), 523 compound(TermPos), % make sure somthing is filled. 524 arg(1, TermPos, A1), nonvar(A1), 525 arg(2, TermPos, A2), nonvar(A2). 526 527set_xref_flag(Value) :- 528 current_prolog_flag(xref, Value), 529 !, 530 set_prolog_flag(xref, true). 531set_xref_flag(false) :- 532 create_prolog_flag(xref, true, [type(boolean)]). 533 534match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :- 535 !, 536 unify_clause_head(H1, H2), 537 unify_body(B1, B2, Module, Pos0, Pos). 538match_module((H1 :- B1), H2, _Module, Pos0, Pos) :- 539 B1 == true, 540 unify_clause_head(H1, H2), 541 Pos = Pos0, 542 !. 543match_module(H1, H2, _, Pos, Pos) :- % deal with facts 544 unify_clause_head(H1, H2).
550expand_failed(E, Read) :-
551 debugging(clause_info),
552 message_to_string(E, Msg),
553 debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
554 fail.Pos0 and Pos still include the term-position of the head.
563unify_body(B, C, _, Pos, Pos) :- 564 B =@= C, B = C, 565 does_not_dcg_after_binding(B, Pos), 566 !. 567unify_body(R, D, Module, 568 term_position(F,T,FF,FT,[HP,BP0]), 569 term_position(F,T,FF,FT,[HP,BP])) :- 570 ubody(R, D, Module, BP0, BP).
580does_not_dcg_after_binding(B, Pos) :- 581 \+ sub_term(brace_term_position(_,_,_), Pos), 582 \+ (sub_term((Cut,_=_), B), Cut == !), 583 !. 584 585 586/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 587Some remarks. 588 589a --> { x, y, z }. 590 This is translated into "(x,y),z), X=Y" by the DCG translator, after 591 which the compiler creates "a(X,Y) :- x, y, z, X=Y". 592- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
607ubody(B, DB, _, P, P) :- 608 var(P), % TBD: Create compatible pos term? 609 !, 610 B = DB. 611ubody(B, C, _, P, P) :- 612 B =@= C, B = C, 613 does_not_dcg_after_binding(B, P), 614 !. 615ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :- 616 !, 617 ubody(X0, X, M, P0, P). 618ubody(X, Y, _, % X = call(X) 619 Pos, 620 term_position(From, To, From, To, [Pos])) :- 621 nonvar(Y), 622 Y = call(X), 623 !, 624 arg(1, Pos, From), 625 arg(2, Pos, To). 626ubody(A, B, _, P1, P2) :- 627 nonvar(A), A = (_=_), 628 nonvar(B), B = (LB=RB), 629 A =@= (RB=LB), 630 !, 631 P1 = term_position(F,T, FF,FT, [PL,PR]), 632 P2 = term_position(F,T, FF,FT, [PR,PL]). 633ubody(A, B, _, P1, P2) :- 634 nonvar(A), A = (_==_), 635 nonvar(B), B = (LB==RB), 636 A =@= (RB==LB), 637 !, 638 P1 = term_position(F,T, FF,FT, [PL,PR]), 639 P2 = term_position(F,T, FF,FT, [PR,PL]). 640ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :- 641 nonvar(B), B = M:R, 642 ubody(R, D, M, RP, TPOut). 643ubody(B, D, M, term_position(_,_,_,_,[RP0,RP1]), TPOut) :- 644 nonvar(B), B = (B0,B1), 645 ( maybe_optimized(B0), 646 ubody(B1, D, M, RP1, TPOut) 647 -> true 648 ; maybe_optimized(B1), 649 ubody(B0, D, M, RP0, TPOut) 650 ), 651 !. 652ubody(B0, B, M, 653 brace_term_position(F,T,A0), 654 Pos) :- 655 B0 = (_,_=_), 656 !, 657 T1 is T - 1, 658 ubody(B0, B, M, 659 term_position(F,T, 660 F,T, 661 [A0,T1-T]), 662 Pos). 663ubody(B0, B, M, 664 brace_term_position(F,T,A0), 665 term_position(F,T,F,T,[A])) :- 666 !, 667 ubody(B0, B, M, A0, A). 668ubody(C0, C, M, P0, P) :- 669 nonvar(C0), nonvar(C), 670 C0 = (_,_), C = (_,_), 671 !, 672 conj(C0, P0, GL, PL), 673 mkconj(C, M, P, GL, PL). 674ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :- 675 unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled), 676 !. 677ubody(X0, X, M, 678 term_position(F,T,FF,TT,PA0), 679 term_position(F,T,FF,TT,PA)) :- 680 callable(X0), 681 callable(X), 682 meta(M, X0, S), 683 !, 684 X0 =.. [_|A0], 685 X =.. [_|A], 686 S =.. [_|AS], 687 ubody_list(A0, A, AS, M, PA0, PA). 688ubody(X0, X, M, 689 term_position(F,T,FF,TT,PA0), 690 term_position(F,T,FF,TT,PA)) :- 691 expand_goal(X0, X1, M, PA0, PA), 692 X1 =@= X, 693 X1 = X. 694 695 % 5.7.X optimizations 696ubody(_=_, true, _, % singleton = Any 697 term_position(F,T,_FF,_TT,_PA), 698 F-T) :- !. 699ubody(_==_, fail, _, % singleton/firstvar == Any 700 term_position(F,T,_FF,_TT,_PA), 701 F-T) :- !. 702ubody(A1=B1, B2=A2, _, % Term = Var --> Var = Term 703 term_position(F,T,FF,TT,[PA1,PA2]), 704 term_position(F,T,FF,TT,[PA2,PA1])) :- 705 var(B1), var(B2), 706 (A1==B1) =@= (B2==A2), 707 !, 708 A1 = A2, B1=B2. 709ubody(A1==B1, B2==A2, _, % const == Var --> Var == const 710 term_position(F,T,FF,TT,[PA1,PA2]), 711 term_position(F,T,FF,TT,[PA2,PA1])) :- 712 var(B1), var(B2), 713 (A1==B1) =@= (B2==A2), 714 !, 715 A1 = A2, B1=B2. 716ubody(A is B - C, A is B + C2, _, Pos, Pos) :- 717 integer(C), 718 C2 =:= -C, 719 !. 720 721ubody_list([], [], [], _, [], []). 722ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :- 723 ubody_elem(AS, G0, G, M, PA0, PA), 724 ubody_list(T0, T, ASL, M, PAT0, PAT). 725 726ubody_elem(0, G0, G, M, PA0, PA) :- 727 !, 728 ubody(G0, G, M, PA0, PA). 729ubody_elem(_, G, G, _, PA, PA).
736conj(Goal, Pos, GoalList, PosList) :- 737 conj(Goal, Pos, GoalList, [], PosList, []). 738 739conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :- 740 !, 741 conj(A, PA, GL, TGA, PL, TPA), 742 conj(B, PB, TGA, TG, TPA, TP). 743conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :- 744 B = (_=_), 745 !, 746 conj(A, PA, GL, TGA, PL, TPA), 747 T1 is T - 1, 748 conj(B, T1-T, TGA, TG, TPA, TP). 749conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :- 750 nonvar(Pos), 751 !, 752 conj(A, Pos, GL, TG, PL, TP). 753conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :- 754 F1 is F+1, 755 T1 is T+1. 756conj(A, P, [A|TG], TG, [P|TP], TP).
761mkconj(Goal, M, Pos, GoalList, PosList) :- 762 mkconj(Goal, M, Pos, GoalList, [], PosList, []). 763 764mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :- 765 nonvar(Conj), 766 Conj = (A,B), 767 !, 768 mkconj(A, M, PA, GL, TGA, PL, TPA), 769 mkconj(B, M, PB, TGA, TG, TPA, TP). 770mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :- 771 ubody(A, A0, M, P, P0), 772 !. 773mkconj(A0, M, P0, [RG|TG0], TG, [_|TP0], TP) :- 774 maybe_optimized(RG), 775 mkconj(A0, M, P0, TG0, TG, TP0, TP). 776 777maybe_optimized(debug(_,_,_)). 778maybe_optimized(assertion(_)). 779maybe_optimized(true).
785argpos(N, parentheses_term_position(_,_,PosIn), Pos) => 786 argpos(N, PosIn, Pos). 787argpos(N, term_position(_,_,_,_,ArgPos), Pos) => 788 nth1(N, ArgPos, Pos). 789argpos(_, _, _) => true. 790 791 792 /******************************* 793 * PCE STUFF (SHOULD MOVE) * 794 *******************************/ 795 796/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 797 <method>(Receiver, ... Arg ...) :-> 798 Body 799 800mapped to: 801 802 send_implementation(Id, <method>(...Arg...), Receiver) 803 804- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 805 806pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :- 807 !, 808 pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos). 809pce_method_clause(Head, Body, 810 send_implementation(_Id, Msg, Receiver), PlBody, 811 M, TermPos0, TermPos) :- 812 !, 813 debug(clause_info, 'send method ...', []), 814 arg(1, Head, Receiver), 815 functor(Head, _, Arity), 816 pce_method_head_arguments(2, Arity, Head, Msg), 817 debug(clause_info, 'head ...', []), 818 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 819pce_method_clause(Head, Body, 820 get_implementation(_Id, Msg, Receiver, Result), PlBody, 821 M, TermPos0, TermPos) :- 822 !, 823 debug(clause_info, 'get method ...', []), 824 arg(1, Head, Receiver), 825 debug(clause_info, 'receiver ...', []), 826 functor(Head, _, Arity), 827 arg(Arity, Head, PceResult), 828 debug(clause_info, '~w?~n', [PceResult = Result]), 829 pce_unify_head_arg(PceResult, Result), 830 Ar is Arity - 1, 831 pce_method_head_arguments(2, Ar, Head, Msg), 832 debug(clause_info, 'head ...', []), 833 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 834 835pce_method_head_arguments(N, Arity, Head, Msg) :- 836 N =< Arity, 837 !, 838 arg(N, Head, PceArg), 839 PLN is N - 1, 840 arg(PLN, Msg, PlArg), 841 pce_unify_head_arg(PceArg, PlArg), 842 debug(clause_info, '~w~n', [PceArg = PlArg]), 843 NextArg is N+1, 844 pce_method_head_arguments(NextArg, Arity, Head, Msg). 845pce_method_head_arguments(_, _, _, _). 846 847pce_unify_head_arg(V, A) :- 848 var(V), 849 !, 850 V = A. 851pce_unify_head_arg(A:_=_, A) :- !. 852pce_unify_head_arg(A:_, A). 853 854% pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos 855% 856% Unify the body of an XPCE method. Goal-expansion makes this 857% rather tricky, especially as we cannot call XPCE's expansion 858% on an isolated method. 859% 860% TermPos0 is the term-position term of the whole clause! 861% 862% Further, please note that the body of the method-clauses reside 863% in another module than pce_principal, and therefore the body 864% starts with an I_CONTEXT call. This implies we need a 865% hypothetical term-position for the module-qualifier. 866 867pce_method_body(A0, A, M, TermPos0, TermPos) :- 868 TermPos0 = term_position(F, T, FF, FT, 869 [ HeadPos, 870 BodyPos0 871 ]), 872 TermPos = term_position(F, T, FF, FT, 873 [ HeadPos, 874 term_position(0,0,0,0, [0-0,BodyPos]) 875 ]), 876 pce_method_body2(A0, A, M, BodyPos0, BodyPos). 877 878 879pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :- 880 !, 881 TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]), 882 TermPos = BodyPos, 883 expand_goal(A0, A, M, BodyPos0, BodyPos). 884pce_method_body2(A0, A, M, TermPos0, TermPos) :- 885 A0 =.. [Func,B0,C0], 886 control_op(Func), 887 !, 888 A =.. [Func,B,C], 889 TermPos0 = term_position(F, T, FF, FT, 890 [ BP0, 891 CP0 892 ]), 893 TermPos = term_position(F, T, FF, FT, 894 [ BP, 895 CP 896 ]), 897 pce_method_body2(B0, B, M, BP0, BP), 898 expand_goal(C0, C, M, CP0, CP). 899pce_method_body2(A0, A, M, TermPos0, TermPos) :- 900 expand_goal(A0, A, M, TermPos0, TermPos). 901 902control_op(','). 903control_op((;)). 904control_op((->)). 905control_op((*->)). 906 907 /******************************* 908 * EXPAND_GOAL SUPPORT * 909 *******************************/ 910 911/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 912With the introduction of expand_goal, it is increasingly hard to relate 913the clause from the database to the actual source. For one thing, we do 914not know the compilation module of the clause (unless we want to 915decompile it). 916 917Goal expansion can translate goals into control-constructs, multiple 918clauses, or delete a subgoal. 919 920To keep track of the source-locations, we have to redo the analysis of 921the clause as defined in init.pl 922- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 923 924expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :- 925 var(G), 926 !. 927expand_goal(G, G1, _, P, P) :- 928 var(G), 929 !, 930 G1 = G. 931expand_goal(M0, M, Module, P0, P) :- 932 meta(Module, M0, S), 933 !, 934 P0 = term_position(F,T,FF,FT,PL0), 935 P = term_position(F,T,FF,FT,PL), 936 functor(M0, Functor, Arity), 937 functor(M, Functor, Arity), 938 expand_meta_args(PL0, PL, 1, S, Module, M0, M). 939expand_goal(A, B, Module, P0, P) :- 940 goal_expansion(A, B0, P0, P1), 941 !, 942 expand_goal(B0, B, Module, P1, P). 943expand_goal(A, A, _, P, P). 944 945expand_meta_args([], [], _, _, _, _, _). 946expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :- 947 arg(I, M0, A0), 948 arg(I, M, A), 949 arg(I, S, AS), 950 expand_arg(AS, A0, A, Module, P0, P), 951 NI is I + 1, 952 expand_meta_args(T0, T, NI, S, Module, M0, M). 953 954expand_arg(0, A0, A, Module, P0, P) :- 955 !, 956 expand_goal(A0, A, Module, P0, P). 957expand_arg(_, A, A, _, P, P). 958 959meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)). 960 961goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :- 962 compound(Msg), 963 Msg =.. [send_super, Selector | Args], 964 !, 965 SuperMsg =.. [Selector|Args]. 966goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :- 967 compound(Msg), 968 Msg =.. [get_super, Selector | Args], 969 !, 970 SuperMsg =.. [Selector|Args]. 971goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P). 972goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P). 973goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :- 974 compound(SendSuperN), 975 compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]), 976 Msg =.. [Sel|Args]. 977goal_expansion(SendN, send(R, Msg), P, P) :- 978 compound(SendN), 979 compound_name_arguments(SendN, send, [R,Sel|Args]), 980 atom(Sel), Args \== [], 981 Msg =.. [Sel|Args]. 982goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :- 983 compound(GetSuperN), 984 compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]), 985 append(Args, [Answer], AllArgs), 986 Msg =.. [Sel|Args]. 987goal_expansion(GetN, get(R, Msg, Answer), P, P) :- 988 compound(GetN), 989 compound_name_arguments(GetN, get, [R,Sel|AllArgs]), 990 append(Args, [Answer], AllArgs), 991 atom(Sel), Args \== [], 992 Msg =.. [Sel|Args]. 993goal_expansion(G0, G, P, P) :- 994 user:goal_expansion(G0, G), % TBD: we need the module! 995 G0 \== G. % \=@=? 996 997 998 /******************************* 999 * INITIALIZATION * 1000 *******************************/
1007initialization_layout(File:Line, M:Goal0, Goal, TermPos) :- 1008 read_term_at_line(File, Line, M, Directive, DirectivePos, _), 1009 Directive = (:- initialization(ReadGoal)), 1010 DirectivePos = term_position(_, _, _, _, [InitPos]), 1011 InitPos = term_position(_, _, _, _, [GoalPos]), 1012 ( ReadGoal = M:_ 1013 -> Goal = M:Goal0 1014 ; Goal = Goal0 1015 ), 1016 unify_body(ReadGoal, Goal, M, GoalPos, TermPos), 1017 !. 1018 1019 1020 /******************************* 1021 * PRINTABLE NAMES * 1022 *******************************/ 1023 1024:- module_transparent 1025 predicate_name/2. 1026:- multifile 1027 user:prolog_predicate_name/2, 1028 user:prolog_clause_name/2. 1029 (user). 1031hidden_module(system). 1032hidden_module(pce_principal). % should be config 1033hidden_module(Module) :- % SWI-Prolog specific 1034 import_module(Module, system). 1035 1036thaffix(1, st) :- !. 1037thaffix(2, nd) :- !. 1038thaffix(_, th).
1044predicate_name(Predicate, PName) :-
1045 strip_module(Predicate, Module, Head),
1046 ( user:prolog_predicate_name(Module:Head, PName)
1047 -> true
1048 ; functor(Head, Name, Arity),
1049 ( hidden_module(Module)
1050 -> format(string(PName), '~q/~d', [Name, Arity])
1051 ; format(string(PName), '~q:~q/~d', [Module, Name, Arity])
1052 )
1053 ).1059clause_name(Ref, Name) :- 1060 user:prolog_clause_name(Ref, Name), 1061 !. 1062clause_name(Ref, Name) :- 1063 nth_clause(Head, N, Ref), 1064 !, 1065 predicate_name(Head, PredName), 1066 thaffix(N, Th), 1067 format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]). 1068clause_name(Ref, Name) :- 1069 clause_property(Ref, erased), 1070 !, 1071 clause_property(Ref, predicate(M:PI)), 1072 format(string(Name), 'erased clause from ~q', [M:PI]). 1073clause_name(_, '<meta-call>')
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. */