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:
104clause_info(ClauseRef, File, TermPos, NameOffset) :- 105 clause_info(ClauseRef, File, TermPos, NameOffset, []). 106 107clause_info(ClauseRef, File, TermPos, NameOffset, Options) :- 108 ( debugging(clause_info) 109 -> clause_name(ClauseRef, Name), 110 debug(clause_info, 'clause_info(~w) (~w)... ', 111 [ClauseRef, Name]) 112 ; true 113 ), 114 clause_property(ClauseRef, file(File)), 115 File \== user, % loaded using ?- [user]. 116 '$clause'(Head0, Body, ClauseRef, VarOffset), 117 option(head(Head0), Options, _), 118 option(body(Body), Options, _), 119 ( module_property(Module, file(File)) 120 -> true 121 ; strip_module(user:Head0, Module, _) 122 ), 123 unqualify(Head0, Module, Head), 124 ( Body == true 125 -> DecompiledClause = Head 126 ; DecompiledClause = (Head :- Body) 127 ), 128 clause_property(ClauseRef, line_count(LineNo)), 129 debug(clause_info, 'from ~w:~d ... ', [File, LineNo]), 130 read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames), 131 option(variable_names(VarNames), Options, _), 132 debug(clause_info, 'read ...', []), 133 unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos), 134 debug(clause_info, 'unified ...', []), 135 make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset), 136 debug(clause_info, 'got names~n', []), 137 !. 138 139unqualify(Module:Head, Module, Head) :- 140 !. 141unqualify(Head, _, Head).
NOTE: Called directly from library(trace/clause) for the GUI tracer.
155unify_term(X, X) :- !. 156unify_term(X1, X2) :- 157 compound(X1), 158 compound(X2), 159 functor(X1, F, Arity), 160 functor(X2, F, Arity), 161 !, 162 unify_args(0, Arity, X1, X2). 163unify_term(X, Y) :- 164 float(X), float(Y), 165 !. 166unify_term(X, '$BLOB'(_)) :- 167 blob(X, _), 168 \+ atom(X). 169unify_term(X, Y) :- 170 string(X), 171 is_list(Y), 172 string_codes(X, Y), 173 !. 174unify_term(_, Y) :- 175 Y == '...', 176 !. % elipses left by max_depth 177unify_term(_:X, Y) :- 178 unify_term(X, Y), 179 !. 180unify_term(X, _:Y) :- 181 unify_term(X, Y), 182 !. 183unify_term(X, Y) :- 184 format('[INTERNAL ERROR: Diff:~n'), 185 portray_clause(X), 186 format('~N*** <->~n'), 187 portray_clause(Y), 188 break. 189 190unify_args(N, N, _, _) :- !. 191unify_args(I, Arity, T1, T2) :- 192 A is I + 1, 193 arg(A, T1, A1), 194 arg(A, T2, A2), 195 unify_term(A1, A2), 196 unify_args(A, Arity, T1, T2).
204read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :- 205 setup_call_cleanup( 206 '$push_input_context'(clause_info), 207 read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames), 208 '$pop_input_context'). 209 210read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :- 211 catch(try_open_source(File, In), error(_,_), fail), 212 set_stream(In, newline(detect)), 213 call_cleanup( 214 read_source_term_at_location( 215 In, Clause, 216 [ line(Line), 217 module(Module), 218 subterm_positions(TermPos), 219 variable_names(VarNames) 220 ]), 221 close(In)).
clause_property(ClauseRef, file(File)), prolog_clause:open_source(File, Stream)
234:- public try_open_source/2. % used by library(prolog_breakpoints). 235 236try_open_source(File, In) :- 237 open_source(File, In), 238 !. 239try_open_source(File, In) :- 240 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.
259make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :- 260 make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term), 261 !. 262make_varnames((Head --> _Body), _, Offsets, Names, Bindings) :- 263 !, 264 functor(Head, _, Arity), 265 In is Arity, 266 memberchk(In=IVar, Offsets), 267 Names1 = ['<DCG_list>'=IVar|Names], 268 Out is Arity + 1, 269 memberchk(Out=OVar, Offsets), 270 Names2 = ['<DCG_tail>'=OVar|Names1], 271 make_varnames(xx, xx, Offsets, Names2, Bindings). 272make_varnames(_, _, Offsets, Names, Bindings) :- 273 length(Offsets, L), 274 functor(Bindings, varnames, L), 275 do_make_varnames(Offsets, Names, Bindings). 276 277do_make_varnames([], _, _). 278do_make_varnames([N=Var|TO], Names, Bindings) :- 279 ( find_varname(Var, Names, Name) 280 -> true 281 ; Name = '_' 282 ), 283 AN is N + 1, 284 arg(AN, Bindings, Name), 285 do_make_varnames(TO, Names, Bindings). 286 287find_varname(Var, [Name = TheVar|_], Name) :- 288 Var == TheVar, 289 !. 290find_varname(Var, [_|T], Name) :- 291 find_varname(Var, T, Name).
This predicate calls the multifile predicate unify_clause_hook/5 with the same arguments to support user extensions.
314unify_clause(Read, _, _, _, _) :- 315 var(Read), 316 !, 317 fail. 318unify_clause((RHead :- RBody), (CHead :- CBody), Module, TermPos1, TermPos) :- 319 '$expand':f2_pos(TermPos1, HPos, BPos1, 320 TermPos2, HPos, BPos2), 321 inlined_unification(RBody, CBody, RBody1, CBody1, RHead, 322 BPos1, BPos2), 323 RBody1 \== RBody, 324 !, 325 unify_clause2((RHead :- RBody1), (CHead :- CBody1), Module, 326 TermPos2, TermPos). 327unify_clause(Read, Decompiled, _, TermPos, TermPos) :- 328 Read =@= Decompiled, 329 !, 330 Read = Decompiled. 331unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :- 332 unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos), 333 !. 334 % XPCE send-methods 335unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :- 336 !, 337 pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos). 338 % XPCE get-methods 339unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :- 340 !, 341 pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos). 342 % Unit test clauses 343unify_clause((TH :- RBody), (CH :- !, CBody), Module, TP0, TP) :- 344 plunit_source_head(TH), 345 plunit_compiled_head(CH), 346 !, 347 TP0 = term_position(F,T,FF,FT,[HP,BP0]), 348 ubody(RBody, CBody, Module, BP0, BP), 349 TP = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]). 350 % module:head :- body 351unify_clause((Head :- Read), 352 (Head :- _M:Compiled), Module, TermPos0, TermPos) :- 353 unify_clause2((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1), 354 TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]), 355 TermPos = term_position(TA,TZ,FA,FZ, 356 [ PH, 357 term_position(0,0,0,0,[0-0,PB]) 358 ]). 359 % DCG rules 360unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :- 361 Read = (_ --> Terminal, _), 362 is_list(Terminal), 363 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 364 Compiled2 = (DH :- _), 365 functor(DH, _, Arity), 366 DArg is Arity - 1, 367 append(Terminal, _Tail, List), 368 arg(DArg, DH, List), 369 TermPos1 = term_position(F,T,FF,FT,[ HP, 370 term_position(_,_,_,_,[_,BP]) 371 ]), 372 !, 373 TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]), 374 match_module(Compiled2, Compiled1, Module, TermPos2, TermPos). 375 % SSU rules 376unify_clause((Head,RCond => Body), (CHead :- CCondAndBody), Module, 377 term_position(F,T,FF,FT, 378 [ term_position(_,_,_,_,[HP,CP]), 379 BP 380 ]), 381 TermPos) :- 382 split_on_cut(CCondAndBody, CCond, CBody0), 383 !, 384 inlined_unification(RCond, CCond, RCond1, CCond1, Head, CP, CP1), 385 TermPos1 = term_position(F,T,FF,FT, [HP, BP1]), 386 BP2 = term_position(_,_,_,_, [FF-FT, BP]), % Represent (!, Body), placing 387 ( CCond1 == true % ! at => 388 -> BP1 = BP2, % Whole guard is inlined 389 unify_clause2((Head :- !, Body), (CHead :- !, CBody0), 390 Module, TermPos1, TermPos) 391 ; mkconj_pos(RCond1, CP1, (!,Body), BP2, RBody, BP1), 392 mkconj_npos(CCond1, (!,CBody0), CBody), 393 unify_clause2((Head :- RBody), (CHead :- CBody), 394 Module, TermPos1, TermPos) 395 ). 396unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :- 397 !, 398 unify_clause2(Head :- Body, Compiled1, Module, TermPos0, TermPos). 399unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :- 400 unify_clause2(Read, Decompiled, Module, TermPos0, TermPos). 401 402% mkconj, but also unify position info 403mkconj_pos((A,B), term_position(F,T,FF,FT,[PA,PB]), Ex, ExPos, Code, Pos) => 404 Code = (A,B1), 405 Pos = term_position(F,T,FF,FT,[PA,PB1]), 406 mkconj_pos(B, PB, Ex, ExPos, B1, PB1). 407mkconj_pos(Last, LastPos, Ex, ExPos, Code, Pos) => 408 Code = (Last,Ex), 409 Pos = term_position(_,_,_,_,[LastPos,ExPos]). 410 411% similar to mkconj, but we should __not__ optimize `true` away. 412mkconj_npos((A,B), Ex, Code) => 413 Code = (A,B1), 414 mkconj_npos(B, Ex, B1). 415mkconj_npos(A, Ex, Code) => 416 Code = (A,Ex).
422unify_clause2(Read, Decompiled, _, TermPos, TermPos) :- 423 Read =@= Decompiled, 424 !, 425 Read = Decompiled. 426unify_clause2(Read, Compiled1, Module, TermPos0, TermPos) :- 427 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 428 match_module(Compiled2, Compiled1, Module, TermPos1, TermPos). 429 % I don't know ... 430unify_clause2(_, _, _, _, _) :- 431 debug(clause_info, 'Could not unify clause', []), 432 fail. 433 434unify_clause_head(H1, H2) :- 435 strip_module(H1, _, H), 436 strip_module(H2, _, H). 437 438plunit_source_head(test(_,_)) => true. 439plunit_source_head(test(_)) => true. 440plunit_source_head(_) => fail. 441 442plunit_compiled_head(_:'unit body'(_, _)) => true. 443plunit_compiled_head('unit body'(_, _)) => true. 444plunit_compiled_head(_) => fail.
451inlined_unification((V=T,RBody0), (CV=CT,CBody0), 452 RBody, CBody, RHead, BPos1, BPos), 453 inlineable_head_var(RHead, V2), 454 V == V2, 455 (V=T) =@= (CV=CT) => 456 argpos(2, BPos1, BPos2), 457 inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos). 458inlined_unification((V=T), (CV=CT), 459 RBody, CBody, RHead, BPos1, BPos), 460 inlineable_head_var(RHead, V2), 461 V == V2, 462 (V=T) =@= (CV=CT) => 463 RBody = true, 464 CBody = true, 465 argpos(2, BPos1, BPos). 466inlined_unification((V=T,RBody0), CBody0, 467 RBody, CBody, RHead, BPos1, BPos), 468 inlineable_head_var(RHead, V2), 469 V == V2, 470 \+ (CBody0 = (G1,_), G1 =@= (V=T)) => 471 argpos(2, BPos1, BPos2), 472 inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos). 473inlined_unification((V=_), true, 474 RBody, CBody, RHead, BPos1, BPos), 475 inlineable_head_var(RHead, V2), 476 V == V2 => 477 RBody = true, 478 CBody = true, 479 argpos(2, BPos1, BPos). 480inlined_unification(RBody0, CBody0, RBody, CBody, _RHead, 481 BPos0, BPos) => 482 RBody = RBody0, 483 BPos = BPos0, 484 CBody = CBody0.
491inlineable_head_var(Head, Var) :- 492 compound(Head), 493 arg(_, Head, Var). 494 495split_on_cut((Cond0,!,Body0), Cond, Body) => 496 Cond = Cond0, 497 Body = Body0. 498split_on_cut((!,Body0), Cond, Body) => 499 Cond = true, 500 Body = Body0. 501split_on_cut((A,B), Cond, Body) => 502 Cond = (A,Cond1), 503 split_on_cut(B, Cond1, Body). 504split_on_cut(_, _, _) => 505 fail. 506 507ci_expand(Read, Compiled, Module, TermPos0, TermPos) :- 508 catch(setup_call_cleanup( 509 ( set_xref_flag(OldXRef), 510 '$set_source_module'(Old, Module) 511 ), 512 expand_term(Read, TermPos0, Compiled, TermPos), 513 ( '$set_source_module'(Old), 514 set_prolog_flag(xref, OldXRef) 515 )), 516 E, 517 expand_failed(E, Read)), 518 compound(TermPos), % make sure somthing is filled. 519 arg(1, TermPos, A1), nonvar(A1), 520 arg(2, TermPos, A2), nonvar(A2). 521 522set_xref_flag(Value) :- 523 current_prolog_flag(xref, Value), 524 !, 525 set_prolog_flag(xref, true). 526set_xref_flag(false) :- 527 create_prolog_flag(xref, true, [type(boolean)]). 528 529match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :- 530 !, 531 unify_clause_head(H1, H2), 532 unify_body(B1, B2, Module, Pos0, Pos). 533match_module((H1 :- B1), H2, _Module, Pos0, Pos) :- 534 B1 == true, 535 unify_clause_head(H1, H2), 536 Pos = Pos0, 537 !. 538match_module(H1, H2, _, Pos, Pos) :- % deal with facts 539 unify_clause_head(H1, H2).
545expand_failed(E, Read) :-
546 debugging(clause_info),
547 message_to_string(E, Msg),
548 debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
549 fail.Pos0 and Pos still include the term-position of the head.
558unify_body(B, C, _, Pos, Pos) :- 559 B =@= C, B = C, 560 does_not_dcg_after_binding(B, Pos), 561 !. 562unify_body(R, D, Module, 563 term_position(F,T,FF,FT,[HP,BP0]), 564 term_position(F,T,FF,FT,[HP,BP])) :- 565 ubody(R, D, Module, BP0, BP).
575does_not_dcg_after_binding(B, Pos) :- 576 \+ sub_term(brace_term_position(_,_,_), Pos), 577 \+ (sub_term((Cut,_=_), B), Cut == !), 578 !. 579 580 581/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 582Some remarks. 583 584a --> { x, y, z }. 585 This is translated into "(x,y),z), X=Y" by the DCG translator, after 586 which the compiler creates "a(X,Y) :- x, y, z, X=Y". 587- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
602ubody(B, DB, _, P, P) :- 603 var(P), % TBD: Create compatible pos term? 604 !, 605 B = DB. 606ubody(B, C, _, P, P) :- 607 B =@= C, B = C, 608 does_not_dcg_after_binding(B, P), 609 !. 610ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :- 611 !, 612 ubody(X0, X, M, P0, P). 613ubody(X, Y, _, % X = call(X) 614 Pos, 615 term_position(From, To, From, To, [Pos])) :- 616 nonvar(Y), 617 Y = call(X), 618 !, 619 arg(1, Pos, From), 620 arg(2, Pos, To). 621ubody(A, B, _, P1, P2) :- 622 nonvar(A), A = (_=_), 623 nonvar(B), B = (LB=RB), 624 A =@= (RB=LB), 625 !, 626 P1 = term_position(F,T, FF,FT, [PL,PR]), 627 P2 = term_position(F,T, FF,FT, [PR,PL]). 628ubody(A, B, _, P1, P2) :- 629 nonvar(A), A = (_==_), 630 nonvar(B), B = (LB==RB), 631 A =@= (RB==LB), 632 !, 633 P1 = term_position(F,T, FF,FT, [PL,PR]), 634 P2 = term_position(F,T, FF,FT, [PR,PL]). 635ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :- 636 nonvar(B), B = M:R, 637 ubody(R, D, M, RP, TPOut). 638ubody(B, D, M, term_position(_,_,_,_,[RP0,RP1]), TPOut) :- 639 nonvar(B), B = (B0,B1), 640 ( maybe_optimized(B0), 641 ubody(B1, D, M, RP1, TPOut) 642 -> true 643 ; maybe_optimized(B1), 644 ubody(B0, D, M, RP0, TPOut) 645 ), 646 !. 647ubody(B0, B, M, 648 brace_term_position(F,T,A0), 649 Pos) :- 650 B0 = (_,_=_), 651 !, 652 T1 is T - 1, 653 ubody(B0, B, M, 654 term_position(F,T, 655 F,T, 656 [A0,T1-T]), 657 Pos). 658ubody(B0, B, M, 659 brace_term_position(F,T,A0), 660 term_position(F,T,F,T,[A])) :- 661 !, 662 ubody(B0, B, M, A0, A). 663ubody(C0, C, M, P0, P) :- 664 nonvar(C0), nonvar(C), 665 C0 = (_,_), C = (_,_), 666 !, 667 conj(C0, P0, GL, PL), 668 mkconj(C, M, P, GL, PL). 669ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :- 670 unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled), 671 !. 672ubody(X0, X, M, 673 term_position(F,T,FF,TT,PA0), 674 term_position(F,T,FF,TT,PA)) :- 675 callable(X0), 676 callable(X), 677 meta(M, X0, S), 678 !, 679 X0 =.. [_|A0], 680 X =.. [_|A], 681 S =.. [_|AS], 682 ubody_list(A0, A, AS, M, PA0, PA). 683ubody(X0, X, M, 684 term_position(F,T,FF,TT,PA0), 685 term_position(F,T,FF,TT,PA)) :- 686 expand_goal(X0, X1, M, PA0, PA), 687 X1 =@= X, 688 X1 = X. 689 690 % 5.7.X optimizations 691ubody(_=_, true, _, % singleton = Any 692 term_position(F,T,_FF,_TT,_PA), 693 F-T) :- !. 694ubody(_==_, fail, _, % singleton/firstvar == Any 695 term_position(F,T,_FF,_TT,_PA), 696 F-T) :- !. 697ubody(A1=B1, B2=A2, _, % Term = Var --> Var = Term 698 term_position(F,T,FF,TT,[PA1,PA2]), 699 term_position(F,T,FF,TT,[PA2,PA1])) :- 700 var(B1), var(B2), 701 (A1==B1) =@= (B2==A2), 702 !, 703 A1 = A2, B1=B2. 704ubody(A1==B1, B2==A2, _, % const == Var --> Var == const 705 term_position(F,T,FF,TT,[PA1,PA2]), 706 term_position(F,T,FF,TT,[PA2,PA1])) :- 707 var(B1), var(B2), 708 (A1==B1) =@= (B2==A2), 709 !, 710 A1 = A2, B1=B2. 711ubody(A is B - C, A is B + C2, _, Pos, Pos) :- 712 integer(C), 713 C2 =:= -C, 714 !. 715 716ubody_list([], [], [], _, [], []). 717ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :- 718 ubody_elem(AS, G0, G, M, PA0, PA), 719 ubody_list(T0, T, ASL, M, PAT0, PAT). 720 721ubody_elem(0, G0, G, M, PA0, PA) :- 722 !, 723 ubody(G0, G, M, PA0, PA). 724ubody_elem(_, G, G, _, PA, PA).
731conj(Goal, Pos, GoalList, PosList) :- 732 conj(Goal, Pos, GoalList, [], PosList, []). 733 734conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :- 735 !, 736 conj(A, PA, GL, TGA, PL, TPA), 737 conj(B, PB, TGA, TG, TPA, TP). 738conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :- 739 B = (_=_), 740 !, 741 conj(A, PA, GL, TGA, PL, TPA), 742 T1 is T - 1, 743 conj(B, T1-T, TGA, TG, TPA, TP). 744conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :- 745 nonvar(Pos), 746 !, 747 conj(A, Pos, GL, TG, PL, TP). 748conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :- 749 F1 is F+1, 750 T1 is T+1. 751conj(A, P, [A|TG], TG, [P|TP], TP).
756mkconj(Goal, M, Pos, GoalList, PosList) :- 757 mkconj(Goal, M, Pos, GoalList, [], PosList, []). 758 759mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :- 760 nonvar(Conj), 761 Conj = (A,B), 762 !, 763 mkconj(A, M, PA, GL, TGA, PL, TPA), 764 mkconj(B, M, PB, TGA, TG, TPA, TP). 765mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :- 766 ubody(A, A0, M, P, P0), 767 !. 768mkconj(A0, M, P0, [RG|TG0], TG, [_|TP0], TP) :- 769 maybe_optimized(RG), 770 mkconj(A0, M, P0, TG0, TG, TP0, TP). 771 772maybe_optimized(debug(_,_,_)). 773maybe_optimized(assertion(_)). 774maybe_optimized(true).
780argpos(N, parentheses_term_position(_,_,PosIn), Pos) => 781 argpos(N, PosIn, Pos). 782argpos(N, term_position(_,_,_,_,ArgPos), Pos) => 783 nth1(N, ArgPos, Pos). 784argpos(_, _, _) => true. 785 786 787 /******************************* 788 * PCE STUFF (SHOULD MOVE) * 789 *******************************/ 790 791/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 792 <method>(Receiver, ... Arg ...) :-> 793 Body 794 795mapped to: 796 797 send_implementation(Id, <method>(...Arg...), Receiver) 798 799- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 800 801pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :- 802 !, 803 pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos). 804pce_method_clause(Head, Body, 805 send_implementation(_Id, Msg, Receiver), PlBody, 806 M, TermPos0, TermPos) :- 807 !, 808 debug(clause_info, 'send method ...', []), 809 arg(1, Head, Receiver), 810 functor(Head, _, Arity), 811 pce_method_head_arguments(2, Arity, Head, Msg), 812 debug(clause_info, 'head ...', []), 813 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 814pce_method_clause(Head, Body, 815 get_implementation(_Id, Msg, Receiver, Result), PlBody, 816 M, TermPos0, TermPos) :- 817 !, 818 debug(clause_info, 'get method ...', []), 819 arg(1, Head, Receiver), 820 debug(clause_info, 'receiver ...', []), 821 functor(Head, _, Arity), 822 arg(Arity, Head, PceResult), 823 debug(clause_info, '~w?~n', [PceResult = Result]), 824 pce_unify_head_arg(PceResult, Result), 825 Ar is Arity - 1, 826 pce_method_head_arguments(2, Ar, Head, Msg), 827 debug(clause_info, 'head ...', []), 828 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 829 830pce_method_head_arguments(N, Arity, Head, Msg) :- 831 N =< Arity, 832 !, 833 arg(N, Head, PceArg), 834 PLN is N - 1, 835 arg(PLN, Msg, PlArg), 836 pce_unify_head_arg(PceArg, PlArg), 837 debug(clause_info, '~w~n', [PceArg = PlArg]), 838 NextArg is N+1, 839 pce_method_head_arguments(NextArg, Arity, Head, Msg). 840pce_method_head_arguments(_, _, _, _). 841 842pce_unify_head_arg(V, A) :- 843 var(V), 844 !, 845 V = A. 846pce_unify_head_arg(A:_=_, A) :- !. 847pce_unify_head_arg(A:_, A). 848 849% pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos 850% 851% Unify the body of an XPCE method. Goal-expansion makes this 852% rather tricky, especially as we cannot call XPCE's expansion 853% on an isolated method. 854% 855% TermPos0 is the term-position term of the whole clause! 856% 857% Further, please note that the body of the method-clauses reside 858% in another module than pce_principal, and therefore the body 859% starts with an I_CONTEXT call. This implies we need a 860% hypothetical term-position for the module-qualifier. 861 862pce_method_body(A0, A, M, TermPos0, TermPos) :- 863 TermPos0 = term_position(F, T, FF, FT, 864 [ HeadPos, 865 BodyPos0 866 ]), 867 TermPos = term_position(F, T, FF, FT, 868 [ HeadPos, 869 term_position(0,0,0,0, [0-0,BodyPos]) 870 ]), 871 pce_method_body2(A0, A, M, BodyPos0, BodyPos). 872 873 874pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :- 875 !, 876 TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]), 877 TermPos = BodyPos, 878 expand_goal(A0, A, M, BodyPos0, BodyPos). 879pce_method_body2(A0, A, M, TermPos0, TermPos) :- 880 A0 =.. [Func,B0,C0], 881 control_op(Func), 882 !, 883 A =.. [Func,B,C], 884 TermPos0 = term_position(F, T, FF, FT, 885 [ BP0, 886 CP0 887 ]), 888 TermPos = term_position(F, T, FF, FT, 889 [ BP, 890 CP 891 ]), 892 pce_method_body2(B0, B, M, BP0, BP), 893 expand_goal(C0, C, M, CP0, CP). 894pce_method_body2(A0, A, M, TermPos0, TermPos) :- 895 expand_goal(A0, A, M, TermPos0, TermPos). 896 897control_op(','). 898control_op((;)). 899control_op((->)). 900control_op((*->)). 901 902 /******************************* 903 * EXPAND_GOAL SUPPORT * 904 *******************************/ 905 906/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 907With the introduction of expand_goal, it is increasingly hard to relate 908the clause from the database to the actual source. For one thing, we do 909not know the compilation module of the clause (unless we want to 910decompile it). 911 912Goal expansion can translate goals into control-constructs, multiple 913clauses, or delete a subgoal. 914 915To keep track of the source-locations, we have to redo the analysis of 916the clause as defined in init.pl 917- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 918 919expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :- 920 var(G), 921 !. 922expand_goal(G, G1, _, P, P) :- 923 var(G), 924 !, 925 G1 = G. 926expand_goal(M0, M, Module, P0, P) :- 927 meta(Module, M0, S), 928 !, 929 P0 = term_position(F,T,FF,FT,PL0), 930 P = term_position(F,T,FF,FT,PL), 931 functor(M0, Functor, Arity), 932 functor(M, Functor, Arity), 933 expand_meta_args(PL0, PL, 1, S, Module, M0, M). 934expand_goal(A, B, Module, P0, P) :- 935 goal_expansion(A, B0, P0, P1), 936 !, 937 expand_goal(B0, B, Module, P1, P). 938expand_goal(A, A, _, P, P). 939 940expand_meta_args([], [], _, _, _, _, _). 941expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :- 942 arg(I, M0, A0), 943 arg(I, M, A), 944 arg(I, S, AS), 945 expand_arg(AS, A0, A, Module, P0, P), 946 NI is I + 1, 947 expand_meta_args(T0, T, NI, S, Module, M0, M). 948 949expand_arg(0, A0, A, Module, P0, P) :- 950 !, 951 expand_goal(A0, A, Module, P0, P). 952expand_arg(_, A, A, _, P, P). 953 954meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)). 955 956goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :- 957 compound(Msg), 958 Msg =.. [send_super, Selector | Args], 959 !, 960 SuperMsg =.. [Selector|Args]. 961goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :- 962 compound(Msg), 963 Msg =.. [get_super, Selector | Args], 964 !, 965 SuperMsg =.. [Selector|Args]. 966goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P). 967goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P). 968goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :- 969 compound(SendSuperN), 970 compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]), 971 Msg =.. [Sel|Args]. 972goal_expansion(SendN, send(R, Msg), P, P) :- 973 compound(SendN), 974 compound_name_arguments(SendN, send, [R,Sel|Args]), 975 atom(Sel), Args \== [], 976 Msg =.. [Sel|Args]. 977goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :- 978 compound(GetSuperN), 979 compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]), 980 append(Args, [Answer], AllArgs), 981 Msg =.. [Sel|Args]. 982goal_expansion(GetN, get(R, Msg, Answer), P, P) :- 983 compound(GetN), 984 compound_name_arguments(GetN, get, [R,Sel|AllArgs]), 985 append(Args, [Answer], AllArgs), 986 atom(Sel), Args \== [], 987 Msg =.. [Sel|Args]. 988goal_expansion(G0, G, P, P) :- 989 user:goal_expansion(G0, G), % TBD: we need the module! 990 G0 \== G. % \=@=? 991 992 993 /******************************* 994 * INITIALIZATION * 995 *******************************/
1002initialization_layout(File:Line, M:Goal0, Goal, TermPos) :- 1003 read_term_at_line(File, Line, M, Directive, DirectivePos, _), 1004 Directive = (:- initialization(ReadGoal)), 1005 DirectivePos = term_position(_, _, _, _, [InitPos]), 1006 InitPos = term_position(_, _, _, _, [GoalPos]), 1007 ( ReadGoal = M:_ 1008 -> Goal = M:Goal0 1009 ; Goal = Goal0 1010 ), 1011 unify_body(ReadGoal, Goal, M, GoalPos, TermPos), 1012 !. 1013 1014 1015 /******************************* 1016 * PRINTABLE NAMES * 1017 *******************************/ 1018 1019:- module_transparent 1020 predicate_name/2. 1021:- multifile 1022 user:prolog_predicate_name/2, 1023 user:prolog_clause_name/2. 1024 (user). 1026hidden_module(system). 1027hidden_module(pce_principal). % should be config 1028hidden_module(Module) :- % SWI-Prolog specific 1029 import_module(Module, system). 1030 1031thaffix(1, st) :- !. 1032thaffix(2, nd) :- !. 1033thaffix(_, th).
1039predicate_name(Predicate, PName) :-
1040 strip_module(Predicate, Module, Head),
1041 ( user:prolog_predicate_name(Module:Head, PName)
1042 -> true
1043 ; functor(Head, Name, Arity),
1044 ( hidden_module(Module)
1045 -> format(string(PName), '~q/~d', [Name, Arity])
1046 ; format(string(PName), '~q:~q/~d', [Module, Name, Arity])
1047 )
1048 ).1054clause_name(Ref, Name) :- 1055 user:prolog_clause_name(Ref, Name), 1056 !. 1057clause_name(Ref, Name) :- 1058 nth_clause(Head, N, Ref), 1059 !, 1060 predicate_name(Head, PredName), 1061 thaffix(N, Th), 1062 format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]). 1063clause_name(Ref, Name) :- 1064 clause_property(Ref, erased), 1065 !, 1066 clause_property(Ref, predicate(M:PI)), 1067 format(string(Name), 'erased clause from ~q', [M:PI]). 1068clause_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. */