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-2021, 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:- autoload(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 :- Body), 344 (_:'unit body'(_, _) :- !, Body), _, 345 TP0, TP) :- 346 ( TH = test(_,_) 347 ; TH = test(_) 348 ), 349 !, 350 TP0 = term_position(F,T,FF,FT,[HP,BP]), 351 TP = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]). 352 % module:head :- body 353unify_clause((Head :- Read), 354 (Head :- _M:Compiled), Module, TermPos0, TermPos) :- 355 unify_clause2((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1), 356 TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]), 357 TermPos = term_position(TA,TZ,FA,FZ, 358 [ PH, 359 term_position(0,0,0,0,[0-0,PB]) 360 ]). 361 % DCG rules 362unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :- 363 Read = (_ --> Terminal, _), 364 is_list(Terminal), 365 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 366 Compiled2 = (DH :- _), 367 functor(DH, _, Arity), 368 DArg is Arity - 1, 369 append(Terminal, _Tail, List), 370 arg(DArg, DH, List), 371 TermPos1 = term_position(F,T,FF,FT,[ HP, 372 term_position(_,_,_,_,[_,BP]) 373 ]), 374 !, 375 TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]), 376 match_module(Compiled2, Compiled1, Module, TermPos2, TermPos). 377 % SSU rules 378unify_clause((Head,RCond => Body), (CHead :- CCondAndBody), Module, 379 term_position(F,T,FF,FT, 380 [ term_position(_,_,_,_,[HP,CP]), 381 BP 382 ]), 383 TermPos) :- 384 split_on_cut(CCondAndBody, CCond, CBody0), 385 !, 386 inlined_unification(RCond, CCond, RCond1, CCond1, Head, CP, CP1), 387 TermPos1 = term_position(F,T,FF,FT, [HP, BP1]), 388 BP2 = term_position(_,_,_,_, [FF-FT, BP]), % Represent (!, Body), placing 389 ( CCond1 == true % ! at => 390 -> BP1 = BP2, % Whole guard is inlined 391 unify_clause2((Head :- !, Body), (CHead :- !, CBody0), 392 Module, TermPos1, TermPos) 393 ; mkconj_pos(RCond1, CP1, (!,Body), BP2, RBody, BP1), 394 mkconj_npos(CCond1, (!,CBody0), CBody), 395 unify_clause2((Head :- RBody), (CHead :- CBody), 396 Module, TermPos1, TermPos) 397 ). 398unify_clause((Head => Body), Compiled1, Module, TermPos0, TermPos) :- 399 !, 400 unify_clause2(Head :- Body, Compiled1, Module, TermPos0, TermPos). 401unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :- 402 unify_clause2(Read, Decompiled, Module, TermPos0, TermPos). 403 404% mkconj, but also unify position info 405mkconj_pos((A,B), term_position(F,T,FF,FT,[PA,PB]), Ex, ExPos, Code, Pos) => 406 Code = (A,B1), 407 Pos = term_position(F,T,FF,FT,[PA,PB1]), 408 mkconj_pos(B, PB, Ex, ExPos, B1, PB1). 409mkconj_pos(Last, LastPos, Ex, ExPos, Code, Pos) => 410 Code = (Last,Ex), 411 Pos = term_position(_,_,_,_,[LastPos,ExPos]). 412 413% similar to mkconj, but we should __not__ optimize `true` away. 414mkconj_npos((A,B), Ex, Code) => 415 Code = (A,B1), 416 mkconj_npos(B, Ex, B1). 417mkconj_npos(A, Ex, Code) => 418 Code = (A,Ex).
424unify_clause2(Read, Decompiled, _, TermPos, TermPos) :- 425 Read =@= Decompiled, 426 !, 427 Read = Decompiled. 428unify_clause2(Read, Compiled1, Module, TermPos0, TermPos) :- 429 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 430 match_module(Compiled2, Compiled1, Module, TermPos1, TermPos). 431 % I don't know ... 432unify_clause2(_, _, _, _, _) :- 433 debug(clause_info, 'Could not unify clause', []), 434 fail. 435 436unify_clause_head(H1, H2) :- 437 strip_module(H1, _, H), 438 strip_module(H2, _, H).
445inlined_unification((V=T,RBody0), (CV=CT,CBody0), 446 RBody, CBody, RHead, BPos1, BPos), 447 inlineable_head_var(RHead, V2), 448 V == V2, 449 (V=T) =@= (CV=CT) => 450 argpos(2, BPos1, BPos2), 451 inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos). 452inlined_unification((V=T), (CV=CT), 453 RBody, CBody, RHead, BPos1, BPos), 454 inlineable_head_var(RHead, V2), 455 V == V2, 456 (V=T) =@= (CV=CT) => 457 RBody = true, 458 CBody = true, 459 argpos(2, BPos1, BPos). 460inlined_unification((V=T,RBody0), CBody0, 461 RBody, CBody, RHead, BPos1, BPos), 462 inlineable_head_var(RHead, V2), 463 V == V2, 464 \+ (CBody0 = (G1,_), G1 \=@= (V=T)) => 465 argpos(2, BPos1, BPos2), 466 inlined_unification(RBody0, CBody0, RBody, CBody, RHead, BPos2, BPos). 467inlined_unification((V=_), true, 468 RBody, CBody, RHead, BPos1, BPos), 469 inlineable_head_var(RHead, V2), 470 V == V2 => 471 RBody = true, 472 CBody = true, 473 argpos(2, BPos1, BPos). 474inlined_unification(RBody0, CBody0, RBody, CBody, _RHead, 475 BPos0, BPos) => 476 RBody = RBody0, 477 BPos = BPos0, 478 CBody = CBody0.
485inlineable_head_var(Head, Var) :- 486 compound(Head), 487 arg(_, Head, Var). 488 489split_on_cut((Cond0,!,Body0), Cond, Body) => 490 Cond = Cond0, 491 Body = Body0. 492split_on_cut((!,Body0), Cond, Body) => 493 Cond = true, 494 Body = Body0. 495split_on_cut((A,B), Cond, Body) => 496 Cond = (A,Cond1), 497 split_on_cut(B, Cond1, Body). 498split_on_cut(_, _, _) => 499 fail. 500 501ci_expand(Read, Compiled, Module, TermPos0, TermPos) :- 502 catch(setup_call_cleanup( 503 ( set_xref_flag(OldXRef), 504 '$set_source_module'(Old, Module) 505 ), 506 expand_term(Read, TermPos0, Compiled, TermPos), 507 ( '$set_source_module'(Old), 508 set_prolog_flag(xref, OldXRef) 509 )), 510 E, 511 expand_failed(E, Read)), 512 compound(TermPos), % make sure somthing is filled. 513 arg(1, TermPos, A1), nonvar(A1), 514 arg(2, TermPos, A2), nonvar(A2). 515 516set_xref_flag(Value) :- 517 current_prolog_flag(xref, Value), 518 !, 519 set_prolog_flag(xref, true). 520set_xref_flag(false) :- 521 create_prolog_flag(xref, true, [type(boolean)]). 522 523match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :- 524 !, 525 unify_clause_head(H1, H2), 526 unify_body(B1, B2, Module, Pos0, Pos). 527match_module((H1 :- B1), H2, _Module, Pos0, Pos) :- 528 B1 == true, 529 unify_clause_head(H1, H2), 530 Pos = Pos0, 531 !. 532match_module(H1, H2, _, Pos, Pos) :- % deal with facts 533 unify_clause_head(H1, H2).
539expand_failed(E, Read) :-
540 debugging(clause_info),
541 message_to_string(E, Msg),
542 debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
543 fail.Pos0 and Pos still include the term-position of the head.
552unify_body(B, C, _, Pos, Pos) :- 553 B =@= C, B = C, 554 does_not_dcg_after_binding(B, Pos), 555 !. 556unify_body(R, D, Module, 557 term_position(F,T,FF,FT,[HP,BP0]), 558 term_position(F,T,FF,FT,[HP,BP])) :- 559 ubody(R, D, Module, BP0, BP).
569does_not_dcg_after_binding(B, Pos) :- 570 \+ sub_term(brace_term_position(_,_,_), Pos), 571 \+ (sub_term((Cut,_=_), B), Cut == !), 572 !. 573 574 575/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 576Some remarks. 577 578a --> { x, y, z }. 579 This is translated into "(x,y),z), X=Y" by the DCG translator, after 580 which the compiler creates "a(X,Y) :- x, y, z, X=Y". 581- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
596ubody(B, DB, _, P, P) :- 597 var(P), % TBD: Create compatible pos term? 598 !, 599 B = DB. 600ubody(B, C, _, P, P) :- 601 B =@= C, B = C, 602 does_not_dcg_after_binding(B, P), 603 !. 604ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :- 605 !, 606 ubody(X0, X, M, P0, P). 607ubody(X, Y, _, % X = call(X) 608 Pos, 609 term_position(From, To, From, To, [Pos])) :- 610 nonvar(Y), 611 Y = call(X), 612 !, 613 arg(1, Pos, From), 614 arg(2, Pos, To). 615ubody(A, B, _, P1, P2) :- 616 nonvar(A), A = (_=_), 617 nonvar(B), B = (LB=RB), 618 A =@= (RB=LB), 619 !, 620 P1 = term_position(F,T, FF,FT, [PL,PR]), 621 P2 = term_position(F,T, FF,FT, [PR,PL]). 622ubody(A, B, _, P1, P2) :- 623 nonvar(A), A = (_==_), 624 nonvar(B), B = (LB==RB), 625 A =@= (RB==LB), 626 !, 627 P1 = term_position(F,T, FF,FT, [PL,PR]), 628 P2 = term_position(F,T, FF,FT, [PR,PL]). 629ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :- 630 nonvar(B), B = M:R, 631 ubody(R, D, M, RP, TPOut). 632ubody(B, D, M, term_position(_,_,_,_,[RP0,RP1]), TPOut) :- 633 nonvar(B), B = (B0,B1), 634 ( maybe_optimized(B0), 635 ubody(B1, D, M, RP1, TPOut) 636 -> true 637 ; maybe_optimized(B1), 638 ubody(B0, D, M, RP0, TPOut) 639 ), 640 !. 641ubody(B0, B, M, 642 brace_term_position(F,T,A0), 643 Pos) :- 644 B0 = (_,_=_), 645 !, 646 T1 is T - 1, 647 ubody(B0, B, M, 648 term_position(F,T, 649 F,T, 650 [A0,T1-T]), 651 Pos). 652ubody(B0, B, M, 653 brace_term_position(F,T,A0), 654 term_position(F,T,F,T,[A])) :- 655 !, 656 ubody(B0, B, M, A0, A). 657ubody(C0, C, M, P0, P) :- 658 nonvar(C0), nonvar(C), 659 C0 = (_,_), C = (_,_), 660 !, 661 conj(C0, P0, GL, PL), 662 mkconj(C, M, P, GL, PL). 663ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :- 664 unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled), 665 !. 666ubody(X0, X, M, 667 term_position(F,T,FF,TT,PA0), 668 term_position(F,T,FF,TT,PA)) :- 669 callable(X0), 670 callable(X), 671 meta(M, X0, S), 672 !, 673 X0 =.. [_|A0], 674 X =.. [_|A], 675 S =.. [_|AS], 676 ubody_list(A0, A, AS, M, PA0, PA). 677ubody(X0, X, M, 678 term_position(F,T,FF,TT,PA0), 679 term_position(F,T,FF,TT,PA)) :- 680 expand_goal(X0, X1, M, PA0, PA), 681 X1 =@= X, 682 X1 = X. 683 684 % 5.7.X optimizations 685ubody(_=_, true, _, % singleton = Any 686 term_position(F,T,_FF,_TT,_PA), 687 F-T) :- !. 688ubody(_==_, fail, _, % singleton/firstvar == Any 689 term_position(F,T,_FF,_TT,_PA), 690 F-T) :- !. 691ubody(A1=B1, B2=A2, _, % Term = Var --> Var = Term 692 term_position(F,T,FF,TT,[PA1,PA2]), 693 term_position(F,T,FF,TT,[PA2,PA1])) :- 694 var(B1), var(B2), 695 (A1==B1) =@= (B2==A2), 696 !, 697 A1 = A2, B1=B2. 698ubody(A1==B1, B2==A2, _, % const == Var --> Var == const 699 term_position(F,T,FF,TT,[PA1,PA2]), 700 term_position(F,T,FF,TT,[PA2,PA1])) :- 701 var(B1), var(B2), 702 (A1==B1) =@= (B2==A2), 703 !, 704 A1 = A2, B1=B2. 705ubody(A is B - C, A is B + C2, _, Pos, Pos) :- 706 integer(C), 707 C2 =:= -C, 708 !. 709 710ubody_list([], [], [], _, [], []). 711ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :- 712 ubody_elem(AS, G0, G, M, PA0, PA), 713 ubody_list(T0, T, ASL, M, PAT0, PAT). 714 715ubody_elem(0, G0, G, M, PA0, PA) :- 716 !, 717 ubody(G0, G, M, PA0, PA). 718ubody_elem(_, G, G, _, PA, PA).
725conj(Goal, Pos, GoalList, PosList) :- 726 conj(Goal, Pos, GoalList, [], PosList, []). 727 728conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :- 729 !, 730 conj(A, PA, GL, TGA, PL, TPA), 731 conj(B, PB, TGA, TG, TPA, TP). 732conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :- 733 B = (_=_), 734 !, 735 conj(A, PA, GL, TGA, PL, TPA), 736 T1 is T - 1, 737 conj(B, T1-T, TGA, TG, TPA, TP). 738conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :- 739 nonvar(Pos), 740 !, 741 conj(A, Pos, GL, TG, PL, TP). 742conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :- 743 F1 is F+1, 744 T1 is T+1. 745conj(A, P, [A|TG], TG, [P|TP], TP).
750mkconj(Goal, M, Pos, GoalList, PosList) :- 751 mkconj(Goal, M, Pos, GoalList, [], PosList, []). 752 753mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :- 754 nonvar(Conj), 755 Conj = (A,B), 756 !, 757 mkconj(A, M, PA, GL, TGA, PL, TPA), 758 mkconj(B, M, PB, TGA, TG, TPA, TP). 759mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :- 760 ubody(A, A0, M, P, P0), 761 !. 762mkconj(A0, M, P0, [RG|TG0], TG, [_|TP0], TP) :- 763 maybe_optimized(RG), 764 mkconj(A0, M, P0, TG0, TG, TP0, TP). 765 766maybe_optimized(debug(_,_,_)). 767maybe_optimized(assertion(_)). 768maybe_optimized(true).
774argpos(N, parentheses_term_position(_,_,PosIn), Pos) => 775 argpos(N, PosIn, Pos). 776argpos(N, term_position(_,_,_,_,ArgPos), Pos) => 777 nth1(N, ArgPos, Pos). 778argpos(_, _, _) => true. 779 780 781 /******************************* 782 * PCE STUFF (SHOULD MOVE) * 783 *******************************/ 784 785/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 786 <method>(Receiver, ... Arg ...) :-> 787 Body 788 789mapped to: 790 791 send_implementation(Id, <method>(...Arg...), Receiver) 792 793- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 794 795pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :- 796 !, 797 pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos). 798pce_method_clause(Head, Body, 799 send_implementation(_Id, Msg, Receiver), PlBody, 800 M, TermPos0, TermPos) :- 801 !, 802 debug(clause_info, 'send method ...', []), 803 arg(1, Head, Receiver), 804 functor(Head, _, Arity), 805 pce_method_head_arguments(2, Arity, Head, Msg), 806 debug(clause_info, 'head ...', []), 807 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 808pce_method_clause(Head, Body, 809 get_implementation(_Id, Msg, Receiver, Result), PlBody, 810 M, TermPos0, TermPos) :- 811 !, 812 debug(clause_info, 'get method ...', []), 813 arg(1, Head, Receiver), 814 debug(clause_info, 'receiver ...', []), 815 functor(Head, _, Arity), 816 arg(Arity, Head, PceResult), 817 debug(clause_info, '~w?~n', [PceResult = Result]), 818 pce_unify_head_arg(PceResult, Result), 819 Ar is Arity - 1, 820 pce_method_head_arguments(2, Ar, Head, Msg), 821 debug(clause_info, 'head ...', []), 822 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 823 824pce_method_head_arguments(N, Arity, Head, Msg) :- 825 N =< Arity, 826 !, 827 arg(N, Head, PceArg), 828 PLN is N - 1, 829 arg(PLN, Msg, PlArg), 830 pce_unify_head_arg(PceArg, PlArg), 831 debug(clause_info, '~w~n', [PceArg = PlArg]), 832 NextArg is N+1, 833 pce_method_head_arguments(NextArg, Arity, Head, Msg). 834pce_method_head_arguments(_, _, _, _). 835 836pce_unify_head_arg(V, A) :- 837 var(V), 838 !, 839 V = A. 840pce_unify_head_arg(A:_=_, A) :- !. 841pce_unify_head_arg(A:_, A). 842 843% pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos 844% 845% Unify the body of an XPCE method. Goal-expansion makes this 846% rather tricky, especially as we cannot call XPCE's expansion 847% on an isolated method. 848% 849% TermPos0 is the term-position term of the whole clause! 850% 851% Further, please note that the body of the method-clauses reside 852% in another module than pce_principal, and therefore the body 853% starts with an I_CONTEXT call. This implies we need a 854% hypothetical term-position for the module-qualifier. 855 856pce_method_body(A0, A, M, TermPos0, TermPos) :- 857 TermPos0 = term_position(F, T, FF, FT, 858 [ HeadPos, 859 BodyPos0 860 ]), 861 TermPos = term_position(F, T, FF, FT, 862 [ HeadPos, 863 term_position(0,0,0,0, [0-0,BodyPos]) 864 ]), 865 pce_method_body2(A0, A, M, BodyPos0, BodyPos). 866 867 868pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :- 869 !, 870 TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]), 871 TermPos = BodyPos, 872 expand_goal(A0, A, M, BodyPos0, BodyPos). 873pce_method_body2(A0, A, M, TermPos0, TermPos) :- 874 A0 =.. [Func,B0,C0], 875 control_op(Func), 876 !, 877 A =.. [Func,B,C], 878 TermPos0 = term_position(F, T, FF, FT, 879 [ BP0, 880 CP0 881 ]), 882 TermPos = term_position(F, T, FF, FT, 883 [ BP, 884 CP 885 ]), 886 pce_method_body2(B0, B, M, BP0, BP), 887 expand_goal(C0, C, M, CP0, CP). 888pce_method_body2(A0, A, M, TermPos0, TermPos) :- 889 expand_goal(A0, A, M, TermPos0, TermPos). 890 891control_op(','). 892control_op((;)). 893control_op((->)). 894control_op((*->)). 895 896 /******************************* 897 * EXPAND_GOAL SUPPORT * 898 *******************************/ 899 900/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 901With the introduction of expand_goal, it is increasingly hard to relate 902the clause from the database to the actual source. For one thing, we do 903not know the compilation module of the clause (unless we want to 904decompile it). 905 906Goal expansion can translate goals into control-constructs, multiple 907clauses, or delete a subgoal. 908 909To keep track of the source-locations, we have to redo the analysis of 910the clause as defined in init.pl 911- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 912 913expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :- 914 var(G), 915 !. 916expand_goal(G, G1, _, P, P) :- 917 var(G), 918 !, 919 G1 = G. 920expand_goal(M0, M, Module, P0, P) :- 921 meta(Module, M0, S), 922 !, 923 P0 = term_position(F,T,FF,FT,PL0), 924 P = term_position(F,T,FF,FT,PL), 925 functor(M0, Functor, Arity), 926 functor(M, Functor, Arity), 927 expand_meta_args(PL0, PL, 1, S, Module, M0, M). 928expand_goal(A, B, Module, P0, P) :- 929 goal_expansion(A, B0, P0, P1), 930 !, 931 expand_goal(B0, B, Module, P1, P). 932expand_goal(A, A, _, P, P). 933 934expand_meta_args([], [], _, _, _, _, _). 935expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :- 936 arg(I, M0, A0), 937 arg(I, M, A), 938 arg(I, S, AS), 939 expand_arg(AS, A0, A, Module, P0, P), 940 NI is I + 1, 941 expand_meta_args(T0, T, NI, S, Module, M0, M). 942 943expand_arg(0, A0, A, Module, P0, P) :- 944 !, 945 expand_goal(A0, A, Module, P0, P). 946expand_arg(_, A, A, _, P, P). 947 948meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)). 949 950goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :- 951 compound(Msg), 952 Msg =.. [send_super, Selector | Args], 953 !, 954 SuperMsg =.. [Selector|Args]. 955goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :- 956 compound(Msg), 957 Msg =.. [get_super, Selector | Args], 958 !, 959 SuperMsg =.. [Selector|Args]. 960goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P). 961goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P). 962goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :- 963 compound(SendSuperN), 964 compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]), 965 Msg =.. [Sel|Args]. 966goal_expansion(SendN, send(R, Msg), P, P) :- 967 compound(SendN), 968 compound_name_arguments(SendN, send, [R,Sel|Args]), 969 atom(Sel), Args \== [], 970 Msg =.. [Sel|Args]. 971goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :- 972 compound(GetSuperN), 973 compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]), 974 append(Args, [Answer], AllArgs), 975 Msg =.. [Sel|Args]. 976goal_expansion(GetN, get(R, Msg, Answer), P, P) :- 977 compound(GetN), 978 compound_name_arguments(GetN, get, [R,Sel|AllArgs]), 979 append(Args, [Answer], AllArgs), 980 atom(Sel), Args \== [], 981 Msg =.. [Sel|Args]. 982goal_expansion(G0, G, P, P) :- 983 user:goal_expansion(G0, G), % TBD: we need the module! 984 G0 \== G. % \=@=? 985 986 987 /******************************* 988 * INITIALIZATION * 989 *******************************/
996initialization_layout(File:Line, M:Goal0, Goal, TermPos) :- 997 read_term_at_line(File, Line, M, Directive, DirectivePos, _), 998 Directive = (:- initialization(ReadGoal)), 999 DirectivePos = term_position(_, _, _, _, [InitPos]), 1000 InitPos = term_position(_, _, _, _, [GoalPos]), 1001 ( ReadGoal = M:_ 1002 -> Goal = M:Goal0 1003 ; Goal = Goal0 1004 ), 1005 unify_body(ReadGoal, Goal, M, GoalPos, TermPos), 1006 !. 1007 1008 1009 /******************************* 1010 * PRINTABLE NAMES * 1011 *******************************/ 1012 1013:- module_transparent 1014 predicate_name/2. 1015:- multifile 1016 user:prolog_predicate_name/2, 1017 user:prolog_clause_name/2. 1018 (user). 1020hidden_module(system). 1021hidden_module(pce_principal). % should be config 1022hidden_module(Module) :- % SWI-Prolog specific 1023 import_module(Module, system). 1024 1025thaffix(1, st) :- !. 1026thaffix(2, nd) :- !. 1027thaffix(_, th).
1033predicate_name(Predicate, PName) :-
1034 strip_module(Predicate, Module, Head),
1035 ( user:prolog_predicate_name(Module:Head, PName)
1036 -> true
1037 ; functor(Head, Name, Arity),
1038 ( hidden_module(Module)
1039 -> format(string(PName), '~q/~d', [Name, Arity])
1040 ; format(string(PName), '~q:~q/~d', [Module, Name, Arity])
1041 )
1042 ).1048clause_name(Ref, Name) :- 1049 user:prolog_clause_name(Ref, Name), 1050 !. 1051clause_name(Ref, Name) :- 1052 nth_clause(Head, N, Ref), 1053 !, 1054 predicate_name(Head, PredName), 1055 thaffix(N, Th), 1056 format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]). 1057clause_name(Ref, Name) :- 1058 clause_property(Ref, erased), 1059 !, 1060 clause_property(Ref, predicate(M:PI)), 1061 format(string(Name), 'erased clause from ~q', [M:PI]). 1062clause_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. */