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-2018, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(prolog_clause, 38 [ clause_info/4, % +ClauseRef, -File, -TermPos, -VarNames 39 clause_info/5, % +ClauseRef, -File, -TermPos, -VarNames, 40 % +Options 41 initialization_layout/4, % +SourceLoc, +Goal, -Term, -TermPos 42 predicate_name/2, % +Head, -Name 43 clause_name/2 % +ClauseRef, -Name 44 ]). 45:- autoload(library(debug),[debugging/1,debug/3]). 46:- autoload(library(listing),[portray_clause/1]). 47:- autoload(library(lists),[append/3]). 48:- autoload(library(occurs),[sub_term/2]). 49:- autoload(library(option),[option/3]). 50:- autoload(library(prolog_source),[read_source_term_at_location/3]). 51 52 53:- public % called from library(trace/clause) 54 unify_term/2, 55 make_varnames/5, 56 do_make_varnames/3. 57 58:- multifile 59 unify_goal/5, % +Read, +Decomp, +M, +Pos, -Pos 60 unify_clause_hook/5, 61 make_varnames_hook/5, 62 open_source/2. % +Input, -Stream 63 64:- predicate_options(prolog_clause:clause_info/5, 5, 65 [ head(-any), 66 body(-any), 67 variable_names(-list) 68 ]).
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:
103clause_info(ClauseRef, File, TermPos, NameOffset) :- 104 clause_info(ClauseRef, File, TermPos, NameOffset, []). 105 106clause_info(ClauseRef, File, TermPos, NameOffset, Options) :- 107 ( debugging(clause_info) 108 -> clause_name(ClauseRef, Name), 109 debug(clause_info, 'clause_info(~w) (~w)... ', 110 [ClauseRef, Name]) 111 ; true 112 ), 113 clause_property(ClauseRef, file(File)), 114 File \== user, % loaded using ?- [user]. 115 '$clause'(Head0, Body, ClauseRef, VarOffset), 116 option(head(Head0), Options, _), 117 option(body(Body), Options, _), 118 ( module_property(Module, file(File)) 119 -> true 120 ; strip_module(user:Head0, Module, _) 121 ), 122 unqualify(Head0, Module, Head), 123 ( Body == true 124 -> DecompiledClause = Head 125 ; DecompiledClause = (Head :- Body) 126 ), 127 clause_property(ClauseRef, line_count(LineNo)), 128 debug(clause_info, 'from ~w:~d ... ', [File, LineNo]), 129 read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames), 130 option(variable_names(VarNames), Options, _), 131 debug(clause_info, 'read ...', []), 132 unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos), 133 debug(clause_info, 'unified ...', []), 134 make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset), 135 debug(clause_info, 'got names~n', []), 136 !. 137 138unqualify(Module:Head, Module, Head) :- 139 !. 140unqualify(Head, _, Head).
NOTE: Called directly from library(trace/clause) for the GUI
tracer.
154unify_term(X, X) :- !. 155unify_term(X1, X2) :- 156 compound(X1), 157 compound(X2), 158 functor(X1, F, Arity), 159 functor(X2, F, Arity), 160 !, 161 unify_args(0, Arity, X1, X2). 162unify_term(X, Y) :- 163 float(X), float(Y), 164 !. 165unify_term(X, '$BLOB'(_)) :- 166 blob(X, _), 167 \+ atom(X). 168unify_term(X, Y) :- 169 string(X), 170 is_list(Y), 171 string_codes(X, Y), 172 !. 173unify_term(_, Y) :- 174 Y == '...', 175 !. % elipses left by max_depth 176unify_term(_:X, Y) :- 177 unify_term(X, Y), 178 !. 179unify_term(X, _:Y) :- 180 unify_term(X, Y), 181 !. 182unify_term(X, Y) :- 183 format('[INTERNAL ERROR: Diff:~n'), 184 portray_clause(X), 185 format('~N*** <->~n'), 186 portray_clause(Y), 187 break. 188 189unify_args(N, N, _, _) :- !. 190unify_args(I, Arity, T1, T2) :- 191 A is I + 1, 192 arg(A, T1, A1), 193 arg(A, T2, A2), 194 unify_term(A1, A2), 195 unify_args(A, Arity, T1, T2).
203read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :- 204 setup_call_cleanup( 205 '$push_input_context'(clause_info), 206 read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames), 207 '$pop_input_context'). 208 209read_term_at_line_2(File, Line, Module, Clause, TermPos, VarNames) :- 210 catch(try_open_source(File, In), error(_,_), fail), 211 set_stream(In, newline(detect)), 212 call_cleanup( 213 read_source_term_at_location( 214 In, Clause, 215 [ line(Line), 216 module(Module), 217 subterm_positions(TermPos), 218 variable_names(VarNames) 219 ]), 220 close(In)).
clause_property(ClauseRef, file(File)), prolog_clause:open_source(File, Stream)
233:- public try_open_source/2. % used by library(prolog_breakpoints). 234 235try_open_source(File, In) :- 236 open_source(File, In), 237 !. 238try_open_source(File, In) :- 239 open(File, read, In).
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.
258make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :- 259 make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term), 260 !. 261make_varnames((Head --> _Body), _, Offsets, Names, Bindings) :- 262 !, 263 functor(Head, _, Arity), 264 In is Arity, 265 memberchk(In=IVar, Offsets), 266 Names1 = ['<DCG_list>'=IVar|Names], 267 Out is Arity + 1, 268 memberchk(Out=OVar, Offsets), 269 Names2 = ['<DCG_tail>'=OVar|Names1], 270 make_varnames(xx, xx, Offsets, Names2, Bindings). 271make_varnames(_, _, Offsets, Names, Bindings) :- 272 length(Offsets, L), 273 functor(Bindings, varnames, L), 274 do_make_varnames(Offsets, Names, Bindings). 275 276do_make_varnames([], _, _). 277do_make_varnames([N=Var|TO], Names, Bindings) :- 278 ( find_varname(Var, Names, Name) 279 -> true 280 ; Name = '_' 281 ), 282 AN is N + 1, 283 arg(AN, Bindings, Name), 284 do_make_varnames(TO, Names, Bindings). 285 286find_varname(Var, [Name = TheVar|_], Name) :- 287 Var == TheVar, 288 !. 289find_varname(Var, [_|T], Name) :- 290 find_varname(Var, T, Name).
This predicate calls the multifile predicate unify_clause_hook/5 with the same arguments to support user extensions.
306unify_clause(Read, Decompiled, _, TermPos, TermPos) :- 307 Read =@= Decompiled, 308 !, 309 Read = Decompiled. 310 % XPCE send-methods 311unify_clause(Read, Decompiled, Module, TermPos0, TermPos) :- 312 unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos), 313 !. 314unify_clause(:->(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :- 315 !, 316 pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos). 317 % XPCE get-methods 318unify_clause(:<-(Head, Body), (PlHead :- PlBody), M, TermPos0, TermPos) :- 319 !, 320 pce_method_clause(Head, Body, PlHead, PlBody, M, TermPos0, TermPos). 321 % Unit test clauses 322unify_clause((TH :- Body), 323 (_:'unit body'(_, _) :- !, Body), _, 324 TP0, TP) :- 325 ( TH = test(_,_) 326 ; TH = test(_) 327 ), 328 !, 329 TP0 = term_position(F,T,FF,FT,[HP,BP]), 330 TP = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]). 331 % module:head :- body 332unify_clause((Head :- Read), 333 (Head :- _M:Compiled), Module, TermPos0, TermPos) :- 334 unify_clause((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1), 335 TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]), 336 TermPos = term_position(TA,TZ,FA,FZ, 337 [ PH, 338 term_position(0,0,0,0,[0-0,PB]) 339 ]). 340 % DCG rules 341unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :- 342 Read = (_ --> Terminal, _), 343 is_list(Terminal), 344 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 345 Compiled2 = (DH :- _), 346 functor(DH, _, Arity), 347 DArg is Arity - 1, 348 append(Terminal, _Tail, List), 349 arg(DArg, DH, List), 350 TermPos1 = term_position(F,T,FF,FT,[ HP, 351 term_position(_,_,_,_,[_,BP]) 352 ]), 353 !, 354 TermPos2 = term_position(F,T,FF,FT,[ HP, BP ]), 355 match_module(Compiled2, Compiled1, Module, TermPos2, TermPos). 356 % general term-expansion 357unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :- 358 ci_expand(Read, Compiled2, Module, TermPos0, TermPos1), 359 match_module(Compiled2, Compiled1, Module, TermPos1, TermPos). 360 % I don't know ... 361unify_clause(_, _, _, _, _) :- 362 debug(clause_info, 'Could not unify clause', []), 363 fail. 364 365unify_clause_head(H1, H2) :- 366 strip_module(H1, _, H), 367 strip_module(H2, _, H). 368 369ci_expand(Read, Compiled, Module, TermPos0, TermPos) :- 370 catch(setup_call_cleanup( 371 ( set_xref_flag(OldXRef), 372 '$set_source_module'(Old, Module) 373 ), 374 expand_term(Read, TermPos0, Compiled, TermPos), 375 ( '$set_source_module'(Old), 376 set_prolog_flag(xref, OldXRef) 377 )), 378 E, 379 expand_failed(E, Read)). 380 381set_xref_flag(Value) :- 382 current_prolog_flag(xref, Value), 383 !, 384 set_prolog_flag(xref, true). 385set_xref_flag(false) :- 386 create_prolog_flag(xref, true, [type(boolean)]). 387 388match_module((H1 :- B1), (H2 :- B2), Module, Pos0, Pos) :- 389 !, 390 unify_clause_head(H1, H2), 391 unify_body(B1, B2, Module, Pos0, Pos). 392match_module((H1 :- B1), H2, _Module, Pos0, Pos) :- 393 B1 == true, 394 unify_clause_head(H1, H2), 395 Pos = Pos0, 396 !. 397match_module(H1, H2, _, Pos, Pos) :- % deal with facts 398 unify_clause_head(H1, H2).
404expand_failed(E, Read) :-
405 debugging(clause_info),
406 message_to_string(E, Msg),
407 debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
408 fail.Pos0 and Pos still include the term-position of the head.
417unify_body(B, C, _, Pos, Pos) :- 418 B =@= C, B = C, 419 does_not_dcg_after_binding(B, Pos), 420 !. 421unify_body(R, D, Module, 422 term_position(F,T,FF,FT,[HP,BP0]), 423 term_position(F,T,FF,FT,[HP,BP])) :- 424 ubody(R, D, Module, BP0, BP).
434does_not_dcg_after_binding(B, Pos) :- 435 \+ sub_term(brace_term_position(_,_,_), Pos), 436 \+ (sub_term((Cut,_=_), B), Cut == !), 437 !. 438 439 440/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 441Some remarks. 442 443a --> { x, y, z }. 444 This is translated into "(x,y),z), X=Y" by the DCG translator, after 445 which the compiler creates "a(X,Y) :- x, y, z, X=Y". 446- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
461ubody(B, DB, _, P, P) :- 462 var(P), % TBD: Create compatible pos term? 463 !, 464 B = DB. 465ubody(B, C, _, P, P) :- 466 B =@= C, B = C, 467 does_not_dcg_after_binding(B, P), 468 !. 469ubody(X0, X, M, parentheses_term_position(_, _, P0), P) :- 470 !, 471 ubody(X0, X, M, P0, P). 472ubody(X, call(X), _, % X = call(X) 473 Pos, 474 term_position(From, To, From, To, [Pos])) :- 475 !, 476 arg(1, Pos, From), 477 arg(2, Pos, To). 478ubody(A, B, _, P1, P2) :- 479 nonvar(A), A = (_=_), 480 nonvar(B), B = (LB=RB), 481 A =@= (RB=LB), 482 !, 483 P1 = term_position(F,T, FF,FT, [PL,PR]), 484 P2 = term_position(F,T, FF,FT, [PR,PL]). 485ubody(A, B, _, P1, P2) :- 486 nonvar(A), A = (_==_), 487 nonvar(B), B = (LB==RB), 488 A =@= (RB==LB), 489 !, 490 P1 = term_position(F,T, FF,FT, [PL,PR]), 491 P2 = term_position(F,T, FF,FT, [PR,PL]). 492ubody(B, D, _, term_position(_,_,_,_,[_,RP]), TPOut) :- 493 nonvar(B), B = M:R, 494 ubody(R, D, M, RP, TPOut). 495ubody(B0, B, M, 496 brace_term_position(F,T,A0), 497 Pos) :- 498 B0 = (_,_=_), 499 !, 500 T1 is T - 1, 501 ubody(B0, B, M, 502 term_position(F,T, 503 F,T, 504 [A0,T1-T]), 505 Pos). 506ubody(B0, B, M, 507 brace_term_position(F,T,A0), 508 term_position(F,T,F,T,[A])) :- 509 !, 510 ubody(B0, B, M, A0, A). 511ubody(C0, C, M, P0, P) :- 512 nonvar(C0), nonvar(C), 513 C0 = (_,_), C = (_,_), 514 !, 515 conj(C0, P0, GL, PL), 516 mkconj(C, M, P, GL, PL). 517ubody(Read, Decompiled, Module, TermPosRead, TermPosDecompiled) :- 518 unify_goal(Read, Decompiled, Module, TermPosRead, TermPosDecompiled), 519 !. 520ubody(X0, X, M, 521 term_position(F,T,FF,TT,PA0), 522 term_position(F,T,FF,TT,PA)) :- 523 meta(M, X0, S), 524 !, 525 X0 =.. [_|A0], 526 X =.. [_|A], 527 S =.. [_|AS], 528 ubody_list(A0, A, AS, M, PA0, PA). 529ubody(X0, X, M, 530 term_position(F,T,FF,TT,PA0), 531 term_position(F,T,FF,TT,PA)) :- 532 expand_goal(X0, X1, M, PA0, PA), 533 X1 =@= X, 534 X1 = X. 535 536 % 5.7.X optimizations 537ubody(_=_, true, _, % singleton = Any 538 term_position(F,T,_FF,_TT,_PA), 539 F-T) :- !. 540ubody(_==_, fail, _, % singleton/firstvar == Any 541 term_position(F,T,_FF,_TT,_PA), 542 F-T) :- !. 543ubody(A1=B1, B2=A2, _, % Term = Var --> Var = Term 544 term_position(F,T,FF,TT,[PA1,PA2]), 545 term_position(F,T,FF,TT,[PA2,PA1])) :- 546 var(B1), var(B2), 547 (A1==B1) =@= (B2==A2), 548 !, 549 A1 = A2, B1=B2. 550ubody(A1==B1, B2==A2, _, % const == Var --> Var == const 551 term_position(F,T,FF,TT,[PA1,PA2]), 552 term_position(F,T,FF,TT,[PA2,PA1])) :- 553 var(B1), var(B2), 554 (A1==B1) =@= (B2==A2), 555 !, 556 A1 = A2, B1=B2. 557ubody(A is B - C, A is B + C2, _, Pos, Pos) :- 558 integer(C), 559 C2 =:= -C, 560 !. 561 562ubody_list([], [], [], _, [], []). 563ubody_list([G0|T0], [G|T], [AS|ASL], M, [PA0|PAT0], [PA|PAT]) :- 564 ubody_elem(AS, G0, G, M, PA0, PA), 565 ubody_list(T0, T, ASL, M, PAT0, PAT). 566 567ubody_elem(0, G0, G, M, PA0, PA) :- 568 !, 569 ubody(G0, G, M, PA0, PA). 570ubody_elem(_, G, G, _, PA, PA). 571 572conj(Goal, Pos, GoalList, PosList) :- 573 conj(Goal, Pos, GoalList, [], PosList, []). 574 575conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :- 576 !, 577 conj(A, PA, GL, TGA, PL, TPA), 578 conj(B, PB, TGA, TG, TPA, TP). 579conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :- 580 B = (_=_), 581 !, 582 conj(A, PA, GL, TGA, PL, TPA), 583 T1 is T - 1, 584 conj(B, T1-T, TGA, TG, TPA, TP). 585conj(A, parentheses_term_position(_,_,Pos), GL, TG, PL, TP) :- 586 nonvar(Pos), 587 !, 588 conj(A, Pos, GL, TG, PL, TP). 589conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :- 590 F1 is F+1, 591 T1 is T+1. 592conj(A, P, [A|TG], TG, [P|TP], TP). 593 594 595mkconj(Goal, M, Pos, GoalList, PosList) :- 596 mkconj(Goal, M, Pos, GoalList, [], PosList, []). 597 598mkconj(Conj, M, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :- 599 nonvar(Conj), 600 Conj = (A,B), 601 !, 602 mkconj(A, M, PA, GL, TGA, PL, TPA), 603 mkconj(B, M, PB, TGA, TG, TPA, TP). 604mkconj(A0, M, P0, [A|TG], TG, [P|TP], TP) :- 605 ubody(A, A0, M, P, P0). 606 607 608 /******************************* 609 * PCE STUFF (SHOULD MOVE) * 610 *******************************/ 611 612/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 613 <method>(Receiver, ... Arg ...) :-> 614 Body 615 616mapped to: 617 618 send_implementation(Id, <method>(...Arg...), Receiver) 619 620- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 621 622pce_method_clause(Head, Body, M:PlHead, PlBody, _, TermPos0, TermPos) :- 623 !, 624 pce_method_clause(Head, Body, PlBody, PlHead, M, TermPos0, TermPos). 625pce_method_clause(Head, Body, 626 send_implementation(_Id, Msg, Receiver), PlBody, 627 M, TermPos0, TermPos) :- 628 !, 629 debug(clause_info, 'send method ...', []), 630 arg(1, Head, Receiver), 631 functor(Head, _, Arity), 632 pce_method_head_arguments(2, Arity, Head, Msg), 633 debug(clause_info, 'head ...', []), 634 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 635pce_method_clause(Head, Body, 636 get_implementation(_Id, Msg, Receiver, Result), PlBody, 637 M, TermPos0, TermPos) :- 638 !, 639 debug(clause_info, 'get method ...', []), 640 arg(1, Head, Receiver), 641 debug(clause_info, 'receiver ...', []), 642 functor(Head, _, Arity), 643 arg(Arity, Head, PceResult), 644 debug(clause_info, '~w?~n', [PceResult = Result]), 645 pce_unify_head_arg(PceResult, Result), 646 Ar is Arity - 1, 647 pce_method_head_arguments(2, Ar, Head, Msg), 648 debug(clause_info, 'head ...', []), 649 pce_method_body(Body, PlBody, M, TermPos0, TermPos). 650 651pce_method_head_arguments(N, Arity, Head, Msg) :- 652 N =< Arity, 653 !, 654 arg(N, Head, PceArg), 655 PLN is N - 1, 656 arg(PLN, Msg, PlArg), 657 pce_unify_head_arg(PceArg, PlArg), 658 debug(clause_info, '~w~n', [PceArg = PlArg]), 659 NextArg is N+1, 660 pce_method_head_arguments(NextArg, Arity, Head, Msg). 661pce_method_head_arguments(_, _, _, _). 662 663pce_unify_head_arg(V, A) :- 664 var(V), 665 !, 666 V = A. 667pce_unify_head_arg(A:_=_, A) :- !. 668pce_unify_head_arg(A:_, A). 669 670% pce_method_body(+SrcBody, +DbBody, +M, +TermPos0, -TermPos 671% 672% Unify the body of an XPCE method. Goal-expansion makes this 673% rather tricky, especially as we cannot call XPCE's expansion 674% on an isolated method. 675% 676% TermPos0 is the term-position term of the whole clause! 677% 678% Further, please note that the body of the method-clauses reside 679% in another module than pce_principal, and therefore the body 680% starts with an I_CONTEXT call. This implies we need a 681% hypothetical term-position for the module-qualifier. 682 683pce_method_body(A0, A, M, TermPos0, TermPos) :- 684 TermPos0 = term_position(F, T, FF, FT, 685 [ HeadPos, 686 BodyPos0 687 ]), 688 TermPos = term_position(F, T, FF, FT, 689 [ HeadPos, 690 term_position(0,0,0,0, [0-0,BodyPos]) 691 ]), 692 pce_method_body2(A0, A, M, BodyPos0, BodyPos). 693 694 695pce_method_body2(::(_,A0), A, M, TermPos0, TermPos) :- 696 !, 697 TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]), 698 TermPos = BodyPos, 699 expand_goal(A0, A, M, BodyPos0, BodyPos). 700pce_method_body2(A0, A, M, TermPos0, TermPos) :- 701 A0 =.. [Func,B0,C0], 702 control_op(Func), 703 !, 704 A =.. [Func,B,C], 705 TermPos0 = term_position(F, T, FF, FT, 706 [ BP0, 707 CP0 708 ]), 709 TermPos = term_position(F, T, FF, FT, 710 [ BP, 711 CP 712 ]), 713 pce_method_body2(B0, B, M, BP0, BP), 714 expand_goal(C0, C, M, CP0, CP). 715pce_method_body2(A0, A, M, TermPos0, TermPos) :- 716 expand_goal(A0, A, M, TermPos0, TermPos). 717 718control_op(','). 719control_op((;)). 720control_op((->)). 721control_op((*->)). 722 723 /******************************* 724 * EXPAND_GOAL SUPPORT * 725 *******************************/ 726 727/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 728With the introduction of expand_goal, it is increasingly hard to relate 729the clause from the database to the actual source. For one thing, we do 730not know the compilation module of the clause (unless we want to 731decompile it). 732 733Goal expansion can translate goals into control-constructs, multiple 734clauses, or delete a subgoal. 735 736To keep track of the source-locations, we have to redo the analysis of 737the clause as defined in init.pl 738- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 739 740expand_goal(G, call(G), _, P, term_position(0,0,0,0,[P])) :- 741 var(G), 742 !. 743expand_goal(G, G1, _, P, P) :- 744 var(G), 745 !, 746 G1 = G. 747expand_goal(M0, M, Module, P0, P) :- 748 meta(Module, M0, S), 749 !, 750 P0 = term_position(F,T,FF,FT,PL0), 751 P = term_position(F,T,FF,FT,PL), 752 functor(M0, Functor, Arity), 753 functor(M, Functor, Arity), 754 expand_meta_args(PL0, PL, 1, S, Module, M0, M). 755expand_goal(A, B, Module, P0, P) :- 756 goal_expansion(A, B0, P0, P1), 757 !, 758 expand_goal(B0, B, Module, P1, P). 759expand_goal(A, A, _, P, P). 760 761expand_meta_args([], [], _, _, _, _, _). 762expand_meta_args([P0|T0], [P|T], I, S, Module, M0, M) :- 763 arg(I, M0, A0), 764 arg(I, M, A), 765 arg(I, S, AS), 766 expand_arg(AS, A0, A, Module, P0, P), 767 NI is I + 1, 768 expand_meta_args(T0, T, NI, S, Module, M0, M). 769 770expand_arg(0, A0, A, Module, P0, P) :- 771 !, 772 expand_goal(A0, A, Module, P0, P). 773expand_arg(_, A, A, _, P, P). 774 775meta(M, G, S) :- predicate_property(M:G, meta_predicate(S)). 776 777goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :- 778 compound(Msg), 779 Msg =.. [send_super, Selector | Args], 780 !, 781 SuperMsg =.. [Selector|Args]. 782goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :- 783 compound(Msg), 784 Msg =.. [get_super, Selector | Args], 785 !, 786 SuperMsg =.. [Selector|Args]. 787goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P). 788goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P). 789goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :- 790 compound(SendSuperN), 791 compound_name_arguments(SendSuperN, send_super, [R,Sel|Args]), 792 Msg =.. [Sel|Args]. 793goal_expansion(SendN, send(R, Msg), P, P) :- 794 compound(SendN), 795 compound_name_arguments(SendN, send, [R,Sel|Args]), 796 atom(Sel), Args \== [], 797 Msg =.. [Sel|Args]. 798goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :- 799 compound(GetSuperN), 800 compound_name_arguments(GetSuperN, get_super, [R,Sel|AllArgs]), 801 append(Args, [Answer], AllArgs), 802 Msg =.. [Sel|Args]. 803goal_expansion(GetN, get(R, Msg, Answer), P, P) :- 804 compound(GetN), 805 compound_name_arguments(GetN, get, [R,Sel|AllArgs]), 806 append(Args, [Answer], AllArgs), 807 atom(Sel), Args \== [], 808 Msg =.. [Sel|Args]. 809goal_expansion(G0, G, P, P) :- 810 user:goal_expansion(G0, G), % TBD: we need the module! 811 G0 \== G. % \=@=? 812 813 814 /******************************* 815 * INITIALIZATION * 816 *******************************/
823initialization_layout(File:Line, M:Goal0, Goal, TermPos) :- 824 read_term_at_line(File, Line, M, Directive, DirectivePos, _), 825 Directive = (:- initialization(ReadGoal)), 826 DirectivePos = term_position(_, _, _, _, [InitPos]), 827 InitPos = term_position(_, _, _, _, [GoalPos]), 828 ( ReadGoal = M:_ 829 -> Goal = M:Goal0 830 ; Goal = Goal0 831 ), 832 unify_body(ReadGoal, Goal, M, GoalPos, TermPos), 833 !. 834 835 836 /******************************* 837 * PRINTABLE NAMES * 838 *******************************/ 839 840:- module_transparent 841 predicate_name/2. 842:- multifile 843 user:prolog_predicate_name/2, 844 user:prolog_clause_name/2. 845 (user). 847hidden_module(system). 848hidden_module(pce_principal). % should be config 849hidden_module(Module) :- % SWI-Prolog specific 850 import_module(Module, system). 851 852thaffix(1, st) :- !. 853thaffix(2, nd) :- !. 854thaffix(_, th).
860predicate_name(Predicate, PName) :-
861 strip_module(Predicate, Module, Head),
862 ( user:prolog_predicate_name(Module:Head, PName)
863 -> true
864 ; functor(Head, Name, Arity),
865 ( hidden_module(Module)
866 -> format(string(PName), '~q/~d', [Name, Arity])
867 ; format(string(PName), '~q:~q/~d', [Module, Name, Arity])
868 )
869 ).875clause_name(Ref, Name) :- 876 user:prolog_clause_name(Ref, Name), 877 !. 878clause_name(Ref, Name) :- 879 nth_clause(Head, N, Ref), 880 !, 881 predicate_name(Head, PredName), 882 thaffix(N, Th), 883 format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]). 884clause_name(Ref, Name) :- 885 clause_property(Ref, erased), 886 !, 887 clause_property(Ref, predicate(M:PI)), 888 format(string(Name), 'erased clause from ~q', [M:PI]). 889clause_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. */