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 infer_meta_predicates(oneof([false,true,all])), 105 evaluate(boolean), 106 verbose(boolean) 107 ]). 108 109:- record 110 walk_option(undefined:oneof([ignore,error,trace])=ignore, 111 autoload:boolean=true, 112 source:boolean=true, 113 module:atom, % Only analyse given module 114 module_class:list(oneof([user,system,library, 115 test,development]))=[user,library], 116 infer_meta_predicates:oneof([false,true,all])=true, 117 clauses:list, % Walk only these clauses 118 trace_reference:any=(-), 119 trace_condition:callable, % Call-back condition 120 on_trace:callable, % Call-back on trace hits 121 % private stuff 122 clause, % Processed clause 123 caller, % Head of the caller 124 initialization, % Initialization source 125 undecided, % Error to throw error 126 evaluate:boolean, % Do partial evaluation 127 verbose:boolean=false). % Report progress 128 129:- thread_local 130 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.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(OnTrace, Callee, Caller, Location)
, where Location 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.
223prolog_walk_code(Options) :- 224 meta_options(is_meta, Options, QOptions), 225 prolog_walk_code(1, QOptions). 226 227prolog_walk_code(Iteration, Options) :- 228 statistics(cputime, CPU0), 229 make_walk_option(Options, OTerm, _), 230 ( walk_option_clauses(OTerm, Clauses), 231 nonvar(Clauses) 232 -> walk_clauses(Clauses, OTerm) 233 ; forall(( walk_option_module(OTerm, M), 234 current_module(M), 235 scan_module(M, OTerm) 236 ), 237 find_walk_from_module(M, OTerm)), 238 walk_from_multifile(OTerm), 239 walk_from_initialization(OTerm) 240 ), 241 infer_new_meta_predicates(New, OTerm), 242 statistics(cputime, CPU1), 243 ( New \== [] 244 -> CPU is CPU1-CPU0, 245 ( walk_option_verbose(OTerm, true) 246 -> Level = informational 247 ; Level = silent 248 ), 249 print_message(Level, 250 codewalk(reiterate(New, Iteration, CPU))), 251 succ(Iteration, Iteration2), 252 prolog_walk_code(Iteration2, Options) 253 ; true 254 ). 255 256is_meta(on_trace). 257is_meta(trace_condition).
263walk_clauses(Clauses, OTerm) :-
264 must_be(list, Clauses),
265 forall(member(ClauseRef, Clauses),
266 ( user:clause(CHead, Body, ClauseRef),
267 ( CHead = Module:Head
268 -> true
269 ; Module = user,
270 Head = CHead
271 ),
272 walk_option_clause(OTerm, ClauseRef),
273 walk_option_caller(OTerm, Module:Head),
274 walk_called_by_body(Body, Module, OTerm)
275 )).
281scan_module(M, OTerm) :- 282 walk_option_module(OTerm, M1), 283 nonvar(M1), 284 !, 285 \+ M \= M1. 286scan_module(M, OTerm) :- 287 walk_option_module_class(OTerm, Classes), 288 module_property(M, class(Class)), 289 memberchk(Class, Classes), 290 !.
299walk_from_initialization(OTerm) :- 300 walk_option_caller(OTerm, '<initialization>'), 301 forall(init_goal_in_scope(Goal, SourceLocation, OTerm), 302 ( walk_option_initialization(OTerm, SourceLocation), 303 walk_from_initialization(Goal, OTerm))). 304 305init_goal_in_scope(Goal, SourceLocation, OTerm) :- 306 '$init_goal'(File, Goal, SourceLocation), 307 ( walk_option_module(OTerm, M), 308 nonvar(M) 309 -> module_property(M, file(File)) 310 ; walk_option_module_class(OTerm, Classes), 311 source_file_property(File, module(MF)) 312 -> module_property(MF, class(Class)), 313 memberchk(Class, Classes), 314 walk_option_module(OTerm, MF) 315 ; true 316 ). 317 318walk_from_initialization(M:Goal, OTerm) :- 319 scan_module(M, OTerm), 320 !, 321 walk_called_by_body(Goal, M, OTerm). 322walk_from_initialization(_, _).
330find_walk_from_module(M, OTerm) :- 331 debug(autoload, 'Analysing module ~q', [M]), 332 walk_option_module(OTerm, M), 333 forall(predicate_in_module(M, PI), 334 walk_called_by_pred(M:PI, OTerm)). 335 336walk_called_by_pred(Module:Name/Arity, _) :- 337 multifile_predicate(Name, Arity, Module), 338 !. 339walk_called_by_pred(Module:Name/Arity, _) :- 340 functor(Head, Name, Arity), 341 predicate_property(Module:Head, multifile), 342 !, 343 assertz(multifile_predicate(Name, Arity, Module)). 344walk_called_by_pred(Module:Name/Arity, OTerm) :- 345 functor(Head, Name, Arity), 346 ( no_walk_property(Property), 347 predicate_property(Module:Head, Property) 348 -> true 349 ; walk_option_caller(OTerm, Module:Head), 350 walk_option_clause(OTerm, ClauseRef), 351 forall(catch(clause(Module:, Body, ClauseRef), _, fail), 352 walk_called_by_body(Body, Module, OTerm)) 353 ). 354 355no_walk_property(number_of_rules(0)). % no point walking only facts 356no_walk_property(foreign). % cannot walk foreign code
362walk_from_multifile(OTerm) :- 363 forall(retract(multifile_predicate(Name, Arity, Module)), 364 walk_called_by_multifile(Module:Name/Arity, OTerm)). 365 366walk_called_by_multifile(Module:Name/Arity, OTerm) :- 367 functor(Head, Name, Arity), 368 forall(catch(clause_not_from_development( 369 Module:Head, Body, ClauseRef, OTerm), 370 _, fail), 371 ( walk_option_clause(OTerm, ClauseRef), 372 walk_option_caller(OTerm, Module:Head), 373 walk_called_by_body(Body, Module, OTerm) 374 )).
382clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
383 clause(Module:, Body, Ref),
384 \+ ( clause_property(Ref, file(File)),
385 module_property(LoadModule, file(File)),
386 \+ scan_module(LoadModule, OTerm)
387 ).
ignore
, error
397walk_called_by_body(True, _, _) :- 398 True == true, 399 !. % quickly deal with facts 400walk_called_by_body(Body, Module, OTerm) :- 401 set_undecided_of_walk_option(error, OTerm, OTerm1), 402 set_evaluate_of_walk_option(false, OTerm1, OTerm2), 403 catch(walk_called(Body, Module, _TermPos, OTerm2), 404 missing(Missing), 405 walk_called_by_body(Missing, Body, Module, OTerm)), 406 !. 407walk_called_by_body(Body, Module, OTerm) :- 408 format(user_error, 'Failed to analyse:~n', []), 409 portray_clause(('<head>' :- Body)), 410 debug_walk(Body, Module, OTerm). 411 412% recompile this library after `debug(codewalk(trace))` and re-try 413% for debugging failures. 414:- if(debugging(codewalk(trace))). 415debug_walk(Body, Module, OTerm) :- 416 gtrace, 417 walk_called_by_body(Body, Module, OTerm). 418:- else. 419debug_walk(_,_,_). 420:- endif.
427walk_called_by_body(Missing, Body, _, OTerm) :- 428 debugging(codewalk), 429 format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]), 430 portray_clause(('<head>' :- Body)), fail. 431walk_called_by_body(undecided_call, Body, Module, OTerm) :- 432 catch(forall(walk_called(Body, Module, _TermPos, OTerm), 433 true), 434 missing(Missing), 435 walk_called_by_body(Missing, Body, Module, OTerm)). 436walk_called_by_body(subterm_positions, Body, Module, OTerm) :- 437 ( ( walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef), 438 clause_info(ClauseRef, _, TermPos, _NameOffset), 439 TermPos = term_position(_,_,_,_,[_,BodyPos]) 440 -> WBody = Body 441 ; walk_option_initialization(OTerm, SrcLoc), 442 ground(SrcLoc), SrcLoc = _File:_Line, 443 initialization_layout(SrcLoc, Module:Body, WBody, BodyPos) 444 ) 445 -> catch(forall(walk_called(WBody, Module, BodyPos, OTerm), 446 true), 447 missing(subterm_positions), 448 walk_called_by_body(no_positions, Body, Module, OTerm)) 449 ; set_source_of_walk_option(false, OTerm, OTerm2), 450 forall(walk_called(Body, Module, _BodyPos, OTerm2), 451 true) 452 ). 453walk_called_by_body(no_positions, Body, Module, OTerm) :- 454 set_source_of_walk_option(false, OTerm, OTerm2), 455 forall(walk_called(Body, Module, _NoPos, OTerm2), 456 true).
If Goal is disjunctive, walk_called succeeds with a
choice-point. Backtracking analyses the alternative control
path(s)
.
Options:
undecided_call
true
(default), evaluate some goals. Notably =/2.486walk_called(Term, Module, parentheses_term_position(_,_,Pos), OTerm) :- 487 nonvar(Pos), 488 !, 489 walk_called(Term, Module, Pos, OTerm). 490walk_called(Var, _, TermPos, OTerm) :- 491 var(Var), % Incomplete analysis 492 !, 493 undecided(Var, TermPos, OTerm). 494walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 495 !, 496 ( nonvar(M) 497 -> walk_called(G, M, Pos, OTerm) 498 ; undecided(M, MPos, OTerm) 499 ). 500walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 501 !, 502 walk_called(A, M, PA, OTerm), 503 walk_called(B, M, PB, OTerm). 504walk_called((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 505 !, 506 walk_called(A, M, PA, OTerm), 507 walk_called(B, M, PB, OTerm). 508walk_called((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 509 !, 510 walk_called(A, M, PA, OTerm), 511 walk_called(B, M, PB, OTerm). 512walk_called(\+(A), M, term_position(_,_,_,_,[PA]), OTerm) :- 513 !, 514 \+ \+ walk_called(A, M, PA, OTerm). 515walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 516 !, 517 ( walk_option_evaluate(OTerm, Eval), Eval == true 518 -> Goal = (A;B), 519 setof(Goal, 520 ( walk_called(A, M, PA, OTerm) 521 ; walk_called(B, M, PB, OTerm) 522 ), 523 Alts0), 524 variants(Alts0, Alts), 525 member(Goal, Alts) 526 ; \+ \+ walk_called(A, M, PA, OTerm), % do not propagate bindings 527 \+ \+ walk_called(B, M, PB, OTerm) 528 ). 529walk_called(Goal, Module, TermPos, OTerm) :- 530 walk_option_trace_reference(OTerm, To), To \== (-), 531 ( subsumes_term(To, Module:Goal) 532 -> M2 = Module 533 ; predicate_property(Module:Goal, imported_from(M2)), 534 subsumes_term(To, M2:Goal) 535 ), 536 trace_condition(M2:Goal, TermPos, OTerm), 537 print_reference(M2:Goal, TermPos, trace, OTerm), 538 fail. % Continue search 539walk_called(Goal, Module, _, OTerm) :- 540 evaluate(Goal, Module, OTerm), 541 !. 542walk_called(Goal, M, TermPos, OTerm) :- 543 ( ( predicate_property(M:Goal, imported_from(IM)) 544 -> true 545 ; IM = M 546 ), 547 prolog:called_by(Goal, IM, M, Called) 548 ; prolog:called_by(Goal, Called) 549 ), 550 Called \== [], 551 !, 552 walk_called_by(Called, M, Goal, TermPos, OTerm). 553walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :- 554 ( walk_option_autoload(OTerm, false) 555 -> nonvar(M), 556 '$get_predicate_attribute'(M:Meta, defined, 1) 557 ; true 558 ), 559 ( predicate_property(M:Meta, meta_predicate(Head)) 560 ; inferred_meta_predicate(M:Meta, Head) 561 ), 562 !, 563 walk_option_clause(OTerm, ClauseRef), 564 register_possible_meta_clause(ClauseRef), 565 walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm). 566walk_called(Closure, _, _, _) :- 567 blob(Closure, closure), 568 !, 569 '$closure_predicate'(Closure, Module:Name/Arity), 570 functor(Head, Name, Arity), 571 '$get_predicate_attribute'(Module:Head, defined, 1). 572walk_called(ClosureCall, _, _, _) :- 573 compound(ClosureCall), 574 compound_name_arity(ClosureCall, Closure, _), 575 blob(Closure, closure), 576 !, 577 '$closure_predicate'(Closure, Module:Name/Arity), 578 functor(Head, Name, Arity), 579 '$get_predicate_attribute'(Module:Head, defined, 1). 580walk_called(Goal, Module, _, _) :- 581 nonvar(Module), 582 '$get_predicate_attribute'(Module:Goal, defined, 1), 583 !. 584walk_called(Goal, Module, TermPos, OTerm) :- 585 callable(Goal), 586 !, 587 undefined(Module:Goal, TermPos, OTerm). 588walk_called(Goal, _Module, TermPos, OTerm) :- 589 not_callable(Goal, TermPos, OTerm).
call(Condition, Callee, Dict)
595trace_condition(Callee, TermPos, OTerm) :- 596 walk_option_trace_condition(OTerm, Cond), nonvar(Cond), 597 !, 598 cond_location_context(OTerm, TermPos, Context0), 599 walk_option_caller(OTerm, Caller), 600 walk_option_module(OTerm, Module), 601 put_dict(#{caller:Caller, module:Module}, Context0, Context), 602 call(Cond, Callee, Context). 603trace_condition(_, _, _). 604 605cond_location_context(OTerm, _TermPos, Context) :- 606 walk_option_clause(OTerm, Clause), nonvar(Clause), 607 !, 608 Context = #{clause:Clause}. 609cond_location_context(OTerm, _TermPos, Context) :- 610 walk_option_initialization(OTerm, Init), nonvar(Init), 611 !, 612 Context = #{initialization:Init}.
616undecided(Var, TermPos, OTerm) :- 617 walk_option_undecided(OTerm, Undecided), 618 ( var(Undecided) 619 -> Action = ignore 620 ; Action = Undecided 621 ), 622 undecided(Action, Var, TermPos, OTerm). 623 624undecided(ignore, _, _, _) :- !. 625undecided(error, _, _, _) :- 626 throw(missing(undecided_call)).
630evaluate(Goal, Module, OTerm) :- 631 walk_option_evaluate(OTerm, Evaluate), 632 Evaluate \== false, 633 evaluate(Goal, Module). 634 635evaluate(A=B, _) :- 636 unify_with_occurs_check(A, B).
642undefined(_, _, OTerm) :- 643 walk_option_undefined(OTerm, ignore), 644 !. 645undefined(Goal, _, _) :- 646 predicate_property(Goal, autoload(_)), 647 !. 648undefined(Goal, TermPos, OTerm) :- 649 ( walk_option_undefined(OTerm, trace) 650 -> Why = trace 651 ; Why = undefined 652 ), 653 print_reference(Goal, TermPos, Why, OTerm).
659not_callable(Goal, TermPos, OTerm) :-
660 print_reference(Goal, TermPos, not_callable, OTerm).
669print_reference(Goal, TermPos, Why, OTerm) :- 670 walk_option_clause(OTerm, Clause), nonvar(Clause), 671 !, 672 ( compound(TermPos), 673 arg(1, TermPos, CharCount), 674 integer(CharCount) % test it is valid 675 -> From = clause_term_position(Clause, TermPos) 676 ; walk_option_source(OTerm, false) 677 -> From = clause(Clause) 678 ; From = _, 679 throw(missing(subterm_positions)) 680 ), 681 print_reference2(Goal, From, Why, OTerm). 682print_reference(Goal, TermPos, Why, OTerm) :- 683 walk_option_initialization(OTerm, Init), nonvar(Init), 684 Init = File:Line, 685 !, 686 ( compound(TermPos), 687 arg(1, TermPos, CharCount), 688 integer(CharCount) % test it is valid 689 -> From = file_term_position(File, TermPos) 690 ; walk_option_source(OTerm, false) 691 -> From = file(File, Line, -1, _) 692 ; From = _, 693 throw(missing(subterm_positions)) 694 ), 695 print_reference2(Goal, From, Why, OTerm). 696print_reference(Goal, _, Why, OTerm) :- 697 print_reference2(Goal, _, Why, OTerm). 698 699print_reference2(Goal, From, trace, OTerm) :- 700 walk_option_on_trace(OTerm, Closure), 701 walk_option_caller(OTerm, Caller), 702 nonvar(Closure), 703 call(Closure, Goal, Caller, From), 704 !. 705print_reference2(Goal, From, Why, _OTerm) :- 706 make_message(Why, Goal, From, Message, Level), 707 print_message(Level, Message). 708 709 710make_message(undefined, Goal, Context, 711 error(existence_error(procedure, PI), Context), error) :- 712 goal_pi(Goal, PI). 713make_message(not_callable, Goal, Context, 714 error(type_error(callable, Goal), Context), error). 715make_message(trace, Goal, Context, 716 trace_call_to(PI, Context), informational) :- 717 goal_pi(Goal, PI). 718 719 720goal_pi(Goal, M:Name/Arity) :- 721 strip_module(Goal, M, Head), 722 callable(Head), 723 !, 724 functor(Head, Name, Arity). 725goal_pi(Goal, Goal). 726 727:- dynamic 728 possible_meta_predicate/2.
737register_possible_meta_clause(ClausesRef) :- 738 nonvar(ClausesRef), 739 clause_property(ClausesRef, predicate(PI)), 740 pi_head(PI, Head, Module), 741 module_property(Module, class(user)), 742 \+ predicate_property(Module:Head, meta_predicate(_)), 743 \+ inferred_meta_predicate(Module:Head, _), 744 \+ possible_meta_predicate(Head, Module), 745 !, 746 assertz(possible_meta_predicate(Head, Module)). 747register_possible_meta_clause(_). 748 749pi_head(Module:Name/Arity, Head, Module) :- 750 !, 751 functor(Head, Name, Arity). 752pi_head(_, _, _) :- 753 assertion(fail).
757infer_new_meta_predicates([], OTerm) :- 758 walk_option_infer_meta_predicates(OTerm, false), 759 !. 760infer_new_meta_predicates(MetaSpecs, OTerm) :- 761 findall(Module:MetaSpec, 762 ( retract(possible_meta_predicate(Head, Module)), 763 infer_meta_predicate(Module:Head, MetaSpec), 764 ( walk_option_infer_meta_predicates(OTerm, all) 765 -> true 766 ; calling_metaspec(MetaSpec) 767 ) 768 ), 769 MetaSpecs).
776calling_metaspec(Head) :- 777 arg(_, Head, Arg), 778 calling_metaarg(Arg), 779 !. 780 781calling_metaarg(I) :- integer(I), !. 782calling_metaarg(^). 783calling_metaarg(//).
796walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :- 797 arg(I, Head, AS), 798 !, 799 ( ArgPosList = [ArgPos|ArgPosTail] 800 -> true 801 ; ArgPos = EPos, 802 ArgPosTail = [] 803 ), 804 ( integer(AS) 805 -> arg(I, Meta, MA), 806 extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm), 807 walk_called(Goal, M, ArgPosEx, OTerm) 808 ; AS == (^) 809 -> arg(I, Meta, MA), 810 remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm), 811 walk_called(Goal, MG, ArgPosEx, OTerm) 812 ; AS == (//) 813 -> arg(I, Meta, DCG), 814 walk_dcg_body(DCG, M, ArgPos, OTerm) 815 ; true 816 ), 817 succ(I, I2), 818 walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm). 819walk_meta_call(_, _, _, _, _, _, _). 820 821remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :- 822 var(Goal), 823 !, 824 undecided(Goal, TermPos, OTerm). 825remove_quantifier(_^Goal0, Goal, 826 term_position(_,_,_,_,[_,GPos]), 827 TermPos, M0, M, OTerm) :- 828 !, 829 remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm). 830remove_quantifier(M1:Goal0, Goal, 831 term_position(_,_,_,_,[_,GPos]), 832 TermPos, _, M, OTerm) :- 833 !, 834 remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm). 835remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
843walk_called_by([], _, _, _, _). 844walk_called_by([H|T], M, Goal, TermPos, OTerm) :- 845 ( H = G0+N 846 -> subterm_pos(G0, M, Goal, TermPos, G, GPos), 847 ( extend(G, N, G2, GPos, GPosEx, OTerm) 848 -> walk_called(G2, M, GPosEx, OTerm) 849 ; true 850 ) 851 ; subterm_pos(H, M, Goal, TermPos, G, GPos), 852 walk_called(G, M, GPos, OTerm) 853 ), 854 walk_called_by(T, M, Goal, TermPos, OTerm). 855 856subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :- 857 subterm_pos(Sub, Term, TermPos, SubTermPos), 858 !. 859subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :- 860 nonvar(Sub), 861 Sub = M:H, 862 !, 863 subterm_pos(H, M, Term, TermPos, G, SubTermPos). 864subterm_pos(Sub, _, _, _, Sub, _). 865 866subterm_pos(Sub, Term, TermPos, SubTermPos) :- 867 subterm_pos(Sub, Term, same_term, TermPos, SubTermPos), 868 !. 869subterm_pos(Sub, Term, TermPos, SubTermPos) :- 870 subterm_pos(Sub, Term, ==, TermPos, SubTermPos), 871 !. 872subterm_pos(Sub, Term, TermPos, SubTermPos) :- 873 subterm_pos(Sub, Term, =@=, TermPos, SubTermPos), 874 !. 875subterm_pos(Sub, Term, TermPos, SubTermPos) :- 876 subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos), 877 !.
883walk_dcg_body(Var, _Module, TermPos, OTerm) :- 884 var(Var), 885 !, 886 undecided(Var, TermPos, OTerm). 887walk_dcg_body([], _Module, _, _) :- !. 888walk_dcg_body([_|_], _Module, _, _) :- !. 889walk_dcg_body(String, _Module, _, _) :- 890 string(String), 891 !. 892walk_dcg_body(!, _Module, _, _) :- !. 893walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 894 !, 895 ( nonvar(M) 896 -> walk_dcg_body(G, M, Pos, OTerm) 897 ; undecided(M, MPos, OTerm) 898 ). 899walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 900 !, 901 walk_dcg_body(A, M, PA, OTerm), 902 walk_dcg_body(B, M, PB, OTerm). 903walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 904 !, 905 walk_dcg_body(A, M, PA, OTerm), 906 walk_dcg_body(B, M, PB, OTerm). 907walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 908 !, 909 walk_dcg_body(A, M, PA, OTerm), 910 walk_dcg_body(B, M, PB, OTerm). 911walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 912 !, 913 ( walk_dcg_body(A, M, PA, OTerm) 914 ; walk_dcg_body(B, M, PB, OTerm) 915 ). 916walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 917 !, 918 ( walk_dcg_body(A, M, PA, OTerm) 919 ; walk_dcg_body(B, M, PB, OTerm) 920 ). 921walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :- 922 !, 923 walk_called(G, M, PG, OTerm). 924walk_dcg_body(G, M, TermPos, OTerm) :- 925 extend(G, 2, G2, TermPos, TermPosEx, OTerm), 926 walk_called(G2, M, TermPosEx, OTerm).
same_term
, ==
, =@=
or subsumes_term
937:- meta_predicate 938 subterm_pos( , , , , ), 939 sublist_pos( , , , , , ). 940:- public 941 subterm_pos/5. % used in library(check). 942 943subterm_pos(_, _, _, Pos, _) :- 944 var(Pos), !, fail. 945subterm_pos(Sub, Term, Cmp, Pos, Pos) :- 946 call(Cmp, Sub, Term), 947 !. 948subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :- 949 is_list(ArgPosList), 950 compound(Term), 951 nth1(I, ArgPosList, ArgPos), 952 arg(I, Term, Arg), 953 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 954subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :- 955 sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos). 956subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :- 957 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 958 959sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :- 960 ( subterm_pos(Sub, H, Cmp, EP, Pos) 961 ; sublist_pos(TP, TailPos, Sub, T, Cmp, Pos) 962 ). 963sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :- 964 TailPos \== none, 965 subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
971extend(Goal, 0, Goal, TermPos, TermPos, _) :- !. 972extend(Goal, _, _, TermPos, TermPos, OTerm) :- 973 var(Goal), 974 !, 975 undecided(Goal, TermPos, OTerm). 976extend(M:Goal, N, M:GoalEx, 977 term_position(F,T,FT,TT,[MPos,GPosIn]), 978 term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :- 979 !, 980 ( var(M) 981 -> undecided(N, MPos, OTerm) 982 ; true 983 ), 984 extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm). 985extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :- 986 callable(Goal), 987 !, 988 Goal =.. List, 989 length(Extra, N), 990 extend_term_pos(TermPosIn, N, TermPosOut), 991 append(List, Extra, ListEx), 992 GoalEx =.. ListEx. 993extend(Closure, N, M:GoalEx, TermPosIn, TermPosOut, OTerm) :- 994 blob(Closure, closure), % call(Closure, A1, ...) 995 !, 996 '$closure_predicate'(Closure, M:Name/Arity), 997 length(Extra, N), 998 extend_term_pos(TermPosIn, N, TermPosOut), 999 GoalEx =.. [Name|Extra], 1000 ( N =:= Arity 1001 -> true 1002 ; print_reference(Closure, TermPosIn, closure_arity_mismatch, OTerm) 1003 ). 1004extend(Goal, _, _, TermPos, _, OTerm) :- 1005 print_reference(Goal, TermPos, not_callable, OTerm). 1006 1007extend_term_pos(Var, _, _) :- 1008 var(Var), 1009 !. 1010extend_term_pos(term_position(F,T,FT,TT,ArgPosIn), 1011 N, 1012 term_position(F,T,FT,TT,ArgPosOut)) :- 1013 !, 1014 length(Extra, N), 1015 maplist(=(0-0), Extra), 1016 append(ArgPosIn, Extra, ArgPosOut). 1017extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :- 1018 length(Extra, N), 1019 maplist(=(0-0), Extra).
1024variants([], []). 1025variants([H|T], List) :- 1026 variants(T, H, List). 1027 1028variants([], H, [H]). 1029variants([H|T], V, List) :- 1030 ( H =@= V 1031 -> variants(T, V, List) 1032 ; List = [V|List2], 1033 variants(T, H, List2) 1034 ).
1040predicate_in_module(Module, PI) :- 1041 current_predicate(Module:PI), 1042 PI = Name/Arity, 1043 \+ hidden_predicate(Name, Arity), 1044 functor(Head, Name, Arity), 1045 \+ predicate_property(Module:Head, imported_from(_)). 1046 1047 Name, _) (:- 1049 atom(Name), % []/N is not hidden 1050 sub_atom(Name, 0, _, _, '$wrap$'). 1051 1052 1053 /******************************* 1054 * ENUMERATE CLAUSES * 1055 *******************************/
module_class(+list(Classes))
1067prolog_program_clause(ClauseRef, Options) :- 1068 make_walk_option(Options, OTerm, _), 1069 setup_call_cleanup( 1070 true, 1071 ( current_module(Module), 1072 scan_module(Module, OTerm), 1073 module_clause(Module, ClauseRef, OTerm) 1074 ; retract(multifile_predicate(Name, Arity, MM)), 1075 multifile_clause(ClauseRef, MM:Name/Arity, OTerm) 1076 ; initialization_clause(ClauseRef, OTerm) 1077 ), 1078 retractall(multifile_predicate(_,_,_))). 1079 1080 1081module_clause(Module, ClauseRef, _OTerm) :- 1082 predicate_in_module(Module, Name/Arity), 1083 \+ multifile_predicate(Name, Arity, Module), 1084 functor(Head, Name, Arity), 1085 ( predicate_property(Module:Head, multifile) 1086 -> assertz(multifile_predicate(Name, Arity, Module)), 1087 fail 1088 ; predicate_property(Module:Head, Property), 1089 no_enum_property(Property) 1090 -> fail 1091 ; catch(nth_clause(Module:Head, _, ClauseRef), _, fail) 1092 ). 1093 1094no_enum_property(foreign). 1095 1096multifile_clause(ClauseRef, M:Name/Arity, OTerm) :- 1097 functor(Head, Name, Arity), 1098 catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm), 1099 _, fail). 1100 1101clauseref_not_from_development(Module:Head, Ref, OTerm) :- 1102 nth_clause(Module:Head, _N, Ref), 1103 \+ ( clause_property(Ref, file(File)), 1104 module_property(LoadModule, file(File)), 1105 \+ scan_module(LoadModule, OTerm) 1106 ). 1107 1108initialization_clause(ClauseRef, OTerm) :- 1109 catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation), 1110 true, ClauseRef), 1111 _, fail), 1112 walk_option_initialization(OTerm, SourceLocation), 1113 scan_module(M, OTerm). 1114 1115 1116 /******************************* 1117 * MESSAGES * 1118 *******************************/ 1119 1120:- multifile 1121 prolog:message//1, 1122 prolog:message_location//1. 1123 1124prologmessage(trace_call_to(PI, Context)) --> 1125 [ 'Call to ~q at '-[PI] ], 1126 '$messages':swi_location(Context). 1127 1128prologmessage_location(clause_term_position(ClauseRef, TermPos)) --> 1129 { clause_property(ClauseRef, file(File)) }, 1130 message_location_file_term_position(File, TermPos). 1131prologmessage_location(clause(ClauseRef)) --> 1132 { clause_property(ClauseRef, file(File)), 1133 clause_property(ClauseRef, line_count(Line)) 1134 }, 1135 !, 1136 [ '~w:~d: '-[File, Line] ]. 1137prologmessage_location(clause(ClauseRef)) --> 1138 { clause_name(ClauseRef, Name) }, 1139 [ '~w: '-[Name] ]. 1140prologmessage_location(file_term_position(Path, TermPos)) --> 1141 message_location_file_term_position(Path, TermPos). 1142prologmessage(codewalk(reiterate(New, Iteration, CPU))) --> 1143 [ 'Found new meta-predicates in iteration ~w (~3f sec)'- 1144 [Iteration, CPU], nl ], 1145 meta_decls(New), 1146 [ 'Restarting analysis ...'-[], nl ]. 1147 1148meta_decls([]) --> []. 1149meta_decls([H|T]) --> 1150 [ ':- meta_predicate ~q.'-[H], nl ], 1151 meta_decls(T). 1152 1153message_location_file_term_position(File, TermPos) --> 1154 { arg(1, TermPos, CharCount), 1155 filepos_line(File, CharCount, Line, LinePos) 1156 }, 1157 [ '~w:~d:~d: '-[File, Line, LinePos] ].
1164filepos_line(File, CharPos, Line, LinePos) :-
1165 setup_call_cleanup(
1166 ( open(File, read, In),
1167 open_null_stream(Out)
1168 ),
1169 ( copy_stream_data(In, Out, CharPos),
1170 stream_property(In, position(Pos)),
1171 stream_position_data(line_count, Pos, Line),
1172 stream_position_data(line_position, Pos, LinePos)
1173 ),
1174 ( close(Out),
1175 close(In)
1176 ))
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.*/