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) 2012-2023, VU University Amsterdam 7 CWI, Amsterdam 8 SWI-Prolog Solutions b.v. 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_codewalk, 38 [ prolog_walk_code/1, % +Options 39 prolog_program_clause/2 % -ClauseRef, +Options 40 ]). 41:- use_module(library(record),[(record)/1, op(_,_,record)]). 42:- use_module(library(debug),[debug/3,debugging/1,assertion/1]). 43 44:- autoload(library(apply),[maplist/2]). 45:- autoload(library(error),[must_be/2]). 46:- autoload(library(listing),[portray_clause/1]). 47:- autoload(library(lists),[member/2,nth1/3,append/3]). 48:- autoload(library(option),[meta_options/3]). 49:- autoload(library(prolog_clause), 50 [clause_info/4,initialization_layout/4,clause_name/2]). 51:- autoload(library(prolog_metainference), 52 [inferred_meta_predicate/2,infer_meta_predicate/2]).
87:- meta_predicate 88 prolog_walk_code(). 89 90:- multifile 91 prolog:called_by/4, 92 prolog:called_by/2. 93 94:- predicate_options(prolog_walk_code/1, 1, 95 [ undefined(oneof([ignore,error,trace])), 96 autoload(boolean), 97 clauses(list), 98 module(atom), 99 module_class(list(oneof([user,system,library, 100 test,development]))), 101 source(boolean), 102 trace_reference(any), 103 trace_condition(callable), 104 on_trace(callable), 105 on_edge(callable), 106 infer_meta_predicates(oneof([false,true,all])), 107 walk_meta_predicates(boolean), 108 evaluate(boolean), 109 verbose(boolean) 110 ]). 111 112:- record 113 walk_option(undefined:oneof([ignore,error,trace])=ignore, 114 autoload:boolean=true, 115 source:boolean=true, 116 module:atom, % Only analyse given module 117 module_class:list(oneof([user,system,library, 118 test,development]))=[user,library], 119 infer_meta_predicates:oneof([false,true,all])=true, 120 walk_meta_predicates:boolean=true, 121 clauses:list, % Walk only these clauses 122 trace_reference:any=(-), 123 trace_condition:callable, % Call-back condition 124 on_edge:callable, % Call-back on trace hits 125 on_trace:callable, % Call-back on trace hits 126 % private stuff 127 clause, % Processed clause 128 caller, % Head of the caller 129 initialization, % Initialization source 130 undecided, % Error to throw error 131 evaluate:boolean, % Do partial evaluation 132 verbose:boolean=false). % Report progress 133 134:- thread_local 135 multifile_predicate/3. % Name, Arity, Module
Options processed:
ignore or
error (default is ignore).source(false) and then process only interesting
clauses with source information.user and library.true (default), analysis is
only restarted if the inferred meta-predicate contains a
callable argument. If all, it will be restarted until no
more new meta-predicates can be found.false (default true), do not analyse the arguments
of meta predicates. Standard Prolog control structures are
always analysed.trace_reference.
Called as call(Cond, Callee, Context), where Context is a
dict containing the following keys:
File:Line representing the location of the declaration.trace_reference is found, call
call(OnEdge, Callee, Caller, Location), where Location is a
dict containing a subset of the keys clause, file,
character_count, line_count and line_position. If
full position information is available all keys are present.
If the clause layout is unknown the only the clause, file
and line_count are available and the line is the start line
of the clause. For a dynamic clause, only the clause is
present. If the position is associated to a directive,
the clause is missing. If nothing is known the Location
is an empty dict.on_edge, but location is not translated and is one
of these:
clause_term_position(+ClauseRef, +TermPos)clause(+ClauseRef)file_term_position(+Path, +TermPos)file(+File, +Line, -1, _)Caller is the qualified head of the calling clause or the atom '<initialization>'.
false (default true), to not try to obtain detailed
source information for printed messages.true (default false), report derived meta-predicates
and iterations.
@compat OnTrace was called using Caller-Location in older versions.
245prolog_walk_code(Options) :- 246 meta_options(is_meta, Options, QOptions), 247 prolog_walk_code(1, QOptions). 248 249prolog_walk_code(Iteration, Options) :- 250 statistics(cputime, CPU0), 251 make_walk_option(Options, OTerm, _), 252 ( walk_option_clauses(OTerm, Clauses), 253 nonvar(Clauses) 254 -> walk_clauses(Clauses, OTerm) 255 ; forall(( walk_option_module(OTerm, M0), 256 copy_term(M0, M), 257 current_module(M), 258 scan_module(M, OTerm) 259 ), 260 find_walk_from_module(M, OTerm)), 261 walk_from_multifile(OTerm), 262 walk_from_initialization(OTerm) 263 ), 264 infer_new_meta_predicates(New, OTerm), 265 statistics(cputime, CPU1), 266 ( New \== [] 267 -> CPU is CPU1-CPU0, 268 ( walk_option_verbose(OTerm, true) 269 -> Level = informational 270 ; Level = silent 271 ), 272 print_message(Level, 273 codewalk(reiterate(New, Iteration, CPU))), 274 succ(Iteration, Iteration2), 275 prolog_walk_code(Iteration2, Options) 276 ; true 277 ). 278 279is_meta(on_edge). 280is_meta(on_trace). 281is_meta(trace_condition).
287walk_clauses(Clauses, OTerm) :-
288 must_be(list, Clauses),
289 forall(member(ClauseRef, Clauses),
290 ( user:clause(CHead, Body, ClauseRef),
291 ( CHead = Module:Head
292 -> true
293 ; Module = user,
294 Head = CHead
295 ),
296 walk_option_clause(OTerm, ClauseRef),
297 walk_option_caller(OTerm, Module:Head),
298 walk_called_by_body(Body, Module, OTerm)
299 )).305scan_module(M, OTerm) :- 306 walk_option_module(OTerm, M1), 307 nonvar(M1), 308 !, 309 \+ M \= M1. 310scan_module(M, OTerm) :- 311 walk_option_module_class(OTerm, Classes), 312 module_property(M, class(Class)), 313 memberchk(Class, Classes), 314 !.
323walk_from_initialization(OTerm) :- 324 walk_option_caller(OTerm, '<initialization>'), 325 forall(init_goal_in_scope(Goal, SourceLocation, OTerm), 326 ( walk_option_initialization(OTerm, SourceLocation), 327 walk_from_initialization(Goal, OTerm))). 328 329init_goal_in_scope(Goal, SourceLocation, OTerm) :- 330 '$init_goal'(_When, Goal, SourceLocation), 331 SourceLocation = File:_Line, 332 ( walk_option_module(OTerm, M), 333 nonvar(M) 334 -> module_property(M, file(File)) 335 ; walk_option_module_class(OTerm, Classes), 336 source_file_property(File, module(MF)) 337 -> module_property(MF, class(Class)), 338 memberchk(Class, Classes), 339 walk_option_module(OTerm, MF) 340 ; true 341 ). 342 343walk_from_initialization(M:Goal, OTerm) :- 344 scan_module(M, OTerm), 345 !, 346 walk_called_by_body(Goal, M, OTerm). 347walk_from_initialization(_, _).
355find_walk_from_module(M, OTerm) :- 356 debug(autoload, 'Analysing module ~q', [M]), 357 walk_option_module(OTerm, M), 358 forall(predicate_in_module(M, PI), 359 walk_called_by_pred(M:PI, OTerm)). 360 361walk_called_by_pred(Module:Name/Arity, _) :- 362 multifile_predicate(Name, Arity, Module), 363 !. 364walk_called_by_pred(Module:Name/Arity, _) :- 365 functor(Head, Name, Arity), 366 predicate_property(Module:Head, multifile), 367 !, 368 assertz(multifile_predicate(Name, Arity, Module)). 369walk_called_by_pred(Module:Name/Arity, OTerm) :- 370 functor(Head, Name, Arity), 371 ( no_walk_property(Property), 372 predicate_property(Module:Head, Property) 373 -> true 374 ; walk_option_caller(OTerm, Module:Head), 375 walk_option_clause(OTerm, ClauseRef), 376 forall(catch(clause(Module:, Body, ClauseRef), _, fail), 377 walk_called_by_body(Body, Module, OTerm)) 378 ). 379 380no_walk_property(number_of_rules(0)). % no point walking only facts 381no_walk_property(foreign). % cannot walk foreign code
387walk_from_multifile(OTerm) :- 388 forall(retract(multifile_predicate(Name, Arity, Module)), 389 walk_called_by_multifile(Module:Name/Arity, OTerm)). 390 391walk_called_by_multifile(Module:Name/Arity, OTerm) :- 392 functor(Head, Name, Arity), 393 forall(catch(clause_not_from_development( 394 Module:Head, Body, ClauseRef, OTerm), 395 _, fail), 396 ( walk_option_clause(OTerm, ClauseRef), 397 walk_option_caller(OTerm, Module:Head), 398 walk_called_by_body(Body, Module, OTerm) 399 )).
407clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
408 clause(Module:, Body, Ref),
409 \+ ( clause_property(Ref, file(File)),
410 module_property(LoadModule, file(File)),
411 \+ scan_module(LoadModule, OTerm)
412 ).ignore, error422walk_called_by_body(True, _, _) :- 423 True == true, 424 !. % quickly deal with facts 425walk_called_by_body(Body, Module, OTerm) :- 426 set_undecided_of_walk_option(error, OTerm, OTerm1), 427 set_evaluate_of_walk_option(false, OTerm1, OTerm2), 428 catch(walk_called(Body, Module, _TermPos, OTerm2), 429 missing(Missing), 430 walk_called_by_body(Missing, Body, Module, OTerm)), 431 !. 432walk_called_by_body(Body, Module, OTerm) :- 433 format(user_error, 'Failed to analyse:~n', []), 434 portray_clause(('<head>' :- Body)), 435 debug_walk(Body, Module, OTerm). 436 437% recompile this library after `debug(codewalk(trace))` and re-try 438% for debugging failures. 439:- if(debugging(codewalk(trace))). 440debug_walk(Body, Module, OTerm) :- 441 gtrace, 442 walk_called_by_body(Body, Module, OTerm). 443:- else. 444debug_walk(_,_,_). 445:- endif.
452walk_called_by_body(Missing, Body, _, OTerm) :- 453 debugging(codewalk), 454 format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]), 455 portray_clause(('<head>' :- Body)), fail. 456walk_called_by_body(undecided_call, Body, Module, OTerm) :- 457 catch(forall(walk_called(Body, Module, _TermPos, OTerm), 458 true), 459 missing(Missing), 460 walk_called_by_body(Missing, Body, Module, OTerm)). 461walk_called_by_body(subterm_positions, Body, Module, OTerm) :- 462 ( ( walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef), 463 clause_info(ClauseRef, _, TermPos, _NameOffset), 464 TermPos = term_position(_,_,_,_,[_,BodyPos]) 465 -> WBody = Body 466 ; walk_option_initialization(OTerm, SrcLoc), 467 ground(SrcLoc), SrcLoc = _File:_Line, 468 initialization_layout(SrcLoc, Module:Body, WBody, BodyPos) 469 ) 470 -> catch(forall(walk_called(WBody, Module, BodyPos, OTerm), 471 true), 472 missing(subterm_positions), 473 walk_called_by_body(no_positions, Body, Module, OTerm)) 474 ; set_source_of_walk_option(false, OTerm, OTerm2), 475 forall(walk_called(Body, Module, _BodyPos, OTerm2), 476 true) 477 ). 478walk_called_by_body(no_positions, Body, Module, OTerm) :- 479 set_source_of_walk_option(false, OTerm, OTerm2), 480 forall(walk_called(Body, Module, _NoPos, OTerm2), 481 true).
If Goal is disjunctive, walk_called succeeds with a
choice-point. Backtracking analyses the alternative control
path(s).
Options:
undecided_calltrue (default), evaluate some goals. Notably =/2.511walk_called(Term, Module, parentheses_term_position(_,_,Pos), OTerm) :- 512 nonvar(Pos), 513 !, 514 walk_called(Term, Module, Pos, OTerm). 515walk_called(Var, _, TermPos, OTerm) :- 516 var(Var), % Incomplete analysis 517 !, 518 undecided(Var, TermPos, OTerm). 519walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 520 !, 521 ( nonvar(M) 522 -> walk_called(G, M, Pos, OTerm) 523 ; undecided(M, MPos, OTerm) 524 ). 525walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 526 !, 527 walk_called(A, M, PA, OTerm), 528 walk_called(B, M, PB, OTerm). 529walk_called((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 530 !, 531 walk_called(A, M, PA, OTerm), 532 walk_called(B, M, PB, OTerm). 533walk_called((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 534 !, 535 walk_called(A, M, PA, OTerm), 536 walk_called(B, M, PB, OTerm). 537walk_called(\+(A), M, term_position(_,_,_,_,[PA]), OTerm) :- 538 !, 539 \+ \+ walk_called(A, M, PA, OTerm). 540walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 541 !, 542 ( walk_option_evaluate(OTerm, Eval), Eval == true 543 -> Goal = (A;B), 544 setof(Goal, 545 ( walk_called(A, M, PA, OTerm) 546 ; walk_called(B, M, PB, OTerm) 547 ), 548 Alts0), 549 variants(Alts0, Alts), 550 member(Goal, Alts) 551 ; \+ \+ walk_called(A, M, PA, OTerm), % do not propagate bindings 552 \+ \+ walk_called(B, M, PB, OTerm) 553 ). 554walk_called(Goal, Module, TermPos, OTerm) :- 555 walk_option_trace_reference(OTerm, To), To \== (-), 556 ( subsumes_term(To, Module:Goal) 557 -> M2 = Module 558 ; predicate_property(Module:Goal, imported_from(M2)), 559 subsumes_term(To, M2:Goal) 560 ), 561 trace_condition(M2:Goal, TermPos, OTerm), 562 print_reference(M2:Goal, TermPos, trace, OTerm), 563 fail. % Continue search 564walk_called(Goal, Module, _, OTerm) :- 565 evaluate(Goal, Module, OTerm), 566 !. 567walk_called(Goal, M, TermPos, OTerm) :- 568 ( ( predicate_property(M:Goal, imported_from(IM)) 569 -> true 570 ; IM = M 571 ), 572 prolog:called_by(Goal, IM, M, Called) 573 ; prolog:called_by(Goal, Called) 574 ), 575 Called \== [], 576 !, 577 walk_called_by(Called, M, Goal, TermPos, OTerm). 578walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :- 579 walk_option_walk_meta_predicates(OTerm, true), 580 ( walk_option_autoload(OTerm, false) 581 -> nonvar(M), 582 '$get_predicate_attribute'(M:Meta, defined, 1) 583 ; true 584 ), 585 ( predicate_property(M:Meta, meta_predicate(Head)) 586 ; inferred_meta_predicate(M:Meta, Head) 587 ), 588 !, 589 walk_option_clause(OTerm, ClauseRef), 590 register_possible_meta_clause(ClauseRef), 591 walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm). 592walk_called(Closure, _, _, _) :- 593 blob(Closure, closure), 594 !, 595 '$closure_predicate'(Closure, Module:Name/Arity), 596 functor(Head, Name, Arity), 597 '$get_predicate_attribute'(Module:Head, defined, 1). 598walk_called(ClosureCall, _, _, _) :- 599 compound(ClosureCall), 600 compound_name_arity(ClosureCall, Closure, _), 601 blob(Closure, closure), 602 !, 603 '$closure_predicate'(Closure, Module:Name/Arity), 604 functor(Head, Name, Arity), 605 '$get_predicate_attribute'(Module:Head, defined, 1). 606walk_called(Goal, Module, _, _) :- 607 nonvar(Module), 608 '$get_predicate_attribute'(Module:Goal, defined, 1), 609 !. 610walk_called(Goal, Module, TermPos, OTerm) :- 611 callable(Goal), 612 !, 613 undefined(Module:Goal, TermPos, OTerm). 614walk_called(Goal, _Module, TermPos, OTerm) :- 615 not_callable(Goal, TermPos, OTerm).
call(Condition, Callee, Dict)621trace_condition(Callee, TermPos, OTerm) :- 622 walk_option_trace_condition(OTerm, Cond), nonvar(Cond), 623 !, 624 cond_location_context(OTerm, TermPos, Context0), 625 walk_option_caller(OTerm, Caller), 626 walk_option_module(OTerm, Module), 627 put_dict(#{caller:Caller, module:Module}, Context0, Context), 628 call(Cond, Callee, Context). 629trace_condition(_, _, _). 630 631cond_location_context(OTerm, _TermPos, Context) :- 632 walk_option_clause(OTerm, Clause), nonvar(Clause), 633 !, 634 Context = #{clause:Clause}. 635cond_location_context(OTerm, _TermPos, Context) :- 636 walk_option_initialization(OTerm, Init), nonvar(Init), 637 !, 638 Context = #{initialization:Init}.
642undecided(Var, TermPos, OTerm) :- 643 walk_option_undecided(OTerm, Undecided), 644 ( var(Undecided) 645 -> Action = ignore 646 ; Action = Undecided 647 ), 648 undecided(Action, Var, TermPos, OTerm). 649 650undecided(ignore, _, _, _) :- !. 651undecided(error, _, _, _) :- 652 throw(missing(undecided_call)).
656evaluate(Goal, Module, OTerm) :- 657 walk_option_evaluate(OTerm, Evaluate), 658 Evaluate \== false, 659 evaluate(Goal, Module). 660 661evaluate(A=B, _) :- 662 unify_with_occurs_check(A, B).
668undefined(_, _, OTerm) :- 669 walk_option_undefined(OTerm, ignore), 670 !. 671undefined(Goal, _, _) :- 672 predicate_property(Goal, autoload(_)), 673 !. 674undefined(Goal, TermPos, OTerm) :- 675 ( walk_option_undefined(OTerm, trace) 676 -> Why = trace 677 ; Why = undefined 678 ), 679 print_reference(Goal, TermPos, Why, OTerm).
685not_callable(Goal, TermPos, OTerm) :-
686 print_reference(Goal, TermPos, not_callable, OTerm).695print_reference(Goal, TermPos, Why, OTerm) :- 696 walk_option_clause(OTerm, Clause), nonvar(Clause), 697 !, 698 ( compound(TermPos), 699 arg(1, TermPos, CharCount), 700 integer(CharCount) % test it is valid 701 -> From = clause_term_position(Clause, TermPos) 702 ; walk_option_source(OTerm, false) 703 -> From = clause(Clause) 704 ; From = _, 705 throw(missing(subterm_positions)) 706 ), 707 print_reference2(Goal, From, Why, OTerm). 708print_reference(Goal, TermPos, Why, OTerm) :- 709 walk_option_initialization(OTerm, Init), nonvar(Init), 710 Init = File:Line, 711 !, 712 ( compound(TermPos), 713 arg(1, TermPos, CharCount), 714 integer(CharCount) % test it is valid 715 -> From = file_term_position(File, TermPos) 716 ; walk_option_source(OTerm, false) 717 -> From = file(File, Line, -1, _) 718 ; From = _, 719 throw(missing(subterm_positions)) 720 ), 721 print_reference2(Goal, From, Why, OTerm). 722print_reference(Goal, _, Why, OTerm) :- 723 print_reference2(Goal, _, Why, OTerm). 724 725print_reference2(Goal, From, trace, OTerm) :- 726 walk_option_on_trace(OTerm, Closure), 727 nonvar(Closure), 728 walk_option_caller(OTerm, Caller), 729 call(Closure, Goal, Caller, From), 730 !. 731print_reference2(Goal, From, trace, OTerm) :- 732 walk_option_on_edge(OTerm, Closure), 733 nonvar(Closure), 734 walk_option_caller(OTerm, Caller), 735 translate_location(From, Dict), 736 call(Closure, Goal, Caller, Dict), 737 !. 738print_reference2(Goal, From, Why, _OTerm) :- 739 make_message(Why, Goal, From, Message, Level), 740 print_message(Level, Message). 741 742 743make_message(undefined, Goal, Context, 744 error(existence_error(procedure, PI), Context), error) :- 745 goal_pi(Goal, PI). 746make_message(not_callable, Goal, Context, 747 error(type_error(callable, Goal), Context), error). 748make_message(trace, Goal, Context, 749 trace_call_to(PI, Context), informational) :- 750 goal_pi(Goal, PI). 751 752 753goal_pi(Goal, M:Name/Arity) :- 754 strip_module(Goal, M, Head), 755 callable(Head), 756 !, 757 functor(Head, Name, Arity). 758goal_pi(Goal, Goal). 759 760:- dynamic 761 possible_meta_predicate/2.
770register_possible_meta_clause(ClausesRef) :- 771 nonvar(ClausesRef), 772 clause_property(ClausesRef, predicate(PI)), 773 pi_head(PI, Head, Module), 774 module_property(Module, class(user)), 775 \+ predicate_property(Module:Head, meta_predicate(_)), 776 \+ inferred_meta_predicate(Module:Head, _), 777 \+ possible_meta_predicate(Head, Module), 778 !, 779 assertz(possible_meta_predicate(Head, Module)). 780register_possible_meta_clause(_). 781 782pi_head(Module:Name/Arity, Head, Module) :- 783 !, 784 functor(Head, Name, Arity). 785pi_head(_, _, _) :- 786 assertion(fail).
790infer_new_meta_predicates([], OTerm) :- 791 walk_option_infer_meta_predicates(OTerm, false), 792 !. 793infer_new_meta_predicates(MetaSpecs, OTerm) :- 794 findall(Module:MetaSpec, 795 ( retract(possible_meta_predicate(Head, Module)), 796 infer_meta_predicate(Module:Head, MetaSpec), 797 ( walk_option_infer_meta_predicates(OTerm, all) 798 -> true 799 ; calling_metaspec(MetaSpec) 800 ) 801 ), 802 MetaSpecs).
809calling_metaspec(Head) :- 810 arg(_, Head, Arg), 811 calling_metaarg(Arg), 812 !. 813 814calling_metaarg(I) :- integer(I), !. 815calling_metaarg(^). 816calling_metaarg(//).
829walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :- 830 arg(I, Head, AS), 831 !, 832 ( ArgPosList = [ArgPos|ArgPosTail] 833 -> true 834 ; ArgPos = EPos, 835 ArgPosTail = [] 836 ), 837 ( integer(AS) 838 -> arg(I, Meta, MA), 839 extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm), 840 walk_called(Goal, M, ArgPosEx, OTerm) 841 ; AS == (^) 842 -> arg(I, Meta, MA), 843 remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm), 844 walk_called(Goal, MG, ArgPosEx, OTerm) 845 ; AS == (//) 846 -> arg(I, Meta, DCG), 847 walk_dcg_body(DCG, M, ArgPos, OTerm) 848 ; true 849 ), 850 succ(I, I2), 851 walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm). 852walk_meta_call(_, _, _, _, _, _, _). 853 854remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :- 855 var(Goal), 856 !, 857 undecided(Goal, TermPos, OTerm). 858remove_quantifier(_^Goal0, Goal, 859 term_position(_,_,_,_,[_,GPos]), 860 TermPos, M0, M, OTerm) :- 861 !, 862 remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm). 863remove_quantifier(M1:Goal0, Goal, 864 term_position(_,_,_,_,[_,GPos]), 865 TermPos, _, M, OTerm) :- 866 !, 867 remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm). 868remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
876walk_called_by([], _, _, _, _). 877walk_called_by([H|T], M, Goal, TermPos, OTerm) :- 878 ( H = G0+N 879 -> subterm_pos(G0, M, Goal, TermPos, G, GPos), 880 ( extend(G, N, G2, GPos, GPosEx, OTerm) 881 -> walk_called(G2, M, GPosEx, OTerm) 882 ; true 883 ) 884 ; subterm_pos(H, M, Goal, TermPos, G, GPos), 885 walk_called(G, M, GPos, OTerm) 886 ), 887 walk_called_by(T, M, Goal, TermPos, OTerm). 888 889subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :- 890 subterm_pos(Sub, Term, TermPos, SubTermPos), 891 !. 892subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :- 893 nonvar(Sub), 894 Sub = M:H, 895 !, 896 subterm_pos(H, M, Term, TermPos, G, SubTermPos). 897subterm_pos(Sub, _, _, _, Sub, _). 898 899subterm_pos(Sub, Term, TermPos, SubTermPos) :- 900 subterm_pos(Sub, Term, same_term, TermPos, SubTermPos), 901 !. 902subterm_pos(Sub, Term, TermPos, SubTermPos) :- 903 subterm_pos(Sub, Term, ==, TermPos, SubTermPos), 904 !. 905subterm_pos(Sub, Term, TermPos, SubTermPos) :- 906 subterm_pos(Sub, Term, =@=, TermPos, SubTermPos), 907 !. 908subterm_pos(Sub, Term, TermPos, SubTermPos) :- 909 subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos), 910 !.
916walk_dcg_body(Var, _Module, TermPos, OTerm) :- 917 var(Var), 918 !, 919 undecided(Var, TermPos, OTerm). 920walk_dcg_body([], _Module, _, _) :- !. 921walk_dcg_body([_|_], _Module, _, _) :- !. 922walk_dcg_body(String, _Module, _, _) :- 923 string(String), 924 !. 925walk_dcg_body(!, _Module, _, _) :- !. 926walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 927 !, 928 ( nonvar(M) 929 -> walk_dcg_body(G, M, Pos, OTerm) 930 ; undecided(M, MPos, OTerm) 931 ). 932walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 933 !, 934 walk_dcg_body(A, M, PA, OTerm), 935 walk_dcg_body(B, M, PB, OTerm). 936walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 937 !, 938 walk_dcg_body(A, M, PA, OTerm), 939 walk_dcg_body(B, M, PB, OTerm). 940walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 941 !, 942 walk_dcg_body(A, M, PA, OTerm), 943 walk_dcg_body(B, M, PB, OTerm). 944walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 945 !, 946 ( walk_dcg_body(A, M, PA, OTerm) 947 ; walk_dcg_body(B, M, PB, OTerm) 948 ). 949walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 950 !, 951 ( walk_dcg_body(A, M, PA, OTerm) 952 ; walk_dcg_body(B, M, PB, OTerm) 953 ). 954walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :- 955 !, 956 walk_called(G, M, PG, OTerm). 957walk_dcg_body(G, M, TermPos, OTerm) :- 958 extend(G, 2, G2, TermPos, TermPosEx, OTerm), 959 walk_called(G2, M, TermPosEx, OTerm).
same_term, ==, =@= or subsumes_term970:- meta_predicate 971 subterm_pos(, , , , ), 972 sublist_pos(, , , , , ). 973:- public 974 subterm_pos/5. % used in library(check). 975 976subterm_pos(_, _, _, Pos, _) :- 977 var(Pos), !, fail. 978subterm_pos(Sub, Term, Cmp, Pos, Pos) :- 979 call(Cmp, Sub, Term), 980 !. 981subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :- 982 is_list(ArgPosList), 983 compound(Term), 984 nth1(I, ArgPosList, ArgPos), 985 arg(I, Term, Arg), 986 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 987subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :- 988 sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos). 989subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :- 990 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 991 992sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :- 993 ( subterm_pos(Sub, H, Cmp, EP, Pos) 994 ; sublist_pos(TP, TailPos, Sub, T, Cmp, Pos) 995 ). 996sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :- 997 TailPos \== none, 998 subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
1004extend(Goal, 0, Goal, TermPos, TermPos, _) :- !. 1005extend(Goal, _, _, TermPos, TermPos, OTerm) :- 1006 var(Goal), 1007 !, 1008 undecided(Goal, TermPos, OTerm). 1009extend(M:Goal, N, M:GoalEx, 1010 term_position(F,T,FT,TT,[MPos,GPosIn]), 1011 term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :- 1012 !, 1013 ( var(M) 1014 -> undecided(N, MPos, OTerm) 1015 ; true 1016 ), 1017 extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm). 1018extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :- 1019 callable(Goal), 1020 !, 1021 Goal =.. List, 1022 length(Extra, N), 1023 extend_term_pos(TermPosIn, N, TermPosOut), 1024 append(List, Extra, ListEx), 1025 GoalEx =.. ListEx. 1026extend(Closure, N, M:GoalEx, TermPosIn, TermPosOut, OTerm) :- 1027 blob(Closure, closure), % call(Closure, A1, ...) 1028 !, 1029 '$closure_predicate'(Closure, M:Name/Arity), 1030 length(Extra, N), 1031 extend_term_pos(TermPosIn, N, TermPosOut), 1032 GoalEx =.. [Name|Extra], 1033 ( N =:= Arity 1034 -> true 1035 ; print_reference(Closure, TermPosIn, closure_arity_mismatch, OTerm) 1036 ). 1037extend(Goal, _, _, TermPos, _, OTerm) :- 1038 print_reference(Goal, TermPos, not_callable, OTerm). 1039 1040extend_term_pos(Var, _, _) :- 1041 var(Var), 1042 !. 1043extend_term_pos(term_position(F,T,FT,TT,ArgPosIn), 1044 N, 1045 term_position(F,T,FT,TT,ArgPosOut)) :- 1046 !, 1047 length(Extra, N), 1048 maplist(=(0-0), Extra), 1049 append(ArgPosIn, Extra, ArgPosOut). 1050extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :- 1051 length(Extra, N), 1052 maplist(=(0-0), Extra).
1057variants([], []). 1058variants([H|T], List) :- 1059 variants(T, H, List). 1060 1061variants([], H, [H]). 1062variants([H|T], V, List) :- 1063 ( H =@= V 1064 -> variants(T, V, List) 1065 ; List = [V|List2], 1066 variants(T, H, List2) 1067 ).
1073predicate_in_module(Module, PI) :- 1074 current_predicate(Module:PI), 1075 PI = Name/Arity, 1076 \+ hidden_predicate(Name, Arity), 1077 functor(Head, Name, Arity), 1078 \+ predicate_property(Module:Head, imported_from(_)). 1079 1080 (Name, _) :- 1082 atom(Name), % []/N is not hidden 1083 sub_atom(Name, 0, _, _, '$wrap$'). 1084 1085 1086 /******************************* 1087 * ENUMERATE CLAUSES * 1088 *******************************/
module_class(+list(Classes))1100prolog_program_clause(ClauseRef, Options) :- 1101 make_walk_option(Options, OTerm, _), 1102 setup_call_cleanup( 1103 true, 1104 ( current_module(Module), 1105 scan_module(Module, OTerm), 1106 module_clause(Module, ClauseRef, OTerm) 1107 ; retract(multifile_predicate(Name, Arity, MM)), 1108 multifile_clause(ClauseRef, MM:Name/Arity, OTerm) 1109 ; initialization_clause(ClauseRef, OTerm) 1110 ), 1111 retractall(multifile_predicate(_,_,_))). 1112 1113 1114module_clause(Module, ClauseRef, _OTerm) :- 1115 predicate_in_module(Module, Name/Arity), 1116 \+ multifile_predicate(Name, Arity, Module), 1117 functor(Head, Name, Arity), 1118 ( predicate_property(Module:Head, multifile) 1119 -> assertz(multifile_predicate(Name, Arity, Module)), 1120 fail 1121 ; predicate_property(Module:Head, Property), 1122 no_enum_property(Property) 1123 -> fail 1124 ; catch(nth_clause(Module:Head, _, ClauseRef), _, fail) 1125 ). 1126 1127no_enum_property(foreign). 1128 1129multifile_clause(ClauseRef, M:Name/Arity, OTerm) :- 1130 functor(Head, Name, Arity), 1131 catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm), 1132 _, fail). 1133 1134clauseref_not_from_development(Module:Head, Ref, OTerm) :- 1135 nth_clause(Module:Head, _N, Ref), 1136 \+ ( clause_property(Ref, file(File)), 1137 module_property(LoadModule, file(File)), 1138 \+ scan_module(LoadModule, OTerm) 1139 ). 1140 1141initialization_clause(ClauseRef, OTerm) :- 1142 catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation), 1143 true, ClauseRef), 1144 _, fail), 1145 walk_option_initialization(OTerm, SourceLocation), 1146 scan_module(M, OTerm).
1151translate_location(clause_term_position(ClauseRef, TermPos), Dict), 1152 clause_property(ClauseRef, file(File)) => 1153 arg(1, TermPos, CharCount), 1154 filepos_line(File, CharCount, Line, LinePos), 1155 Dict = _{ clause: ClauseRef, 1156 file: File, 1157 character_count: CharCount, 1158 line_count: Line, 1159 line_position: LinePos 1160 }. 1161translate_location(clause(ClauseRef), Dict), 1162 clause_property(ClauseRef, file(File)), 1163 clause_property(ClauseRef, line_count(Line)) => 1164 Dict = _{ clause: ClauseRef, 1165 file: File, 1166 line_count: Line 1167 }. 1168translate_location(clause(ClauseRef), Dict) => 1169 Dict = _{ clause: ClauseRef 1170 }. 1171translate_location(file_term_position(Path, TermPos), Dict) => 1172 arg(1, TermPos, CharCount), 1173 filepos_line(Path, CharCount, Line, LinePos), 1174 Dict = _{ file: Path, 1175 character_count: CharCount, 1176 line_count: Line, 1177 line_position: LinePos 1178 }. 1179translate_location(Var, Dict), var(Var) => 1180 Dict = _{}. 1181 1182 /******************************* 1183 * MESSAGES * 1184 *******************************/ 1185 1186:- multifile 1187 prolog:message//1, 1188 prolog:message_location//1. 1189 1190prologmessage(trace_call_to(PI, Context)) --> 1191 [ 'Call to ~q at '-[PI] ], 1192 '$messages':swi_location(Context). 1193 1194prologmessage_location(clause_term_position(ClauseRef, TermPos)) --> 1195 { clause_property(ClauseRef, file(File)) }, 1196 message_location_file_term_position(File, TermPos). 1197prologmessage_location(clause(ClauseRef)) --> 1198 { clause_property(ClauseRef, file(File)), 1199 clause_property(ClauseRef, line_count(Line)) 1200 }, 1201 !, 1202 [ url(File:Line), ': ' ]. 1203prologmessage_location(clause(ClauseRef)) --> 1204 { clause_name(ClauseRef, Name) }, 1205 [ '~w: '-[Name] ]. 1206prologmessage_location(file_term_position(Path, TermPos)) --> 1207 message_location_file_term_position(Path, TermPos). 1208prologmessage(codewalk(reiterate(New, Iteration, CPU))) --> 1209 [ 'Found new meta-predicates in iteration ~w (~3f sec)'- 1210 [Iteration, CPU], nl ], 1211 meta_decls(New), 1212 [ 'Restarting analysis ...'-[], nl ]. 1213 1214meta_decls([]) --> []. 1215meta_decls([H|T]) --> 1216 [ ':- meta_predicate ~q.'-[H], nl ], 1217 meta_decls(T). 1218 1219message_location_file_term_position(File, TermPos) --> 1220 { arg(1, TermPos, CharCount), 1221 filepos_line(File, CharCount, Line, LinePos) 1222 }, 1223 [ url(File:Line:LinePos), ': ' ].
1230filepos_line(File, CharPos, Line, LinePos) :-
1231 setup_call_cleanup(
1232 ( open(File, read, In),
1233 open_null_stream(Out)
1234 ),
1235 ( copy_stream_data(In, Out, CharPos),
1236 stream_property(In, position(Pos)),
1237 stream_position_data(line_count, Pos, Line),
1238 stream_position_data(line_position, Pos, LinePos)
1239 ),
1240 ( close(Out),
1241 close(In)
1242 ))
Prolog code walker
This module walks over the loaded program, searching for callable predicates. It started as part of library(prolog_autoload) and has been turned into a separate module to facilitate operations that require the same reachability analysis, such as finding references to a predicate, finding unreachable code, etc.
For example, the following determins the call graph of the loaded program. By using
source(true), The exact location of the call in the source file is passed into _Where.:- dynamic calls/2. assert_call_graph :- retractall(calls(_, _)), prolog_walk_code([ trace_reference(_), on_trace(assert_edge), source(false) ]), predicate_property(calls(_,_), number_of_clauses(N)), format('Got ~D edges~n', [N]). assert_edge(Callee, Caller, _Where) :- calls(Caller, Callee), !. assert_edge(Callee, Caller, _Where) :- assertz(calls(Caller, Callee)).*/