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-2025, 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(autoload_call(_), _, _, _) :- 568 !. % Should we continue, but just not report? 569walk_called(Goal, M, TermPos, OTerm) :- 570 ( ( predicate_property(M:Goal, imported_from(IM)) 571 -> true 572 ; IM = M 573 ), 574 prolog:called_by(Goal, IM, M, Called) 575 ; prolog:called_by(Goal, Called) 576 ), 577 Called \== [], 578 !, 579 walk_called_by(Called, M, Goal, TermPos, OTerm). 580walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :- 581 walk_option_walk_meta_predicates(OTerm, true), 582 ( walk_option_autoload(OTerm, false) 583 -> nonvar(M), 584 '$get_predicate_attribute'(M:Meta, defined, 1) 585 ; true 586 ), 587 ( predicate_property(M:Meta, meta_predicate(Head)) 588 ; inferred_meta_predicate(M:Meta, Head) 589 ), 590 !, 591 walk_option_clause(OTerm, ClauseRef), 592 register_possible_meta_clause(ClauseRef), 593 walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm). 594walk_called(Closure, _, _, _) :- 595 blob(Closure, closure), 596 !, 597 '$closure_predicate'(Closure, Module:Name/Arity), 598 functor(Head, Name, Arity), 599 '$get_predicate_attribute'(Module:Head, defined, 1). 600walk_called(ClosureCall, _, _, _) :- 601 compound(ClosureCall), 602 compound_name_arity(ClosureCall, Closure, _), 603 blob(Closure, closure), 604 !, 605 '$closure_predicate'(Closure, Module:Name/Arity), 606 functor(Head, Name, Arity), 607 '$get_predicate_attribute'(Module:Head, defined, 1). 608walk_called(Goal, Module, _, _) :- 609 nonvar(Module), 610 '$get_predicate_attribute'(Module:Goal, defined, 1), 611 !. 612walk_called(Goal, Module, TermPos, OTerm) :- 613 callable(Goal), 614 !, 615 undefined(Module:Goal, TermPos, OTerm). 616walk_called(Goal, _Module, TermPos, OTerm) :- 617 not_callable(Goal, TermPos, OTerm).
call(Condition, Callee, Dict)623trace_condition(Callee, TermPos, OTerm) :- 624 walk_option_trace_condition(OTerm, Cond), nonvar(Cond), 625 !, 626 cond_location_context(OTerm, TermPos, Context0), 627 walk_option_caller(OTerm, Caller), 628 walk_option_module(OTerm, Module), 629 put_dict(#{caller:Caller, module:Module}, Context0, Context), 630 call(Cond, Callee, Context). 631trace_condition(_, _, _). 632 633cond_location_context(OTerm, _TermPos, Context) :- 634 walk_option_clause(OTerm, Clause), nonvar(Clause), 635 !, 636 Context = #{clause:Clause}. 637cond_location_context(OTerm, _TermPos, Context) :- 638 walk_option_initialization(OTerm, Init), nonvar(Init), 639 !, 640 Context = #{initialization:Init}.
644undecided(Var, TermPos, OTerm) :- 645 walk_option_undecided(OTerm, Undecided), 646 ( var(Undecided) 647 -> Action = ignore 648 ; Action = Undecided 649 ), 650 undecided(Action, Var, TermPos, OTerm). 651 652undecided(ignore, _, _, _) :- !. 653undecided(error, _, _, _) :- 654 throw(missing(undecided_call)).
658evaluate(Goal, Module, OTerm) :- 659 walk_option_evaluate(OTerm, Evaluate), 660 Evaluate \== false, 661 evaluate(Goal, Module). 662 663evaluate(A=B, _) :- 664 unify_with_occurs_check(A, B).
670undefined(_, _, OTerm) :- 671 walk_option_undefined(OTerm, ignore), 672 !. 673undefined(Goal, _, _) :- 674 predicate_property(Goal, autoload(_)), 675 !. 676undefined(Goal, TermPos, OTerm) :- 677 ( walk_option_undefined(OTerm, trace) 678 -> Why = trace 679 ; Why = undefined 680 ), 681 print_reference(Goal, TermPos, Why, OTerm).
687not_callable(Goal, TermPos, OTerm) :-
688 print_reference(Goal, TermPos, not_callable, OTerm).697print_reference(Goal, TermPos, Why, OTerm) :- 698 walk_option_clause(OTerm, Clause), nonvar(Clause), 699 !, 700 ( compound(TermPos), 701 arg(1, TermPos, CharCount), 702 integer(CharCount) % test it is valid 703 -> From = clause_term_position(Clause, TermPos) 704 ; walk_option_source(OTerm, false) 705 -> From = clause(Clause) 706 ; From = _, 707 throw(missing(subterm_positions)) 708 ), 709 print_reference2(Goal, From, Why, OTerm). 710print_reference(Goal, TermPos, Why, OTerm) :- 711 walk_option_initialization(OTerm, Init), nonvar(Init), 712 Init = File:Line, 713 !, 714 ( compound(TermPos), 715 arg(1, TermPos, CharCount), 716 integer(CharCount) % test it is valid 717 -> From = file_term_position(File, TermPos) 718 ; walk_option_source(OTerm, false) 719 -> From = file(File, Line, -1, _) 720 ; From = _, 721 throw(missing(subterm_positions)) 722 ), 723 print_reference2(Goal, From, Why, OTerm). 724print_reference(Goal, _, Why, OTerm) :- 725 print_reference2(Goal, _, Why, OTerm). 726 727print_reference2(Goal, From, trace, OTerm) :- 728 walk_option_on_trace(OTerm, Closure), 729 nonvar(Closure), 730 walk_option_caller(OTerm, Caller), 731 call(Closure, Goal, Caller, From), 732 !. 733print_reference2(Goal, From, trace, OTerm) :- 734 walk_option_on_edge(OTerm, Closure), 735 nonvar(Closure), 736 walk_option_caller(OTerm, Caller), 737 translate_location(From, Dict), 738 call(Closure, Goal, Caller, Dict), 739 !. 740print_reference2(Goal, From, Why, _OTerm) :- 741 make_message(Why, Goal, From, Message, Level), 742 print_message(Level, Message). 743 744 745make_message(undefined, Goal, Context, 746 error(existence_error(procedure, PI), Context), error) :- 747 goal_pi(Goal, PI). 748make_message(not_callable, Goal, Context, 749 error(type_error(callable, Goal), Context), error). 750make_message(trace, Goal, Context, 751 trace_call_to(PI, Context), informational) :- 752 goal_pi(Goal, PI). 753 754 755goal_pi(Goal, M:Name/Arity) :- 756 strip_module(Goal, M, Head), 757 callable(Head), 758 !, 759 functor(Head, Name, Arity). 760goal_pi(Goal, Goal). 761 762:- dynamic 763 possible_meta_predicate/2.
772register_possible_meta_clause(ClausesRef) :- 773 nonvar(ClausesRef), 774 clause_property(ClausesRef, predicate(PI)), 775 pi_head(PI, Head, Module), 776 module_property(Module, class(user)), 777 \+ predicate_property(Module:Head, meta_predicate(_)), 778 \+ inferred_meta_predicate(Module:Head, _), 779 \+ possible_meta_predicate(Head, Module), 780 !, 781 assertz(possible_meta_predicate(Head, Module)). 782register_possible_meta_clause(_). 783 784pi_head(Module:Name/Arity, Head, Module) :- 785 !, 786 functor(Head, Name, Arity). 787pi_head(_, _, _) :- 788 assertion(fail).
792infer_new_meta_predicates([], OTerm) :- 793 walk_option_infer_meta_predicates(OTerm, false), 794 !. 795infer_new_meta_predicates(MetaSpecs, OTerm) :- 796 findall(Module:MetaSpec, 797 ( retract(possible_meta_predicate(Head, Module)), 798 infer_meta_predicate(Module:Head, MetaSpec), 799 ( walk_option_infer_meta_predicates(OTerm, all) 800 -> true 801 ; calling_metaspec(MetaSpec) 802 ) 803 ), 804 MetaSpecs).
811calling_metaspec(Head) :- 812 arg(_, Head, Arg), 813 calling_metaarg(Arg), 814 !. 815 816calling_metaarg(I) :- integer(I), !. 817calling_metaarg(^). 818calling_metaarg(//).
831walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :- 832 arg(I, Head, AS), 833 !, 834 ( ArgPosList = [ArgPos|ArgPosTail] 835 -> true 836 ; ArgPos = EPos, 837 ArgPosTail = [] 838 ), 839 ( integer(AS) 840 -> arg(I, Meta, MA), 841 extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm), 842 walk_called(Goal, M, ArgPosEx, OTerm) 843 ; AS == (^) 844 -> arg(I, Meta, MA), 845 remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm), 846 walk_called(Goal, MG, ArgPosEx, OTerm) 847 ; AS == (//) 848 -> arg(I, Meta, DCG), 849 walk_dcg_body(DCG, M, ArgPos, OTerm) 850 ; true 851 ), 852 succ(I, I2), 853 walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm). 854walk_meta_call(_, _, _, _, _, _, _). 855 856remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :- 857 var(Goal), 858 !, 859 undecided(Goal, TermPos, OTerm). 860remove_quantifier(_^Goal0, Goal, 861 term_position(_,_,_,_,[_,GPos]), 862 TermPos, M0, M, OTerm) :- 863 !, 864 remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm). 865remove_quantifier(M1:Goal0, Goal, 866 term_position(_,_,_,_,[_,GPos]), 867 TermPos, _, M, OTerm) :- 868 !, 869 remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm). 870remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
878walk_called_by([], _, _, _, _). 879walk_called_by([H|T], M, Goal, TermPos, OTerm) :- 880 ( H = G0+N 881 -> subterm_pos(G0, M, Goal, TermPos, G, GPos), 882 ( extend(G, N, G2, GPos, GPosEx, OTerm) 883 -> walk_called(G2, M, GPosEx, OTerm) 884 ; true 885 ) 886 ; subterm_pos(H, M, Goal, TermPos, G, GPos), 887 walk_called(G, M, GPos, OTerm) 888 ), 889 walk_called_by(T, M, Goal, TermPos, OTerm). 890 891subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :- 892 subterm_pos(Sub, Term, TermPos, SubTermPos), 893 !. 894subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :- 895 nonvar(Sub), 896 Sub = M:H, 897 !, 898 subterm_pos(H, M, Term, TermPos, G, SubTermPos). 899subterm_pos(Sub, _, _, _, Sub, _). 900 901subterm_pos(Sub, Term, TermPos, SubTermPos) :- 902 subterm_pos(Sub, Term, same_term, TermPos, SubTermPos), 903 !. 904subterm_pos(Sub, Term, TermPos, SubTermPos) :- 905 subterm_pos(Sub, Term, ==, TermPos, SubTermPos), 906 !. 907subterm_pos(Sub, Term, TermPos, SubTermPos) :- 908 subterm_pos(Sub, Term, =@=, TermPos, SubTermPos), 909 !. 910subterm_pos(Sub, Term, TermPos, SubTermPos) :- 911 subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos), 912 !.
918walk_dcg_body(Var, _Module, TermPos, OTerm) :- 919 var(Var), 920 !, 921 undecided(Var, TermPos, OTerm). 922walk_dcg_body([], _Module, _, _) :- !. 923walk_dcg_body([_|_], _Module, _, _) :- !. 924walk_dcg_body(String, _Module, _, _) :- 925 string(String), 926 !. 927walk_dcg_body(!, _Module, _, _) :- !. 928walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 929 !, 930 ( nonvar(M) 931 -> walk_dcg_body(G, M, Pos, OTerm) 932 ; undecided(M, MPos, OTerm) 933 ). 934walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 935 !, 936 walk_dcg_body(A, M, PA, OTerm), 937 walk_dcg_body(B, M, PB, OTerm). 938walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 939 !, 940 walk_dcg_body(A, M, PA, OTerm), 941 walk_dcg_body(B, M, PB, OTerm). 942walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 943 !, 944 walk_dcg_body(A, M, PA, OTerm), 945 walk_dcg_body(B, M, PB, OTerm). 946walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 947 !, 948 ( walk_dcg_body(A, M, PA, OTerm) 949 ; walk_dcg_body(B, M, PB, OTerm) 950 ). 951walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 952 !, 953 ( walk_dcg_body(A, M, PA, OTerm) 954 ; walk_dcg_body(B, M, PB, OTerm) 955 ). 956walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :- 957 !, 958 walk_called(G, M, PG, OTerm). 959walk_dcg_body(G, M, TermPos, OTerm) :- 960 extend(G, 2, G2, TermPos, TermPosEx, OTerm), 961 walk_called(G2, M, TermPosEx, OTerm).
same_term, ==, =@= or subsumes_term972:- meta_predicate 973 subterm_pos(, , , , ), 974 sublist_pos(, , , , , ). 975:- public 976 subterm_pos/5. % used in library(check). 977 978subterm_pos(_, _, _, Pos, _) :- 979 var(Pos), !, fail. 980subterm_pos(Sub, Term, Cmp, Pos, Pos) :- 981 call(Cmp, Sub, Term), 982 !. 983subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :- 984 is_list(ArgPosList), 985 compound(Term), 986 nth1(I, ArgPosList, ArgPos), 987 arg(I, Term, Arg), 988 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 989subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :- 990 sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos). 991subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :- 992 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 993 994sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :- 995 ( subterm_pos(Sub, H, Cmp, EP, Pos) 996 ; sublist_pos(TP, TailPos, Sub, T, Cmp, Pos) 997 ). 998sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :- 999 TailPos \== none, 1000 subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
1006extend(Goal, 0, Goal, TermPos, TermPos, _) :- !. 1007extend(Goal, _, _, TermPos, TermPos, OTerm) :- 1008 var(Goal), 1009 !, 1010 undecided(Goal, TermPos, OTerm). 1011extend(M:Goal, N, M:GoalEx, 1012 term_position(F,T,FT,TT,[MPos,GPosIn]), 1013 term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :- 1014 !, 1015 ( var(M) 1016 -> undecided(N, MPos, OTerm) 1017 ; true 1018 ), 1019 extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm). 1020extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :- 1021 callable(Goal), 1022 !, 1023 Goal =.. List, 1024 length(Extra, N), 1025 extend_term_pos(TermPosIn, N, TermPosOut), 1026 append(List, Extra, ListEx), 1027 GoalEx =.. ListEx. 1028extend(Closure, N, M:GoalEx, TermPosIn, TermPosOut, OTerm) :- 1029 blob(Closure, closure), % call(Closure, A1, ...) 1030 !, 1031 '$closure_predicate'(Closure, M:Name/Arity), 1032 length(Extra, N), 1033 extend_term_pos(TermPosIn, N, TermPosOut), 1034 GoalEx =.. [Name|Extra], 1035 ( N =:= Arity 1036 -> true 1037 ; print_reference(Closure, TermPosIn, closure_arity_mismatch, OTerm) 1038 ). 1039extend(Goal, _, _, TermPos, _, OTerm) :- 1040 print_reference(Goal, TermPos, not_callable, OTerm). 1041 1042extend_term_pos(Var, _, _) :- 1043 var(Var), 1044 !. 1045extend_term_pos(term_position(F,T,FT,TT,ArgPosIn), 1046 N, 1047 term_position(F,T,FT,TT,ArgPosOut)) :- 1048 !, 1049 length(Extra, N), 1050 maplist(=(0-0), Extra), 1051 append(ArgPosIn, Extra, ArgPosOut). 1052extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :- 1053 length(Extra, N), 1054 maplist(=(0-0), Extra).
1059variants([], []). 1060variants([H|T], List) :- 1061 variants(T, H, List). 1062 1063variants([], H, [H]). 1064variants([H|T], V, List) :- 1065 ( H =@= V 1066 -> variants(T, V, List) 1067 ; List = [V|List2], 1068 variants(T, H, List2) 1069 ).
1075predicate_in_module(Module, PI) :- 1076 current_predicate(Module:PI), 1077 PI = Name/Arity, 1078 \+ hidden_predicate(Name, Arity), 1079 functor(Head, Name, Arity), 1080 \+ predicate_property(Module:Head, imported_from(_)). 1081 1082 (Name, _) :- 1084 atom(Name), % []/N is not hidden 1085 sub_atom(Name, 0, _, _, '$wrap$'). 1086 1087 1088 /******************************* 1089 * ENUMERATE CLAUSES * 1090 *******************************/
module_class(+list(Classes))1102prolog_program_clause(ClauseRef, Options) :- 1103 make_walk_option(Options, OTerm, _), 1104 setup_call_cleanup( 1105 true, 1106 ( current_module(Module), 1107 scan_module(Module, OTerm), 1108 module_clause(Module, ClauseRef, OTerm) 1109 ; retract(multifile_predicate(Name, Arity, MM)), 1110 multifile_clause(ClauseRef, MM:Name/Arity, OTerm) 1111 ; initialization_clause(ClauseRef, OTerm) 1112 ), 1113 retractall(multifile_predicate(_,_,_))). 1114 1115 1116module_clause(Module, ClauseRef, _OTerm) :- 1117 predicate_in_module(Module, Name/Arity), 1118 \+ multifile_predicate(Name, Arity, Module), 1119 functor(Head, Name, Arity), 1120 ( predicate_property(Module:Head, multifile) 1121 -> assertz(multifile_predicate(Name, Arity, Module)), 1122 fail 1123 ; predicate_property(Module:Head, Property), 1124 no_enum_property(Property) 1125 -> fail 1126 ; catch(nth_clause(Module:Head, _, ClauseRef), _, fail) 1127 ). 1128 1129no_enum_property(foreign). 1130 1131multifile_clause(ClauseRef, M:Name/Arity, OTerm) :- 1132 functor(Head, Name, Arity), 1133 catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm), 1134 _, fail). 1135 1136clauseref_not_from_development(Module:Head, Ref, OTerm) :- 1137 nth_clause(Module:Head, _N, Ref), 1138 \+ ( clause_property(Ref, file(File)), 1139 module_property(LoadModule, file(File)), 1140 \+ scan_module(LoadModule, OTerm) 1141 ). 1142 1143initialization_clause(ClauseRef, OTerm) :- 1144 catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation), 1145 true, ClauseRef), 1146 _, fail), 1147 walk_option_initialization(OTerm, SourceLocation), 1148 scan_module(M, OTerm).
1153translate_location(clause_term_position(ClauseRef, TermPos), Dict), 1154 clause_property(ClauseRef, file(File)) => 1155 arg(1, TermPos, CharCount), 1156 filepos_line(File, CharCount, Line, LinePos), 1157 Dict = _{ clause: ClauseRef, 1158 file: File, 1159 character_count: CharCount, 1160 line_count: Line, 1161 line_position: LinePos 1162 }. 1163translate_location(clause(ClauseRef), Dict), 1164 clause_property(ClauseRef, file(File)), 1165 clause_property(ClauseRef, line_count(Line)) => 1166 Dict = _{ clause: ClauseRef, 1167 file: File, 1168 line_count: Line 1169 }. 1170translate_location(clause(ClauseRef), Dict) => 1171 Dict = _{ clause: ClauseRef 1172 }. 1173translate_location(file_term_position(Path, TermPos), Dict) => 1174 arg(1, TermPos, CharCount), 1175 filepos_line(Path, CharCount, Line, LinePos), 1176 Dict = _{ file: Path, 1177 character_count: CharCount, 1178 line_count: Line, 1179 line_position: LinePos 1180 }. 1181translate_location(file(Path, Line, -1, _), Dict) => 1182 Dict = _{ file: Path, 1183 line_count: Line 1184 }. 1185translate_location(Var, Dict), var(Var) => 1186 Dict = _{}. 1187 1188 /******************************* 1189 * MESSAGES * 1190 *******************************/ 1191 1192:- multifile 1193 prolog:message//1, 1194 prolog:message_location//1. 1195 1196prologmessage(trace_call_to(PI, Context)) --> 1197 [ 'Call to ~q at '-[PI] ], 1198 '$messages':swi_location(Context). 1199 1200prologmessage_location(clause_term_position(ClauseRef, TermPos)) --> 1201 { clause_property(ClauseRef, file(File)) }, 1202 message_location_file_term_position(File, TermPos). 1203prologmessage_location(clause(ClauseRef)) --> 1204 { clause_property(ClauseRef, file(File)), 1205 clause_property(ClauseRef, line_count(Line)) 1206 }, 1207 !, 1208 [ url(File:Line), ': ' ]. 1209prologmessage_location(clause(ClauseRef)) --> 1210 { clause_name(ClauseRef, Name) }, 1211 [ '~w: '-[Name] ]. 1212prologmessage_location(file_term_position(Path, TermPos)) --> 1213 message_location_file_term_position(Path, TermPos). 1214prologmessage(codewalk(reiterate(New, Iteration, CPU))) --> 1215 [ 'Found new meta-predicates in iteration ~w (~3f sec)'- 1216 [Iteration, CPU], nl ], 1217 meta_decls(New), 1218 [ 'Restarting analysis ...'-[], nl ]. 1219 1220meta_decls([]) --> []. 1221meta_decls([H|T]) --> 1222 [ ':- meta_predicate ~q.'-[H], nl ], 1223 meta_decls(T). 1224 1225message_location_file_term_position(File, TermPos) --> 1226 { arg(1, TermPos, CharCount), 1227 filepos_line(File, CharCount, Line, LinePos) 1228 }, 1229 [ url(File:Line:LinePos), ': ' ].
1236filepos_line(File, CharPos, Line, LinePos) :-
1237 setup_call_cleanup(
1238 ( open(File, read, In),
1239 open_null_stream(Out)
1240 ),
1241 ( copy_stream_data(In, Out, CharPos),
1242 stream_property(In, position(Pos)),
1243 stream_position_data(line_count, Pos, Line),
1244 stream_position_data(line_position, Pos, LinePos)
1245 ),
1246 ( close(Out),
1247 close(In)
1248 ))
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)).*/