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-2020, VU University Amsterdam 7 CWI, Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(prolog_codewalk, 37 [ prolog_walk_code/1, % +Options 38 prolog_program_clause/2 % -ClauseRef, +Options 39 ]). 40:- use_module(library(record),[(record)/1, op(_,_,record)]). 41 42:- autoload(library(apply),[maplist/2]). 43:- autoload(library(debug),[debug/3,debugging/1,assertion/1]). 44:- autoload(library(error),[must_be/2]). 45:- autoload(library(listing),[portray_clause/1]). 46:- autoload(library(lists),[member/2,nth1/3,append/3]). 47:- autoload(library(option),[meta_options/3]). 48:- autoload(library(prolog_clause), 49 [clause_info/4,initialization_layout/4,clause_name/2]). 50:- autoload(library(prolog_metainference), 51 [inferred_meta_predicate/2,infer_meta_predicate/2]).
86:- meta_predicate 87 prolog_walk_code(). 88 89:- multifile 90 prolog:called_by/4, 91 prolog:called_by/2. 92 93:- predicate_options(prolog_walk_code/1, 1, 94 [ undefined(oneof([ignore,error,trace])), 95 autoload(boolean), 96 clauses(list), 97 module(atom), 98 module_class(list(oneof([user,system,library, 99 test,development]))), 100 source(boolean), 101 trace_reference(any), 102 trace_condition(callable), 103 on_trace(callable), 104 on_edge(callable), 105 infer_meta_predicates(oneof([false,true,all])), 106 walk_meta_predicates(boolean), 107 evaluate(boolean), 108 verbose(boolean) 109 ]). 110 111:- record 112 walk_option(undefined:oneof([ignore,error,trace])=ignore, 113 autoload:boolean=true, 114 source:boolean=true, 115 module:atom, % Only analyse given module 116 module_class:list(oneof([user,system,library, 117 test,development]))=[user,library], 118 infer_meta_predicates:oneof([false,true,all])=true, 119 walk_meta_predicates:boolean=true, 120 clauses:list, % Walk only these clauses 121 trace_reference:any=(-), 122 trace_condition:callable, % Call-back condition 123 on_edge:callable, % Call-back on trace hits 124 on_trace:callable, % Call-back on trace hits 125 % private stuff 126 clause, % Processed clause 127 caller, % Head of the caller 128 initialization, % Initialization source 129 undecided, % Error to throw error 130 evaluate:boolean, % Do partial evaluation 131 verbose:boolean=false). % Report progress 132 133:- thread_local 134 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.
244prolog_walk_code(Options) :- 245 meta_options(is_meta, Options, QOptions), 246 prolog_walk_code(1, QOptions). 247 248prolog_walk_code(Iteration, Options) :- 249 statistics(cputime, CPU0), 250 make_walk_option(Options, OTerm, _), 251 ( walk_option_clauses(OTerm, Clauses), 252 nonvar(Clauses) 253 -> walk_clauses(Clauses, OTerm) 254 ; forall(( walk_option_module(OTerm, M0), 255 copy_term(M0, M), 256 current_module(M), 257 scan_module(M, OTerm) 258 ), 259 find_walk_from_module(M, OTerm)), 260 walk_from_multifile(OTerm), 261 walk_from_initialization(OTerm) 262 ), 263 infer_new_meta_predicates(New, OTerm), 264 statistics(cputime, CPU1), 265 ( New \== [] 266 -> CPU is CPU1-CPU0, 267 ( walk_option_verbose(OTerm, true) 268 -> Level = informational 269 ; Level = silent 270 ), 271 print_message(Level, 272 codewalk(reiterate(New, Iteration, CPU))), 273 succ(Iteration, Iteration2), 274 prolog_walk_code(Iteration2, Options) 275 ; true 276 ). 277 278is_meta(on_edge). 279is_meta(on_trace). 280is_meta(trace_condition).
286walk_clauses(Clauses, OTerm) :-
287 must_be(list, Clauses),
288 forall(member(ClauseRef, Clauses),
289 ( user:clause(CHead, Body, ClauseRef),
290 ( CHead = Module:Head
291 -> true
292 ; Module = user,
293 Head = CHead
294 ),
295 walk_option_clause(OTerm, ClauseRef),
296 walk_option_caller(OTerm, Module:Head),
297 walk_called_by_body(Body, Module, OTerm)
298 )).304scan_module(M, OTerm) :- 305 walk_option_module(OTerm, M1), 306 nonvar(M1), 307 !, 308 \+ M \= M1. 309scan_module(M, OTerm) :- 310 walk_option_module_class(OTerm, Classes), 311 module_property(M, class(Class)), 312 memberchk(Class, Classes), 313 !.
322walk_from_initialization(OTerm) :- 323 walk_option_caller(OTerm, '<initialization>'), 324 forall(init_goal_in_scope(Goal, SourceLocation, OTerm), 325 ( walk_option_initialization(OTerm, SourceLocation), 326 walk_from_initialization(Goal, OTerm))). 327 328init_goal_in_scope(Goal, SourceLocation, OTerm) :- 329 '$init_goal'(_When, Goal, SourceLocation), 330 SourceLocation = File:_Line, 331 ( walk_option_module(OTerm, M), 332 nonvar(M) 333 -> module_property(M, file(File)) 334 ; walk_option_module_class(OTerm, Classes), 335 source_file_property(File, module(MF)) 336 -> module_property(MF, class(Class)), 337 memberchk(Class, Classes), 338 walk_option_module(OTerm, MF) 339 ; true 340 ). 341 342walk_from_initialization(M:Goal, OTerm) :- 343 scan_module(M, OTerm), 344 !, 345 walk_called_by_body(Goal, M, OTerm). 346walk_from_initialization(_, _).
354find_walk_from_module(M, OTerm) :- 355 debug(autoload, 'Analysing module ~q', [M]), 356 walk_option_module(OTerm, M), 357 forall(predicate_in_module(M, PI), 358 walk_called_by_pred(M:PI, OTerm)). 359 360walk_called_by_pred(Module:Name/Arity, _) :- 361 multifile_predicate(Name, Arity, Module), 362 !. 363walk_called_by_pred(Module:Name/Arity, _) :- 364 functor(Head, Name, Arity), 365 predicate_property(Module:Head, multifile), 366 !, 367 assertz(multifile_predicate(Name, Arity, Module)). 368walk_called_by_pred(Module:Name/Arity, OTerm) :- 369 functor(Head, Name, Arity), 370 ( no_walk_property(Property), 371 predicate_property(Module:Head, Property) 372 -> true 373 ; walk_option_caller(OTerm, Module:Head), 374 walk_option_clause(OTerm, ClauseRef), 375 forall(catch(clause(Module:, Body, ClauseRef), _, fail), 376 walk_called_by_body(Body, Module, OTerm)) 377 ). 378 379no_walk_property(number_of_rules(0)). % no point walking only facts 380no_walk_property(foreign). % cannot walk foreign code
386walk_from_multifile(OTerm) :- 387 forall(retract(multifile_predicate(Name, Arity, Module)), 388 walk_called_by_multifile(Module:Name/Arity, OTerm)). 389 390walk_called_by_multifile(Module:Name/Arity, OTerm) :- 391 functor(Head, Name, Arity), 392 forall(catch(clause_not_from_development( 393 Module:Head, Body, ClauseRef, OTerm), 394 _, fail), 395 ( walk_option_clause(OTerm, ClauseRef), 396 walk_option_caller(OTerm, Module:Head), 397 walk_called_by_body(Body, Module, OTerm) 398 )).
406clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
407 clause(Module:, Body, Ref),
408 \+ ( clause_property(Ref, file(File)),
409 module_property(LoadModule, file(File)),
410 \+ scan_module(LoadModule, OTerm)
411 ).ignore, error421walk_called_by_body(True, _, _) :- 422 True == true, 423 !. % quickly deal with facts 424walk_called_by_body(Body, Module, OTerm) :- 425 set_undecided_of_walk_option(error, OTerm, OTerm1), 426 set_evaluate_of_walk_option(false, OTerm1, OTerm2), 427 catch(walk_called(Body, Module, _TermPos, OTerm2), 428 missing(Missing), 429 walk_called_by_body(Missing, Body, Module, OTerm)), 430 !. 431walk_called_by_body(Body, Module, OTerm) :- 432 format(user_error, 'Failed to analyse:~n', []), 433 portray_clause(('<head>' :- Body)), 434 debug_walk(Body, Module, OTerm). 435 436% recompile this library after `debug(codewalk(trace))` and re-try 437% for debugging failures. 438:- if(debugging(codewalk(trace))). 439debug_walk(Body, Module, OTerm) :- 440 gtrace, 441 walk_called_by_body(Body, Module, OTerm). 442:- else. 443debug_walk(_,_,_). 444:- endif.
451walk_called_by_body(Missing, Body, _, OTerm) :- 452 debugging(codewalk), 453 format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]), 454 portray_clause(('<head>' :- Body)), fail. 455walk_called_by_body(undecided_call, Body, Module, OTerm) :- 456 catch(forall(walk_called(Body, Module, _TermPos, OTerm), 457 true), 458 missing(Missing), 459 walk_called_by_body(Missing, Body, Module, OTerm)). 460walk_called_by_body(subterm_positions, Body, Module, OTerm) :- 461 ( ( walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef), 462 clause_info(ClauseRef, _, TermPos, _NameOffset), 463 TermPos = term_position(_,_,_,_,[_,BodyPos]) 464 -> WBody = Body 465 ; walk_option_initialization(OTerm, SrcLoc), 466 ground(SrcLoc), SrcLoc = _File:_Line, 467 initialization_layout(SrcLoc, Module:Body, WBody, BodyPos) 468 ) 469 -> catch(forall(walk_called(WBody, Module, BodyPos, OTerm), 470 true), 471 missing(subterm_positions), 472 walk_called_by_body(no_positions, Body, Module, OTerm)) 473 ; set_source_of_walk_option(false, OTerm, OTerm2), 474 forall(walk_called(Body, Module, _BodyPos, OTerm2), 475 true) 476 ). 477walk_called_by_body(no_positions, Body, Module, OTerm) :- 478 set_source_of_walk_option(false, OTerm, OTerm2), 479 forall(walk_called(Body, Module, _NoPos, OTerm2), 480 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.510walk_called(Term, Module, parentheses_term_position(_,_,Pos), OTerm) :- 511 nonvar(Pos), 512 !, 513 walk_called(Term, Module, Pos, OTerm). 514walk_called(Var, _, TermPos, OTerm) :- 515 var(Var), % Incomplete analysis 516 !, 517 undecided(Var, TermPos, OTerm). 518walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 519 !, 520 ( nonvar(M) 521 -> walk_called(G, M, Pos, OTerm) 522 ; undecided(M, MPos, OTerm) 523 ). 524walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 525 !, 526 walk_called(A, M, PA, OTerm), 527 walk_called(B, M, PB, OTerm). 528walk_called((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 529 !, 530 walk_called(A, M, PA, OTerm), 531 walk_called(B, M, PB, OTerm). 532walk_called((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 533 !, 534 walk_called(A, M, PA, OTerm), 535 walk_called(B, M, PB, OTerm). 536walk_called(\+(A), M, term_position(_,_,_,_,[PA]), OTerm) :- 537 !, 538 \+ \+ walk_called(A, M, PA, OTerm). 539walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 540 !, 541 ( walk_option_evaluate(OTerm, Eval), Eval == true 542 -> Goal = (A;B), 543 setof(Goal, 544 ( walk_called(A, M, PA, OTerm) 545 ; walk_called(B, M, PB, OTerm) 546 ), 547 Alts0), 548 variants(Alts0, Alts), 549 member(Goal, Alts) 550 ; \+ \+ walk_called(A, M, PA, OTerm), % do not propagate bindings 551 \+ \+ walk_called(B, M, PB, OTerm) 552 ). 553walk_called(Goal, Module, TermPos, OTerm) :- 554 walk_option_trace_reference(OTerm, To), To \== (-), 555 ( subsumes_term(To, Module:Goal) 556 -> M2 = Module 557 ; predicate_property(Module:Goal, imported_from(M2)), 558 subsumes_term(To, M2:Goal) 559 ), 560 trace_condition(M2:Goal, TermPos, OTerm), 561 print_reference(M2:Goal, TermPos, trace, OTerm), 562 fail. % Continue search 563walk_called(Goal, Module, _, OTerm) :- 564 evaluate(Goal, Module, OTerm), 565 !. 566walk_called(Goal, M, TermPos, OTerm) :- 567 ( ( predicate_property(M:Goal, imported_from(IM)) 568 -> true 569 ; IM = M 570 ), 571 prolog:called_by(Goal, IM, M, Called) 572 ; prolog:called_by(Goal, Called) 573 ), 574 Called \== [], 575 !, 576 walk_called_by(Called, M, Goal, TermPos, OTerm). 577walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :- 578 walk_option_walk_meta_predicates(OTerm, true), 579 ( walk_option_autoload(OTerm, false) 580 -> nonvar(M), 581 '$get_predicate_attribute'(M:Meta, defined, 1) 582 ; true 583 ), 584 ( predicate_property(M:Meta, meta_predicate(Head)) 585 ; inferred_meta_predicate(M:Meta, Head) 586 ), 587 !, 588 walk_option_clause(OTerm, ClauseRef), 589 register_possible_meta_clause(ClauseRef), 590 walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm). 591walk_called(Closure, _, _, _) :- 592 blob(Closure, closure), 593 !, 594 '$closure_predicate'(Closure, Module:Name/Arity), 595 functor(Head, Name, Arity), 596 '$get_predicate_attribute'(Module:Head, defined, 1). 597walk_called(ClosureCall, _, _, _) :- 598 compound(ClosureCall), 599 compound_name_arity(ClosureCall, Closure, _), 600 blob(Closure, closure), 601 !, 602 '$closure_predicate'(Closure, Module:Name/Arity), 603 functor(Head, Name, Arity), 604 '$get_predicate_attribute'(Module:Head, defined, 1). 605walk_called(Goal, Module, _, _) :- 606 nonvar(Module), 607 '$get_predicate_attribute'(Module:Goal, defined, 1), 608 !. 609walk_called(Goal, Module, TermPos, OTerm) :- 610 callable(Goal), 611 !, 612 undefined(Module:Goal, TermPos, OTerm). 613walk_called(Goal, _Module, TermPos, OTerm) :- 614 not_callable(Goal, TermPos, OTerm).
call(Condition, Callee, Dict)620trace_condition(Callee, TermPos, OTerm) :- 621 walk_option_trace_condition(OTerm, Cond), nonvar(Cond), 622 !, 623 cond_location_context(OTerm, TermPos, Context0), 624 walk_option_caller(OTerm, Caller), 625 walk_option_module(OTerm, Module), 626 put_dict(#{caller:Caller, module:Module}, Context0, Context), 627 call(Cond, Callee, Context). 628trace_condition(_, _, _). 629 630cond_location_context(OTerm, _TermPos, Context) :- 631 walk_option_clause(OTerm, Clause), nonvar(Clause), 632 !, 633 Context = #{clause:Clause}. 634cond_location_context(OTerm, _TermPos, Context) :- 635 walk_option_initialization(OTerm, Init), nonvar(Init), 636 !, 637 Context = #{initialization:Init}.
641undecided(Var, TermPos, OTerm) :- 642 walk_option_undecided(OTerm, Undecided), 643 ( var(Undecided) 644 -> Action = ignore 645 ; Action = Undecided 646 ), 647 undecided(Action, Var, TermPos, OTerm). 648 649undecided(ignore, _, _, _) :- !. 650undecided(error, _, _, _) :- 651 throw(missing(undecided_call)).
655evaluate(Goal, Module, OTerm) :- 656 walk_option_evaluate(OTerm, Evaluate), 657 Evaluate \== false, 658 evaluate(Goal, Module). 659 660evaluate(A=B, _) :- 661 unify_with_occurs_check(A, B).
667undefined(_, _, OTerm) :- 668 walk_option_undefined(OTerm, ignore), 669 !. 670undefined(Goal, _, _) :- 671 predicate_property(Goal, autoload(_)), 672 !. 673undefined(Goal, TermPos, OTerm) :- 674 ( walk_option_undefined(OTerm, trace) 675 -> Why = trace 676 ; Why = undefined 677 ), 678 print_reference(Goal, TermPos, Why, OTerm).
684not_callable(Goal, TermPos, OTerm) :-
685 print_reference(Goal, TermPos, not_callable, OTerm).694print_reference(Goal, TermPos, Why, OTerm) :- 695 walk_option_clause(OTerm, Clause), nonvar(Clause), 696 !, 697 ( compound(TermPos), 698 arg(1, TermPos, CharCount), 699 integer(CharCount) % test it is valid 700 -> From = clause_term_position(Clause, TermPos) 701 ; walk_option_source(OTerm, false) 702 -> From = clause(Clause) 703 ; From = _, 704 throw(missing(subterm_positions)) 705 ), 706 print_reference2(Goal, From, Why, OTerm). 707print_reference(Goal, TermPos, Why, OTerm) :- 708 walk_option_initialization(OTerm, Init), nonvar(Init), 709 Init = File:Line, 710 !, 711 ( compound(TermPos), 712 arg(1, TermPos, CharCount), 713 integer(CharCount) % test it is valid 714 -> From = file_term_position(File, TermPos) 715 ; walk_option_source(OTerm, false) 716 -> From = file(File, Line, -1, _) 717 ; From = _, 718 throw(missing(subterm_positions)) 719 ), 720 print_reference2(Goal, From, Why, OTerm). 721print_reference(Goal, _, Why, OTerm) :- 722 print_reference2(Goal, _, Why, OTerm). 723 724print_reference2(Goal, From, trace, OTerm) :- 725 walk_option_on_trace(OTerm, Closure), 726 nonvar(Closure), 727 walk_option_caller(OTerm, Caller), 728 call(Closure, Goal, Caller, From), 729 !. 730print_reference2(Goal, From, trace, OTerm) :- 731 walk_option_on_edge(OTerm, Closure), 732 nonvar(Closure), 733 walk_option_caller(OTerm, Caller), 734 translate_location(From, Dict), 735 call(Closure, Goal, Caller, Dict), 736 !. 737print_reference2(Goal, From, Why, _OTerm) :- 738 make_message(Why, Goal, From, Message, Level), 739 print_message(Level, Message). 740 741 742make_message(undefined, Goal, Context, 743 error(existence_error(procedure, PI), Context), error) :- 744 goal_pi(Goal, PI). 745make_message(not_callable, Goal, Context, 746 error(type_error(callable, Goal), Context), error). 747make_message(trace, Goal, Context, 748 trace_call_to(PI, Context), informational) :- 749 goal_pi(Goal, PI). 750 751 752goal_pi(Goal, M:Name/Arity) :- 753 strip_module(Goal, M, Head), 754 callable(Head), 755 !, 756 functor(Head, Name, Arity). 757goal_pi(Goal, Goal). 758 759:- dynamic 760 possible_meta_predicate/2.
769register_possible_meta_clause(ClausesRef) :- 770 nonvar(ClausesRef), 771 clause_property(ClausesRef, predicate(PI)), 772 pi_head(PI, Head, Module), 773 module_property(Module, class(user)), 774 \+ predicate_property(Module:Head, meta_predicate(_)), 775 \+ inferred_meta_predicate(Module:Head, _), 776 \+ possible_meta_predicate(Head, Module), 777 !, 778 assertz(possible_meta_predicate(Head, Module)). 779register_possible_meta_clause(_). 780 781pi_head(Module:Name/Arity, Head, Module) :- 782 !, 783 functor(Head, Name, Arity). 784pi_head(_, _, _) :- 785 assertion(fail).
789infer_new_meta_predicates([], OTerm) :- 790 walk_option_infer_meta_predicates(OTerm, false), 791 !. 792infer_new_meta_predicates(MetaSpecs, OTerm) :- 793 findall(Module:MetaSpec, 794 ( retract(possible_meta_predicate(Head, Module)), 795 infer_meta_predicate(Module:Head, MetaSpec), 796 ( walk_option_infer_meta_predicates(OTerm, all) 797 -> true 798 ; calling_metaspec(MetaSpec) 799 ) 800 ), 801 MetaSpecs).
808calling_metaspec(Head) :- 809 arg(_, Head, Arg), 810 calling_metaarg(Arg), 811 !. 812 813calling_metaarg(I) :- integer(I), !. 814calling_metaarg(^). 815calling_metaarg(//).
828walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :- 829 arg(I, Head, AS), 830 !, 831 ( ArgPosList = [ArgPos|ArgPosTail] 832 -> true 833 ; ArgPos = EPos, 834 ArgPosTail = [] 835 ), 836 ( integer(AS) 837 -> arg(I, Meta, MA), 838 extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm), 839 walk_called(Goal, M, ArgPosEx, OTerm) 840 ; AS == (^) 841 -> arg(I, Meta, MA), 842 remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm), 843 walk_called(Goal, MG, ArgPosEx, OTerm) 844 ; AS == (//) 845 -> arg(I, Meta, DCG), 846 walk_dcg_body(DCG, M, ArgPos, OTerm) 847 ; true 848 ), 849 succ(I, I2), 850 walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm). 851walk_meta_call(_, _, _, _, _, _, _). 852 853remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :- 854 var(Goal), 855 !, 856 undecided(Goal, TermPos, OTerm). 857remove_quantifier(_^Goal0, Goal, 858 term_position(_,_,_,_,[_,GPos]), 859 TermPos, M0, M, OTerm) :- 860 !, 861 remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm). 862remove_quantifier(M1:Goal0, Goal, 863 term_position(_,_,_,_,[_,GPos]), 864 TermPos, _, M, OTerm) :- 865 !, 866 remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm). 867remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
875walk_called_by([], _, _, _, _). 876walk_called_by([H|T], M, Goal, TermPos, OTerm) :- 877 ( H = G0+N 878 -> subterm_pos(G0, M, Goal, TermPos, G, GPos), 879 ( extend(G, N, G2, GPos, GPosEx, OTerm) 880 -> walk_called(G2, M, GPosEx, OTerm) 881 ; true 882 ) 883 ; subterm_pos(H, M, Goal, TermPos, G, GPos), 884 walk_called(G, M, GPos, OTerm) 885 ), 886 walk_called_by(T, M, Goal, TermPos, OTerm). 887 888subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :- 889 subterm_pos(Sub, Term, TermPos, SubTermPos), 890 !. 891subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :- 892 nonvar(Sub), 893 Sub = M:H, 894 !, 895 subterm_pos(H, M, Term, TermPos, G, SubTermPos). 896subterm_pos(Sub, _, _, _, Sub, _). 897 898subterm_pos(Sub, Term, TermPos, SubTermPos) :- 899 subterm_pos(Sub, Term, same_term, TermPos, SubTermPos), 900 !. 901subterm_pos(Sub, Term, TermPos, SubTermPos) :- 902 subterm_pos(Sub, 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, subsumes_term, TermPos, SubTermPos), 909 !.
915walk_dcg_body(Var, _Module, TermPos, OTerm) :- 916 var(Var), 917 !, 918 undecided(Var, TermPos, OTerm). 919walk_dcg_body([], _Module, _, _) :- !. 920walk_dcg_body([_|_], _Module, _, _) :- !. 921walk_dcg_body(String, _Module, _, _) :- 922 string(String), 923 !. 924walk_dcg_body(!, _Module, _, _) :- !. 925walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 926 !, 927 ( nonvar(M) 928 -> walk_dcg_body(G, M, Pos, OTerm) 929 ; undecided(M, MPos, OTerm) 930 ). 931walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 932 !, 933 walk_dcg_body(A, M, PA, OTerm), 934 walk_dcg_body(B, M, PB, OTerm). 935walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 936 !, 937 walk_dcg_body(A, M, PA, OTerm), 938 walk_dcg_body(B, M, PB, OTerm). 939walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 940 !, 941 walk_dcg_body(A, M, PA, OTerm), 942 walk_dcg_body(B, M, PB, OTerm). 943walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 944 !, 945 ( walk_dcg_body(A, M, PA, OTerm) 946 ; walk_dcg_body(B, M, PB, OTerm) 947 ). 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({G}, M, brace_term_position(_,_,PG), OTerm) :- 954 !, 955 walk_called(G, M, PG, OTerm). 956walk_dcg_body(G, M, TermPos, OTerm) :- 957 extend(G, 2, G2, TermPos, TermPosEx, OTerm), 958 walk_called(G2, M, TermPosEx, OTerm).
same_term, ==, =@= or subsumes_term969:- meta_predicate 970 subterm_pos(, , , , ), 971 sublist_pos(, , , , , ). 972:- public 973 subterm_pos/5. % used in library(check). 974 975subterm_pos(_, _, _, Pos, _) :- 976 var(Pos), !, fail. 977subterm_pos(Sub, Term, Cmp, Pos, Pos) :- 978 call(Cmp, Sub, Term), 979 !. 980subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :- 981 is_list(ArgPosList), 982 compound(Term), 983 nth1(I, ArgPosList, ArgPos), 984 arg(I, Term, Arg), 985 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 986subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :- 987 sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos). 988subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :- 989 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 990 991sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :- 992 ( subterm_pos(Sub, H, Cmp, EP, Pos) 993 ; sublist_pos(TP, TailPos, Sub, T, Cmp, Pos) 994 ). 995sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :- 996 TailPos \== none, 997 subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
1003extend(Goal, 0, Goal, TermPos, TermPos, _) :- !. 1004extend(Goal, _, _, TermPos, TermPos, OTerm) :- 1005 var(Goal), 1006 !, 1007 undecided(Goal, TermPos, OTerm). 1008extend(M:Goal, N, M:GoalEx, 1009 term_position(F,T,FT,TT,[MPos,GPosIn]), 1010 term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :- 1011 !, 1012 ( var(M) 1013 -> undecided(N, MPos, OTerm) 1014 ; true 1015 ), 1016 extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm). 1017extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :- 1018 callable(Goal), 1019 !, 1020 Goal =.. List, 1021 length(Extra, N), 1022 extend_term_pos(TermPosIn, N, TermPosOut), 1023 append(List, Extra, ListEx), 1024 GoalEx =.. ListEx. 1025extend(Closure, N, M:GoalEx, TermPosIn, TermPosOut, OTerm) :- 1026 blob(Closure, closure), % call(Closure, A1, ...) 1027 !, 1028 '$closure_predicate'(Closure, M:Name/Arity), 1029 length(Extra, N), 1030 extend_term_pos(TermPosIn, N, TermPosOut), 1031 GoalEx =.. [Name|Extra], 1032 ( N =:= Arity 1033 -> true 1034 ; print_reference(Closure, TermPosIn, closure_arity_mismatch, OTerm) 1035 ). 1036extend(Goal, _, _, TermPos, _, OTerm) :- 1037 print_reference(Goal, TermPos, not_callable, OTerm). 1038 1039extend_term_pos(Var, _, _) :- 1040 var(Var), 1041 !. 1042extend_term_pos(term_position(F,T,FT,TT,ArgPosIn), 1043 N, 1044 term_position(F,T,FT,TT,ArgPosOut)) :- 1045 !, 1046 length(Extra, N), 1047 maplist(=(0-0), Extra), 1048 append(ArgPosIn, Extra, ArgPosOut). 1049extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :- 1050 length(Extra, N), 1051 maplist(=(0-0), Extra).
1056variants([], []). 1057variants([H|T], List) :- 1058 variants(T, H, List). 1059 1060variants([], H, [H]). 1061variants([H|T], V, List) :- 1062 ( H =@= V 1063 -> variants(T, V, List) 1064 ; List = [V|List2], 1065 variants(T, H, List2) 1066 ).
1072predicate_in_module(Module, PI) :- 1073 current_predicate(Module:PI), 1074 PI = Name/Arity, 1075 \+ hidden_predicate(Name, Arity), 1076 functor(Head, Name, Arity), 1077 \+ predicate_property(Module:Head, imported_from(_)). 1078 1079 (Name, _) :- 1081 atom(Name), % []/N is not hidden 1082 sub_atom(Name, 0, _, _, '$wrap$'). 1083 1084 1085 /******************************* 1086 * ENUMERATE CLAUSES * 1087 *******************************/
module_class(+list(Classes))1099prolog_program_clause(ClauseRef, Options) :- 1100 make_walk_option(Options, OTerm, _), 1101 setup_call_cleanup( 1102 true, 1103 ( current_module(Module), 1104 scan_module(Module, OTerm), 1105 module_clause(Module, ClauseRef, OTerm) 1106 ; retract(multifile_predicate(Name, Arity, MM)), 1107 multifile_clause(ClauseRef, MM:Name/Arity, OTerm) 1108 ; initialization_clause(ClauseRef, OTerm) 1109 ), 1110 retractall(multifile_predicate(_,_,_))). 1111 1112 1113module_clause(Module, ClauseRef, _OTerm) :- 1114 predicate_in_module(Module, Name/Arity), 1115 \+ multifile_predicate(Name, Arity, Module), 1116 functor(Head, Name, Arity), 1117 ( predicate_property(Module:Head, multifile) 1118 -> assertz(multifile_predicate(Name, Arity, Module)), 1119 fail 1120 ; predicate_property(Module:Head, Property), 1121 no_enum_property(Property) 1122 -> fail 1123 ; catch(nth_clause(Module:Head, _, ClauseRef), _, fail) 1124 ). 1125 1126no_enum_property(foreign). 1127 1128multifile_clause(ClauseRef, M:Name/Arity, OTerm) :- 1129 functor(Head, Name, Arity), 1130 catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm), 1131 _, fail). 1132 1133clauseref_not_from_development(Module:Head, Ref, OTerm) :- 1134 nth_clause(Module:Head, _N, Ref), 1135 \+ ( clause_property(Ref, file(File)), 1136 module_property(LoadModule, file(File)), 1137 \+ scan_module(LoadModule, OTerm) 1138 ). 1139 1140initialization_clause(ClauseRef, OTerm) :- 1141 catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation), 1142 true, ClauseRef), 1143 _, fail), 1144 walk_option_initialization(OTerm, SourceLocation), 1145 scan_module(M, OTerm).
1150translate_location(clause_term_position(ClauseRef, TermPos), Dict), 1151 clause_property(ClauseRef, file(File)) => 1152 arg(1, TermPos, CharCount), 1153 filepos_line(File, CharCount, Line, LinePos), 1154 Dict = _{ clause: ClauseRef, 1155 file: File, 1156 character_count: CharCount, 1157 line_count: Line, 1158 line_position: LinePos 1159 }. 1160translate_location(clause(ClauseRef), Dict), 1161 clause_property(ClauseRef, file(File)), 1162 clause_property(ClauseRef, line_count(Line)) => 1163 Dict = _{ clause: ClauseRef, 1164 file: File, 1165 line_count: Line 1166 }. 1167translate_location(clause(ClauseRef), Dict) => 1168 Dict = _{ clause: ClauseRef 1169 }. 1170translate_location(file_term_position(Path, TermPos), Dict) => 1171 arg(1, TermPos, CharCount), 1172 filepos_line(Path, CharCount, Line, LinePos), 1173 Dict = _{ file: Path, 1174 character_count: CharCount, 1175 line_count: Line, 1176 line_position: LinePos 1177 }. 1178translate_location(Var, Dict), var(Var) => 1179 Dict = _{}. 1180 1181 /******************************* 1182 * MESSAGES * 1183 *******************************/ 1184 1185:- multifile 1186 prolog:message//1, 1187 prolog:message_location//1. 1188 1189prologmessage(trace_call_to(PI, Context)) --> 1190 [ 'Call to ~q at '-[PI] ], 1191 '$messages':swi_location(Context). 1192 1193prologmessage_location(clause_term_position(ClauseRef, TermPos)) --> 1194 { clause_property(ClauseRef, file(File)) }, 1195 message_location_file_term_position(File, TermPos). 1196prologmessage_location(clause(ClauseRef)) --> 1197 { clause_property(ClauseRef, file(File)), 1198 clause_property(ClauseRef, line_count(Line)) 1199 }, 1200 !, 1201 [ url(File:Line), ': ' ]. 1202prologmessage_location(clause(ClauseRef)) --> 1203 { clause_name(ClauseRef, Name) }, 1204 [ '~w: '-[Name] ]. 1205prologmessage_location(file_term_position(Path, TermPos)) --> 1206 message_location_file_term_position(Path, TermPos). 1207prologmessage(codewalk(reiterate(New, Iteration, CPU))) --> 1208 [ 'Found new meta-predicates in iteration ~w (~3f sec)'- 1209 [Iteration, CPU], nl ], 1210 meta_decls(New), 1211 [ 'Restarting analysis ...'-[], nl ]. 1212 1213meta_decls([]) --> []. 1214meta_decls([H|T]) --> 1215 [ ':- meta_predicate ~q.'-[H], nl ], 1216 meta_decls(T). 1217 1218message_location_file_term_position(File, TermPos) --> 1219 { arg(1, TermPos, CharCount), 1220 filepos_line(File, CharCount, Line, LinePos) 1221 }, 1222 [ url(File:Line:LinePos), ': ' ].
1229filepos_line(File, CharPos, Line, LinePos) :-
1230 setup_call_cleanup(
1231 ( open(File, read, In),
1232 open_null_stream(Out)
1233 ),
1234 ( copy_stream_data(In, Out, CharPos),
1235 stream_property(In, position(Pos)),
1236 stream_position_data(line_count, Pos, Line),
1237 stream_position_data(line_position, Pos, LinePos)
1238 ),
1239 ( close(Out),
1240 close(In)
1241 ))
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)).*/