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-2016, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(prolog_codewalk, 36 [ prolog_walk_code/1, % +Options 37 prolog_program_clause/2 % -ClauseRef, +Options 38 ]). 39:- use_module(library(option)). 40:- use_module(library(record)). 41:- use_module(library(debug)). 42:- use_module(library(apply)). 43:- use_module(library(lists)). 44:- use_module(library(prolog_metainference)).
78:- meta_predicate 79 prolog_walk_code( ). 80 81:- multifile 82 prolog:called_by/4, 83 prolog:called_by/2. 84 85:- predicate_options(prolog_walk_code/1, 1, 86 [ undefined(oneof([ignore,error,trace])), 87 autoload(boolean), 88 clauses(list), 89 module(atom), 90 module_class(list(oneof([user,system,library, 91 test,development]))), 92 source(boolean), 93 trace_reference(any), 94 on_trace(callable), 95 infer_meta_predicates(oneof([false,true,all])), 96 evaluate(boolean) 97 ]). 98 99:- record 100 walk_option(undefined:oneof([ignore,error,trace])=ignore, 101 autoload:boolean=true, 102 source:boolean=true, 103 module:atom, % Only analyse given module 104 module_class:list(oneof([user,system,library, 105 test,development]))=[user,library], 106 infer_meta_predicates:oneof([false,true,all])=true, 107 clauses:list, % Walk only these clauses 108 trace_reference:any=(-), 109 on_trace:callable, % Call-back on trace hits 110 % private stuff 111 clause, % Processed clause 112 caller, % Head of the caller 113 initialization, % Initialization source 114 undecided, % Error to throw error 115 evaluate:boolean). % Do partial evaluation 116 117:- thread_local 118 multifile_predicate/3. % Name, Arity, Module
Options processed:
ignore
or
error
.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
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.
@compat OnTrace was called using Caller-Location in older versions.
190prolog_walk_code(Options) :- 191 meta_options(is_meta, Options, QOptions), 192 prolog_walk_code(1, QOptions). 193 194prolog_walk_code(Iteration, Options) :- 195 statistics(cputime, CPU0), 196 make_walk_option(Options, OTerm, _), 197 ( walk_option_clauses(OTerm, Clauses), 198 nonvar(Clauses) 199 -> walk_clauses(Clauses, OTerm) 200 ; forall(( walk_option_module(OTerm, M), 201 current_module(M), 202 scan_module(M, OTerm) 203 ), 204 find_walk_from_module(M, OTerm)), 205 walk_from_multifile(OTerm), 206 walk_from_initialization(OTerm) 207 ), 208 infer_new_meta_predicates(New, OTerm), 209 statistics(cputime, CPU1), 210 ( New \== [] 211 -> CPU is CPU1-CPU0, 212 print_message(informational, 213 codewalk(reiterate(New, Iteration, CPU))), 214 succ(Iteration, Iteration2), 215 prolog_walk_code(Iteration2, Options) 216 ; true 217 ). 218 219is_meta(on_trace).
226walk_clauses(Clauses, OTerm) :-
227 must_be(list, Clauses),
228 forall(member(ClauseRef, Clauses),
229 ( user:clause(, Body, ClauseRef),
230 ( CHead = Module:Head
231 -> true
232 ; Module = user,
233 Head = CHead
234 ),
235 walk_option_clause(OTerm, ClauseRef),
236 walk_option_caller(OTerm, Module:Head),
237 walk_called_by_body(Body, Module, OTerm)
238 )).
244scan_module(M, OTerm) :-
245 walk_option_module_class(OTerm, Classes),
246 module_property(M, class(Class)),
247 memberchk(Class, Classes).
256walk_from_initialization(OTerm) :- 257 walk_option_caller(OTerm, '<initialization>'), 258 forall('$init_goal'(_File, Goal, SourceLocation), 259 ( walk_option_initialization(OTerm, SourceLocation), 260 walk_from_initialization(Goal, OTerm))). 261 262walk_from_initialization(M:Goal, OTerm) :- 263 scan_module(M, OTerm), 264 !, 265 walk_called_by_body(Goal, M, OTerm). 266walk_from_initialization(_, _).
274find_walk_from_module(M, OTerm) :- 275 debug(autoload, 'Analysing module ~q', [M]), 276 forall(predicate_in_module(M, PI), 277 walk_called_by_pred(M:PI, OTerm)). 278 279walk_called_by_pred(Module:Name/Arity, _) :- 280 multifile_predicate(Name, Arity, Module), 281 !. 282walk_called_by_pred(Module:Name/Arity, _) :- 283 functor(Head, Name, Arity), 284 predicate_property(Module:Head, multifile), 285 !, 286 assertz(multifile_predicate(Name, Arity, Module)). 287walk_called_by_pred(Module:Name/Arity, OTerm) :- 288 functor(Head, Name, Arity), 289 ( no_walk_property(Property), 290 predicate_property(Module:Head, Property) 291 -> true 292 ; walk_option_caller(OTerm, Module:Head), 293 walk_option_clause(OTerm, ClauseRef), 294 forall(catch(clause(Module:, Body, ClauseRef), _, fail), 295 walk_called_by_body(Body, Module, OTerm)) 296 ). 297 298no_walk_property(number_of_rules(0)). % no point walking only facts 299no_walk_property(foreign). % cannot walk foreign code
305walk_from_multifile(OTerm) :- 306 forall(retract(multifile_predicate(Name, Arity, Module)), 307 walk_called_by_multifile(Module:Name/Arity, OTerm)). 308 309walk_called_by_multifile(Module:Name/Arity, OTerm) :- 310 functor(Head, Name, Arity), 311 forall(catch(clause_not_from_development( 312 Module:Head, Body, ClauseRef, OTerm), 313 _, fail), 314 ( walk_option_clause(OTerm, ClauseRef), 315 walk_option_caller(OTerm, Module:Head), 316 walk_called_by_body(Body, Module, OTerm) 317 )).
325clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
326 clause(Module:, Body, Ref),
327 \+ ( clause_property(Ref, file(File)),
328 module_property(LoadModule, file(File)),
329 \+ scan_module(LoadModule, OTerm)
330 ).
ignore
, error
340walk_called_by_body(True, _, _) :- 341 True == true, 342 !. % quickly deal with facts 343walk_called_by_body(Body, Module, OTerm) :- 344 set_undecided_of_walk_option(error, OTerm, OTerm1), 345 set_evaluate_of_walk_option(false, OTerm1, OTerm2), 346 catch(walk_called(Body, Module, _TermPos, OTerm2), 347 missing(Missing), 348 walk_called_by_body(Missing, Body, Module, OTerm)), 349 !. 350walk_called_by_body(Body, Module, OTerm) :- 351 format(user_error, 'Failed to analyse:~n', []), 352 portray_clause(('<head>' :- Body)), 353 debug_walk(Body, Module, OTerm). 354 355% recompile this library after `debug(codewalk(trace))` and re-try 356% for debugging failures. 357:- if(debugging(codewalk(trace))). 358debug_walk(Body, Module, OTerm) :- 359 gtrace, 360 walk_called_by_body(Body, Module, OTerm). 361:- else. 362debug_walk(_,_,_). 363:- endif.
370walk_called_by_body(Missing, Body, _, OTerm) :- 371 debugging(codewalk), 372 format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]), 373 portray_clause(('<head>' :- Body)), fail. 374walk_called_by_body(undecided_call, Body, Module, OTerm) :- 375 catch(forall(walk_called(Body, Module, _TermPos, OTerm), 376 true), 377 missing(Missing), 378 walk_called_by_body(Missing, Body, Module, OTerm)). 379walk_called_by_body(subterm_positions, Body, Module, OTerm) :- 380 ( ( walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef), 381 clause_info(ClauseRef, _, TermPos, _NameOffset), 382 TermPos = term_position(_,_,_,_,[_,BodyPos]) 383 -> WBody = Body 384 ; walk_option_initialization(OTerm, SrcLoc), 385 ground(SrcLoc), SrcLoc = _File:_Line, 386 initialization_layout(SrcLoc, Module:Body, WBody, BodyPos) 387 ) 388 -> catch(forall(walk_called(WBody, Module, BodyPos, OTerm), 389 true), 390 missing(subterm_positions), 391 walk_called_by_body(no_positions, Body, Module, OTerm)) 392 ; set_source_of_walk_option(false, OTerm, OTerm2), 393 forall(walk_called(Body, Module, _BodyPos, OTerm2), 394 true) 395 ). 396walk_called_by_body(no_positions, Body, Module, OTerm) :- 397 set_source_of_walk_option(false, OTerm, OTerm2), 398 forall(walk_called(Body, Module, _NoPos, OTerm2), 399 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.429walk_called(Term, Module, parentheses_term_position(_,_,Pos), OTerm) :- 430 nonvar(Pos), 431 !, 432 walk_called(Term, Module, Pos, OTerm). 433walk_called(Var, _, TermPos, OTerm) :- 434 var(Var), % Incomplete analysis 435 !, 436 undecided(Var, TermPos, OTerm). 437walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 438 !, 439 ( nonvar(M) 440 -> walk_called(G, M, Pos, OTerm) 441 ; undecided(M, MPos, OTerm) 442 ). 443walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 444 !, 445 walk_called(A, M, PA, OTerm), 446 walk_called(B, M, PB, OTerm). 447walk_called((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 448 !, 449 walk_called(A, M, PA, OTerm), 450 walk_called(B, M, PB, OTerm). 451walk_called((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 452 !, 453 walk_called(A, M, PA, OTerm), 454 walk_called(B, M, PB, OTerm). 455walk_called(\+(A), M, term_position(_,_,_,_,[PA]), OTerm) :- 456 !, 457 \+ \+ walk_called(A, M, PA, OTerm). 458walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 459 !, 460 ( walk_option_evaluate(OTerm, Eval), Eval == true 461 -> Goal = (A;B), 462 setof(Goal, 463 ( walk_called(A, M, PA, OTerm) 464 ; walk_called(B, M, PB, OTerm) 465 ), 466 Alts0), 467 variants(Alts0, Alts), 468 member(Goal, Alts) 469 ; \+ \+ walk_called(A, M, PA, OTerm), % do not propagate bindings 470 \+ \+ walk_called(B, M, PB, OTerm) 471 ). 472walk_called(Goal, Module, TermPos, OTerm) :- 473 walk_option_trace_reference(OTerm, To), To \== (-), 474 ( subsumes_term(To, Module:Goal) 475 -> M2 = Module 476 ; predicate_property(Module:Goal, imported_from(M2)), 477 subsumes_term(To, M2:Goal) 478 ), 479 print_reference(M2:Goal, TermPos, trace, OTerm), 480 fail. % Continue search 481walk_called(Goal, Module, _, OTerm) :- 482 evaluate(Goal, Module, OTerm), 483 !. 484walk_called(Goal, M, TermPos, OTerm) :- 485 ( ( predicate_property(M:Goal, imported_from(IM)) 486 -> true 487 ; IM = M 488 ), 489 prolog:called_by(Goal, IM, M, Called) 490 ; prolog:called_by(Goal, Called) 491 ), 492 Called \== [], 493 !, 494 walk_called_by(Called, M, Goal, TermPos, OTerm). 495walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :- 496 ( walk_option_autoload(OTerm, false) 497 -> nonvar(M), 498 '$get_predicate_attribute'(M:Meta, defined, 1) 499 ; true 500 ), 501 ( predicate_property(M:Meta, meta_predicate(Head)) 502 ; inferred_meta_predicate(M:Meta, Head) 503 ), 504 !, 505 walk_option_clause(OTerm, ClauseRef), 506 register_possible_meta_clause(ClauseRef), 507 walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm). 508walk_called(Goal, Module, _, _) :- 509 nonvar(Module), 510 '$get_predicate_attribute'(Module:Goal, defined, 1), 511 !. 512walk_called(Goal, Module, TermPos, OTerm) :- 513 callable(Goal), 514 !, 515 undefined(Module:Goal, TermPos, OTerm). 516walk_called(Goal, _Module, TermPos, OTerm) :- 517 not_callable(Goal, TermPos, OTerm).
521undecided(Var, TermPos, OTerm) :- 522 walk_option_undecided(OTerm, Undecided), 523 ( var(Undecided) 524 -> Action = ignore 525 ; Action = Undecided 526 ), 527 undecided(Action, Var, TermPos, OTerm). 528 529undecided(ignore, _, _, _) :- !. 530undecided(error, _, _, _) :- 531 throw(missing(undecided_call)).
535evaluate(Goal, Module, OTerm) :- 536 walk_option_evaluate(OTerm, Evaluate), 537 Evaluate \== false, 538 evaluate(Goal, Module). 539 540evaluate(A=B, _) :- 541 unify_with_occurs_check(A, B).
547undefined(_, _, OTerm) :- 548 walk_option_undefined(OTerm, ignore), 549 !. 550undefined(Goal, _, _) :- 551 predicate_property(Goal, autoload(_)), 552 !. 553undefined(Goal, TermPos, OTerm) :- 554 ( walk_option_undefined(OTerm, trace) 555 -> Why = trace 556 ; Why = undefined 557 ), 558 print_reference(Goal, TermPos, Why, OTerm).
564not_callable(Goal, TermPos, OTerm) :-
565 print_reference(Goal, TermPos, not_callable, OTerm).
574print_reference(Goal, TermPos, Why, OTerm) :- 575 walk_option_clause(OTerm, Clause), nonvar(Clause), 576 !, 577 ( compound(TermPos), 578 arg(1, TermPos, CharCount), 579 integer(CharCount) % test it is valid 580 -> From = clause_term_position(Clause, TermPos) 581 ; walk_option_source(OTerm, false) 582 -> From = clause(Clause) 583 ; From = _, 584 throw(missing(subterm_positions)) 585 ), 586 print_reference2(Goal, From, Why, OTerm). 587print_reference(Goal, TermPos, Why, OTerm) :- 588 walk_option_initialization(OTerm, Init), nonvar(Init), 589 Init = File:Line, 590 !, 591 ( compound(TermPos), 592 arg(1, TermPos, CharCount), 593 integer(CharCount) % test it is valid 594 -> From = file_term_position(File, TermPos) 595 ; walk_option_source(OTerm, false) 596 -> From = file(File, Line, -1, _) 597 ; From = _, 598 throw(missing(subterm_positions)) 599 ), 600 print_reference2(Goal, From, Why, OTerm). 601print_reference(Goal, _, Why, OTerm) :- 602 print_reference2(Goal, _, Why, OTerm). 603 604print_reference2(Goal, From, trace, OTerm) :- 605 walk_option_on_trace(OTerm, Closure), 606 walk_option_caller(OTerm, Caller), 607 nonvar(Closure), 608 call(Closure, Goal, Caller, From), 609 !. 610print_reference2(Goal, From, Why, _OTerm) :- 611 make_message(Why, Goal, From, Message, Level), 612 print_message(Level, Message). 613 614 615make_message(undefined, Goal, Context, 616 error(existence_error(procedure, PI), Context), error) :- 617 goal_pi(Goal, PI). 618make_message(not_callable, Goal, Context, 619 error(type_error(callable, Goal), Context), error). 620make_message(trace, Goal, Context, 621 trace_call_to(PI, Context), informational) :- 622 goal_pi(Goal, PI). 623 624 625goal_pi(Goal, M:Name/Arity) :- 626 strip_module(Goal, M, Head), 627 callable(Head), 628 !, 629 functor(Head, Name, Arity). 630goal_pi(Goal, Goal). 631 632:- dynamic 633 possible_meta_predicate/2.
642register_possible_meta_clause(ClausesRef) :- 643 nonvar(ClausesRef), 644 clause_property(ClausesRef, predicate(PI)), 645 pi_head(PI, Head, Module), 646 module_property(Module, class(user)), 647 \+ predicate_property(Module:Head, meta_predicate(_)), 648 \+ inferred_meta_predicate(Module:Head, _), 649 \+ possible_meta_predicate(Head, Module), 650 !, 651 assertz(possible_meta_predicate(Head, Module)). 652register_possible_meta_clause(_). 653 654pi_head(Module:Name/Arity, Head, Module) :- 655 !, 656 functor(Head, Name, Arity). 657pi_head(_, _, _) :- 658 assertion(fail).
662infer_new_meta_predicates([], OTerm) :- 663 walk_option_infer_meta_predicates(OTerm, false), 664 !. 665infer_new_meta_predicates(MetaSpecs, OTerm) :- 666 findall(Module:MetaSpec, 667 ( retract(possible_meta_predicate(Head, Module)), 668 infer_meta_predicate(Module:Head, MetaSpec), 669 ( walk_option_infer_meta_predicates(OTerm, all) 670 -> true 671 ; calling_metaspec(MetaSpec) 672 ) 673 ), 674 MetaSpecs).
681calling_metaspec(Head) :- 682 arg(_, Head, Arg), 683 calling_metaarg(Arg), 684 !. 685 686calling_metaarg(I) :- integer(I), !. 687calling_metaarg(^). 688calling_metaarg(//).
701walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :- 702 arg(I, Head, AS), 703 !, 704 ( ArgPosList = [ArgPos|ArgPosTail] 705 -> true 706 ; ArgPos = EPos, 707 ArgPosTail = [] 708 ), 709 ( integer(AS) 710 -> arg(I, Meta, MA), 711 extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm), 712 walk_called(Goal, M, ArgPosEx, OTerm) 713 ; AS == (^) 714 -> arg(I, Meta, MA), 715 remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm), 716 walk_called(Goal, MG, ArgPosEx, OTerm) 717 ; AS == (//) 718 -> arg(I, Meta, DCG), 719 walk_dcg_body(DCG, M, ArgPos, OTerm) 720 ; true 721 ), 722 succ(I, I2), 723 walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm). 724walk_meta_call(_, _, _, _, _, _, _). 725 726remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :- 727 var(Goal), 728 !, 729 undecided(Goal, TermPos, OTerm). 730remove_quantifier(_^Goal0, Goal, 731 term_position(_,_,_,_,[_,GPos]), 732 TermPos, M0, M, OTerm) :- 733 !, 734 remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm). 735remove_quantifier(M1:Goal0, Goal, 736 term_position(_,_,_,_,[_,GPos]), 737 TermPos, _, M, OTerm) :- 738 !, 739 remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm). 740remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
748walk_called_by([], _, _, _, _). 749walk_called_by([H|T], M, Goal, TermPos, OTerm) :- 750 ( H = G0+N 751 -> subterm_pos(G0, M, Goal, TermPos, G, GPos), 752 ( extend(G, N, G2, GPos, GPosEx, OTerm) 753 -> walk_called(G2, M, GPosEx, OTerm) 754 ; true 755 ) 756 ; subterm_pos(H, M, Goal, TermPos, G, GPos), 757 walk_called(G, M, GPos, OTerm) 758 ), 759 walk_called_by(T, M, Goal, TermPos, OTerm). 760 761subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :- 762 subterm_pos(Sub, Term, TermPos, SubTermPos), 763 !. 764subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :- 765 nonvar(Sub), 766 Sub = M:H, 767 !, 768 subterm_pos(H, M, Term, TermPos, G, SubTermPos). 769subterm_pos(Sub, _, _, _, Sub, _). 770 771subterm_pos(Sub, Term, TermPos, SubTermPos) :- 772 subterm_pos(Sub, Term, same_term, TermPos, SubTermPos), 773 !. 774subterm_pos(Sub, Term, TermPos, SubTermPos) :- 775 subterm_pos(Sub, Term, ==, TermPos, SubTermPos), 776 !. 777subterm_pos(Sub, Term, TermPos, SubTermPos) :- 778 subterm_pos(Sub, Term, =@=, TermPos, SubTermPos), 779 !. 780subterm_pos(Sub, Term, TermPos, SubTermPos) :- 781 subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos), 782 !.
788walk_dcg_body(Var, _Module, TermPos, OTerm) :- 789 var(Var), 790 !, 791 undecided(Var, TermPos, OTerm). 792walk_dcg_body([], _Module, _, _) :- !. 793walk_dcg_body([_|_], _Module, _, _) :- !. 794walk_dcg_body(String, _Module, _, _) :- 795 string(String), 796 !. 797walk_dcg_body(!, _Module, _, _) :- !. 798walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- 799 !, 800 ( nonvar(M) 801 -> walk_dcg_body(G, M, Pos, OTerm) 802 ; undecided(M, MPos, OTerm) 803 ). 804walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 805 !, 806 walk_dcg_body(A, M, PA, OTerm), 807 walk_dcg_body(B, M, PB, OTerm). 808walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 809 !, 810 walk_dcg_body(A, M, PA, OTerm), 811 walk_dcg_body(B, M, PB, OTerm). 812walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 813 !, 814 walk_dcg_body(A, M, PA, OTerm), 815 walk_dcg_body(B, M, PB, OTerm). 816walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 817 !, 818 ( walk_dcg_body(A, M, PA, OTerm) 819 ; walk_dcg_body(B, M, PB, OTerm) 820 ). 821walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- 822 !, 823 ( walk_dcg_body(A, M, PA, OTerm) 824 ; walk_dcg_body(B, M, PB, OTerm) 825 ). 826walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :- 827 !, 828 walk_called(G, M, PG, OTerm). 829walk_dcg_body(G, M, TermPos, OTerm) :- 830 extend(G, 2, G2, TermPos, TermPosEx, OTerm), 831 walk_called(G2, M, TermPosEx, OTerm).
same_term
, ==
, =@=
or subsumes_term
842:- meta_predicate 843 subterm_pos( , , , , ), 844 sublist_pos( , , , , , ). 845 846subterm_pos(_, _, _, Pos, _) :- 847 var(Pos), !, fail. 848subterm_pos(Sub, Term, Cmp, Pos, Pos) :- 849 call(Cmp, Sub, Term), 850 !. 851subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :- 852 is_list(ArgPosList), 853 compound(Term), 854 nth1(I, ArgPosList, ArgPos), 855 arg(I, Term, Arg), 856 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 857subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :- 858 sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos). 859subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :- 860 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos). 861 862sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :- 863 ( subterm_pos(Sub, H, Cmp, EP, Pos) 864 ; sublist_pos(TP, TailPos, Sub, T, Cmp, Pos) 865 ). 866sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :- 867 TailPos \== none, 868 subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
874extend(Goal, 0, Goal, TermPos, TermPos, _) :- !. 875extend(Goal, _, _, TermPos, TermPos, OTerm) :- 876 var(Goal), 877 !, 878 undecided(Goal, TermPos, OTerm). 879extend(M:Goal, N, M:GoalEx, 880 term_position(F,T,FT,TT,[MPos,GPosIn]), 881 term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :- 882 !, 883 ( var(M) 884 -> undecided(N, MPos, OTerm) 885 ; true 886 ), 887 extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm). 888extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :- 889 callable(Goal), 890 !, 891 Goal =.. List, 892 length(Extra, N), 893 extend_term_pos(TermPosIn, N, TermPosOut), 894 append(List, Extra, ListEx), 895 GoalEx =.. ListEx. 896extend(Goal, _, _, TermPos, _, OTerm) :- 897 print_reference(Goal, TermPos, not_callable, OTerm). 898 899extend_term_pos(Var, _, _) :- 900 var(Var), 901 !. 902extend_term_pos(term_position(F,T,FT,TT,ArgPosIn), 903 N, 904 term_position(F,T,FT,TT,ArgPosOut)) :- 905 !, 906 length(Extra, N), 907 maplist(=(0-0), Extra), 908 append(ArgPosIn, Extra, ArgPosOut). 909extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :- 910 length(Extra, N), 911 maplist(=(0-0), Extra).
916variants([], []). 917variants([H|T], List) :- 918 variants(T, H, List). 919 920variants([], H, [H]). 921variants([H|T], V, List) :- 922 ( H =@= V 923 -> variants(T, V, List) 924 ; List = [V|List2], 925 variants(T, H, List2) 926 ).
932predicate_in_module(Module, PI) :- 933 current_predicate(Module:PI), 934 PI = Name/Arity, 935 functor(Head, Name, Arity), 936 \+ predicate_property(Module:Head, imported_from(_)). 937 938 939 /******************************* 940 * ENUMERATE CLAUSES * 941 *******************************/
module_class(+list(Classes))
953prolog_program_clause(ClauseRef, Options) :- 954 make_walk_option(Options, OTerm, _), 955 setup_call_cleanup( 956 true, 957 ( current_module(Module), 958 scan_module(Module, OTerm), 959 module_clause(Module, ClauseRef, OTerm) 960 ; retract(multifile_predicate(Name, Arity, MM)), 961 multifile_clause(ClauseRef, MM:Name/Arity, OTerm) 962 ; initialization_clause(ClauseRef, OTerm) 963 ), 964 retractall(multifile_predicate(_,_,_))). 965 966 967module_clause(Module, ClauseRef, _OTerm) :- 968 predicate_in_module(Module, Name/Arity), 969 \+ multifile_predicate(Name, Arity, Module), 970 functor(Head, Name, Arity), 971 ( predicate_property(Module:Head, multifile) 972 -> assertz(multifile_predicate(Name, Arity, Module)), 973 fail 974 ; predicate_property(Module:Head, Property), 975 no_enum_property(Property) 976 -> fail 977 ; catch(nth_clause(Module:Head, _, ClauseRef), _, fail) 978 ). 979 980no_enum_property(foreign). 981 982multifile_clause(ClauseRef, M:Name/Arity, OTerm) :- 983 functor(Head, Name, Arity), 984 catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm), 985 _, fail). 986 987clauseref_not_from_development(Module:Head, Ref, OTerm) :- 988 nth_clause(Module:Head, _N, Ref), 989 \+ ( clause_property(Ref, file(File)), 990 module_property(LoadModule, file(File)), 991 \+ scan_module(LoadModule, OTerm) 992 ). 993 994initialization_clause(ClauseRef, OTerm) :- 995 catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation), 996 true, ClauseRef), 997 _, fail), 998 walk_option_initialization(OTerm, SourceLocation), 999 scan_module(M, OTerm). 1000 1001 1002 /******************************* 1003 * MESSAGES * 1004 *******************************/ 1005 1006:- multifile 1007 prolog:message//1, 1008 prolog:message_location//1. 1009 1010prologmessage(trace_call_to(PI, Context)) --> 1011 [ 'Call to ~q at '-[PI] ], 1012 prolog:message_location(Context). 1013 1014prologmessage_location(clause_term_position(ClauseRef, TermPos)) --> 1015 { clause_property(ClauseRef, file(File)) }, 1016 message_location_file_term_position(File, TermPos). 1017prologmessage_location(clause(ClauseRef)) --> 1018 { clause_property(ClauseRef, file(File)), 1019 clause_property(ClauseRef, line_count(Line)) 1020 }, 1021 !, 1022 [ '~w:~d: '-[File, Line] ]. 1023prologmessage_location(clause(ClauseRef)) --> 1024 { clause_name(ClauseRef, Name) }, 1025 [ '~w: '-[Name] ]. 1026prologmessage_location(file_term_position(Path, TermPos)) --> 1027 message_location_file_term_position(Path, TermPos). 1028prologmessage(codewalk(reiterate(New, Iteration, CPU))) --> 1029 [ 'Found new meta-predicates in iteration ~w (~3f sec)'- 1030 [Iteration, CPU], nl ], 1031 meta_decls(New), 1032 [ 'Restarting analysis ...'-[], nl ]. 1033 1034meta_decls([]) --> []. 1035meta_decls([H|T]) --> 1036 [ ':- meta_predicate ~q.'-[H], nl ], 1037 meta_decls(T). 1038 1039message_location_file_term_position(File, TermPos) --> 1040 { arg(1, TermPos, CharCount), 1041 filepos_line(File, CharCount, Line, LinePos) 1042 }, 1043 [ '~w:~d:~d: '-[File, Line, LinePos] ].
1050filepos_line(File, CharPos, Line, LinePos) :-
1051 setup_call_cleanup(
1052 ( open(File, read, In),
1053 open_null_stream(Out)
1054 ),
1055 ( copy_stream_data(In, Out, CharPos),
1056 stream_property(In, position(Pos)),
1057 stream_position_data(line_count, Pos, Line),
1058 stream_position_data(line_position, Pos, LinePos)
1059 ),
1060 ( close(Out),
1061 close(In)
1062 ))
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 seperate 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.*/