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