1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org/projects/xpce/ 6 Copyright (c) 2006-2022, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module(prolog_xref, 39 [ xref_source/1, % +Source 40 xref_source/2, % +Source, +Options 41 xref_called/3, % ?Source, ?Callable, ?By 42 xref_called/4, % ?Source, ?Callable, ?By, ?Cond 43 xref_called/5, % ?Source, ?Callable, ?By, ?Cond, ?Line 44 xref_defined/3, % ?Source. ?Callable, -How 45 xref_definition_line/2, % +How, -Line 46 xref_exported/2, % ?Source, ?Callable 47 xref_module/2, % ?Source, ?Module 48 xref_uses_file/3, % ?Source, ?Spec, ?Path 49 xref_op/2, % ?Source, ?Op 50 xref_prolog_flag/4, % ?Source, ?Flag, ?Value, ?Line 51 xref_comment/3, % ?Source, ?Title, ?Comment 52 xref_comment/4, % ?Source, ?Head, ?Summary, ?Comment 53 xref_mode/3, % ?Source, ?Mode, ?Det 54 xref_option/2, % ?Source, ?Option 55 xref_clean/1, % +Source 56 xref_current_source/1, % ?Source 57 xref_done/2, % +Source, -When 58 xref_built_in/1, % ?Callable 59 xref_source_file/3, % +Spec, -Path, +Source 60 xref_source_file/4, % +Spec, -Path, +Source, +Options 61 xref_public_list/3, % +File, +Src, +Options 62 xref_public_list/4, % +File, -Path, -Export, +Src 63 xref_public_list/6, % +File, -Path, -Module, -Export, -Meta, +Src 64 xref_public_list/7, % +File, -Path, -Module, -Export, -Public, -Meta, +Src 65 xref_meta/3, % +Source, +Goal, -Called 66 xref_meta/2, % +Goal, -Called 67 xref_hook/1, % ?Callable 68 % XPCE class references 69 xref_used_class/2, % ?Source, ?ClassName 70 xref_defined_class/3 % ?Source, ?ClassName, -How 71 ]). 72:- autoload(library(apply),[maplist/2,partition/4,maplist/3]). 73:- autoload(library(debug),[debug/3]). 74:- autoload(library(dialect),[expects_dialect/1]). 75:- autoload(library(error),[must_be/2,instantiation_error/1]). 76:- autoload(library(lists),[member/2,append/2,append/3,select/3]). 77:- autoload(library(modules),[in_temporary_module/3]). 78:- autoload(library(operators),[push_op/3]). 79:- autoload(library(option),[option/2,option/3]). 80:- autoload(library(ordsets),[ord_intersect/2,ord_intersection/3]). 81:- autoload(library(prolog_code), [pi_head/2]). 82:- autoload(library(prolog_source), 83 [ prolog_canonical_source/2, 84 prolog_open_source/2, 85 prolog_close_source/1, 86 prolog_read_source_term/4 87 ]). 88 89:- if(exists_source(library(shlib))). 90:- autoload(library(shlib),[current_foreign_library/2]). 91:- endif. 92:- autoload(library(solution_sequences),[distinct/2,limit/2]). 93 94:- if(exists_source(library(pldoc))). 95:- use_module(library(pldoc), []). % Must be loaded before doc_process 96:- use_module(library(pldoc/doc_process)). 97 98:- endif. 99 100:- predicate_options(xref_source/2, 2, 101 [ silent(boolean), 102 module(atom), 103 register_called(oneof([all,non_iso,non_built_in])), 104 comments(oneof([store,collect,ignore])), 105 process_include(boolean) 106 ]). 107 108 109:- dynamic 110 called/5, % Head, Src, From, Cond, Line 111 (dynamic)/3, % Head, Src, Line 112 (thread_local)/3, % Head, Src, Line 113 (multifile)/3, % Head, Src, Line 114 (public)/3, % Head, Src, Line 115 defined/3, % Head, Src, Line 116 meta_goal/3, % Head, Called, Src 117 foreign/3, % Head, Src, Line 118 constraint/3, % Head, Src, Line 119 imported/3, % Head, Src, From 120 exported/2, % Head, Src 121 xmodule/2, % Module, Src 122 uses_file/3, % Spec, Src, Path 123 xop/2, % Src, Op 124 source/2, % Src, Time 125 used_class/2, % Name, Src 126 defined_class/5, % Name, Super, Summary, Src, Line 127 (mode)/2, % Mode, Src 128 xoption/2, % Src, Option 129 xflag/4, % Name, Value, Src, Line 130 131 module_comment/3, % Src, Title, Comment 132 pred_comment/4, % Head, Src, Summary, Comment 133 pred_comment_link/3, % Head, Src, HeadTo 134 pred_mode/3. % Head, Src, Det 135 136:- create_prolog_flag(xref, false, [type(boolean)]).
173:- predicate_options(xref_source_file/4, 4, 174 [ file_type(oneof([txt,prolog,directory])), 175 silent(boolean) 176 ]). 177:- predicate_options(xref_public_list/3, 3, 178 [ path(-atom), 179 module(-atom), 180 exports(-list(any)), 181 public(-list(any)), 182 meta(-list(any)), 183 silent(boolean) 184 ]). 185 186 187 /******************************* 188 * HOOKS * 189 *******************************/
216:- multifile 217 prolog:called_by/4, % +Goal, +Module, +Context, -Called 218 prolog:called_by/2, % +Goal, -Called 219 prolog:meta_goal/2, % +Goal, -Pattern 220 prolog:hook/1, % +Callable 221 prolog:generated_predicate/1, % :PI 222 prolog:no_autoload_module/1. % Module is not suitable for autoloading. 223 224:- meta_predicate 225 prolog:generated_predicate(). 226 227:- dynamic 228 meta_goal/2. 229 230:- meta_predicate 231 process_predicates(, , ). 232 233 /******************************* 234 * BUILT-INS * 235 *******************************/
register_called.243hide_called(Callable, Src) :- 244 xoption(Src, register_called(Which)), 245 !, 246 mode_hide_called(Which, Callable). 247hide_called(Callable, _) :- 248 mode_hide_called(non_built_in, Callable). 249 250mode_hide_called(all, _) :- !, fail. 251mode_hide_called(non_iso, _:Goal) :- 252 goal_name_arity(Goal, Name, Arity), 253 current_predicate(system:Name/Arity), 254 predicate_property(system:Goal, iso). 255mode_hide_called(non_built_in, _:Goal) :- 256 goal_name_arity(Goal, Name, Arity), 257 current_predicate(system:Name/Arity), 258 predicate_property(system:Goal, built_in). 259mode_hide_called(non_built_in, M:Goal) :- 260 goal_name_arity(Goal, Name, Arity), 261 current_predicate(M:Name/Arity), 262 predicate_property(M:Goal, built_in).
268system_predicate(Goal) :- 269 goal_name_arity(Goal, Name, Arity), 270 current_predicate(system:Name/Arity), % avoid autoloading 271 predicate_property(system:Goal, built_in), 272 !. 273 274 275 /******************************** 276 * TOPLEVEL * 277 ********************************/ 278 279verbose(Src) :- 280 \+ xoption(Src, silent(true)). 281 282:- thread_local 283 xref_input/2. % File, Stream
true (default false), emit warning messages.all, non_iso or non_built_in.store, comments are stored into
the database as if the file was compiled. If collect,
comments are entered to the xref database and made available
through xref_mode/2 and xref_comment/4. If ignore,
comments are simply ignored. Default is to collect comments.true).311xref_source(Source) :- 312 xref_source(Source, []). 313 314xref_source(Source, Options) :- 315 prolog_canonical_source(Source, Src), 316 ( last_modified(Source, Modified) 317 -> ( source(Src, Modified) 318 -> true 319 ; xref_clean(Src), 320 assert(source(Src, Modified)), 321 do_xref(Src, Options) 322 ) 323 ; xref_clean(Src), 324 get_time(Now), 325 assert(source(Src, Now)), 326 do_xref(Src, Options) 327 ). 328 329do_xref(Src, Options) :- 330 must_be(list, Options), 331 setup_call_cleanup( 332 xref_setup(Src, In, Options, State), 333 collect(Src, Src, In, Options), 334 xref_cleanup(State)). 335 336last_modified(Source, Modified) :- 337 prolog:xref_source_time(Source, Modified), 338 !. 339last_modified(Source, Modified) :- 340 atom(Source), 341 \+ is_global_url(Source), 342 exists_file(Source), 343 time_file(Source, Modified). 344 345is_global_url(File) :- 346 sub_atom(File, B, _, _, '://'), 347 !, 348 B > 1, 349 sub_atom(File, 0, B, _, Scheme), 350 atom_codes(Scheme, Codes), 351 maplist(between(0'a, 0'z), Codes). 352 353xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :- 354 maplist(assert_option(Src), Options), 355 assert_default_options(Src), 356 current_prolog_flag(emulated_dialect, Dialect), 357 prolog_open_source(Src, In), 358 set_initial_mode(In, Options), 359 asserta(xref_input(Src, In), SRef), 360 set_xref(Xref), 361 ( verbose(Src) 362 -> HRefs = [] 363 ; asserta((user:thread_message_hook(_,Level,_) :- 364 hide_message(Level)), 365 Ref), 366 HRefs = [Ref] 367 ). 368 369hide_message(warning). 370hide_message(error). 371hide_message(informational). 372 373assert_option(_, Var) :- 374 var(Var), 375 !, 376 instantiation_error(Var). 377assert_option(Src, silent(Boolean)) :- 378 !, 379 must_be(boolean, Boolean), 380 assert(xoption(Src, silent(Boolean))). 381assert_option(Src, register_called(Which)) :- 382 !, 383 must_be(oneof([all,non_iso,non_built_in]), Which), 384 assert(xoption(Src, register_called(Which))). 385assert_option(Src, comments(CommentHandling)) :- 386 !, 387 must_be(oneof([store,collect,ignore]), CommentHandling), 388 assert(xoption(Src, comments(CommentHandling))). 389assert_option(Src, module(Module)) :- 390 !, 391 must_be(atom, Module), 392 assert(xoption(Src, module(Module))). 393assert_option(Src, process_include(Boolean)) :- 394 !, 395 must_be(boolean, Boolean), 396 assert(xoption(Src, process_include(Boolean))). 397 398assert_default_options(Src) :- 399 ( xref_option_default(Opt), 400 generalise_term(Opt, Gen), 401 ( xoption(Src, Gen) 402 -> true 403 ; assertz(xoption(Src, Opt)) 404 ), 405 fail 406 ; true 407 ). 408 409xref_option_default(silent(false)). 410xref_option_default(register_called(non_built_in)). 411xref_option_default(comments(collect)). 412xref_option_default(process_include(true)).
418xref_cleanup(state(In, Dialect, Xref, Refs)) :- 419 prolog_close_source(In), 420 set_prolog_flag(emulated_dialect, Dialect), 421 set_prolog_flag(xref, Xref), 422 maplist(erase, Refs). 423 424set_xref(Xref) :- 425 current_prolog_flag(xref, Xref), 426 set_prolog_flag(xref, true).
435set_initial_mode(_Stream, Options) :- 436 option(module(Module), Options), 437 !, 438 '$set_source_module'(Module). 439set_initial_mode(Stream, _) :- 440 stream_property(Stream, file_name(Path)), 441 source_file_property(Path, load_context(M, _, Opts)), 442 !, 443 '$set_source_module'(M), 444 ( option(dialect(Dialect), Opts) 445 -> expects_dialect(Dialect) 446 ; true 447 ). 448set_initial_mode(_, _) :- 449 '$set_source_module'(user).
455xref_input_stream(Stream) :-
456 xref_input(_, Var),
457 !,
458 Stream = Var.465xref_push_op(Src, P, T, N0) :- 466 '$current_source_module'(M0), 467 strip_module(M0:N0, M, N), 468 ( is_list(N), 469 N \== [] 470 -> maplist(push_op(Src, P, T, M), N) 471 ; push_op(Src, P, T, M, N) 472 ). 473 474push_op(Src, P, T, M0, N0) :- 475 strip_module(M0:N0, M, N), 476 Name = M:N, 477 valid_op(op(P,T,Name)), 478 push_op(P, T, Name), 479 assert_op(Src, op(P,T,Name)), 480 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 481 482valid_op(op(P,T,M:N)) :- 483 atom(M), 484 valid_op_name(N), 485 integer(P), 486 between(0, 1200, P), 487 atom(T), 488 op_type(T). 489 490valid_op_name(N) :- 491 atom(N), 492 !. 493valid_op_name(N) :- 494 N == []. 495 496op_type(xf). 497op_type(yf). 498op_type(fx). 499op_type(fy). 500op_type(xfx). 501op_type(xfy). 502op_type(yfx).
508xref_set_prolog_flag(Flag, Value, Src, Line) :- 509 atom(Flag), 510 !, 511 assertz(xflag(Flag, Value, Src, Line)). 512xref_set_prolog_flag(_, _, _, _).
518xref_clean(Source) :- 519 prolog_canonical_source(Source, Src), 520 retractall(called(_, Src, _Origin, _Cond, _Line)), 521 retractall(dynamic(_, Src, Line)), 522 retractall(multifile(_, Src, Line)), 523 retractall(public(_, Src, Line)), 524 retractall(defined(_, Src, Line)), 525 retractall(meta_goal(_, _, Src)), 526 retractall(foreign(_, Src, Line)), 527 retractall(constraint(_, Src, Line)), 528 retractall(imported(_, Src, _From)), 529 retractall(exported(_, Src)), 530 retractall(uses_file(_, Src, _)), 531 retractall(xmodule(_, Src)), 532 retractall(xop(Src, _)), 533 retractall(xoption(Src, _)), 534 retractall(xflag(_Name, _Value, Src, Line)), 535 retractall(source(Src, _)), 536 retractall(used_class(_, Src)), 537 retractall(defined_class(_, _, _, Src, _)), 538 retractall(mode(_, Src)), 539 retractall(module_comment(Src, _, _)), 540 retractall(pred_comment(_, Src, _, _)), 541 retractall(pred_comment_link(_, Src, _)), 542 retractall(pred_mode(_, Src, _)). 543 544 545 /******************************* 546 * READ RESULTS * 547 *******************************/
553xref_current_source(Source) :-
554 source(Source, _Time).
561xref_done(Source, Time) :-
562 prolog_canonical_source(Source, Src),
563 source(Src, Time).Called-By pairs. The xref_called/5 version may return
duplicate Called-By if Called is called from multiple clauses in
By, but at most one call per clause.
585xref_called(Source, Called, By) :- 586 xref_called(Source, Called, By, _). 587 588xref_called(Source, Called, By, Cond) :- 589 canonical_source(Source, Src), 590 distinct(Called-By, called(Called, Src, By, Cond, _)). 591 592xref_called(Source, Called, By, Cond, Line) :- 593 canonical_source(Source, Src), 594 called(Called, Src, By, Cond, Line).
include(File)) directive.
dynamic(Location)thread_local(Location)multifile(Location)public(Location)local(Location)foreign(Location)constraint(Location)imported(From)615xref_defined(Source, Called, How) :- 616 nonvar(Source), 617 !, 618 canonical_source(Source, Src), 619 xref_defined2(How, Src, Called). 620xref_defined(Source, Called, How) :- 621 xref_defined2(How, Src, Called), 622 canonical_source(Source, Src). 623 624xref_defined2(dynamic(Line), Src, Called) :- 625 dynamic(Called, Src, Line). 626xref_defined2(thread_local(Line), Src, Called) :- 627 thread_local(Called, Src, Line). 628xref_defined2(multifile(Line), Src, Called) :- 629 multifile(Called, Src, Line). 630xref_defined2(public(Line), Src, Called) :- 631 public(Called, Src, Line). 632xref_defined2(local(Line), Src, Called) :- 633 defined(Called, Src, Line). 634xref_defined2(foreign(Line), Src, Called) :- 635 foreign(Called, Src, Line). 636xref_defined2(constraint(Line), Src, Called) :- 637 constraint(Called, Src, Line). 638xref_defined2(imported(From), Src, Called) :- 639 imported(Called, Src, From).
647xref_definition_line(local(Line), Line). 648xref_definition_line(dynamic(Line), Line). 649xref_definition_line(thread_local(Line), Line). 650xref_definition_line(multifile(Line), Line). 651xref_definition_line(public(Line), Line). 652xref_definition_line(constraint(Line), Line). 653xref_definition_line(foreign(Line), Line).
660xref_exported(Source, Called) :-
661 prolog_canonical_source(Source, Src),
662 exported(Called, Src).668xref_module(Source, Module) :- 669 nonvar(Source), 670 !, 671 prolog_canonical_source(Source, Src), 672 xmodule(Module, Src). 673xref_module(Source, Module) :- 674 xmodule(Module, Src), 675 prolog_canonical_source(Source, Src).
685xref_uses_file(Source, Spec, Path) :-
686 prolog_canonical_source(Source, Src),
687 uses_file(Spec, Src, Path).
697xref_op(Source, Op) :-
698 prolog_canonical_source(Source, Src),
699 xop(Src, Op).707xref_prolog_flag(Source, Flag, Value, Line) :- 708 prolog_canonical_source(Source, Src), 709 xflag(Flag, Value, Src, Line). 710 711xref_built_in(Head) :- 712 system_predicate(Head). 713 714xref_used_class(Source, Class) :- 715 prolog_canonical_source(Source, Src), 716 used_class(Class, Src). 717 718xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 719 prolog_canonical_source(Source, Src), 720 defined_class(Class, Super, Summary, Src, Line), 721 integer(Line), 722 !. 723xref_defined_class(Source, Class, file(File)) :- 724 prolog_canonical_source(Source, Src), 725 defined_class(Class, _, _, Src, file(File)). 726 727:- thread_local 728 current_cond/1, 729 source_line/1, 730 current_test_unit/2. 731 732current_source_line(Line) :- 733 source_line(Var), 734 !, 735 Line = Var.
743collect(Src, File, In, Options) :- 744 ( Src == File 745 -> SrcSpec = Line 746 ; SrcSpec = (File:Line) 747 ), 748 option(comments(CommentHandling), Options, collect), 749 ( CommentHandling == ignore 750 -> CommentOptions = [], 751 Comments = [] 752 ; CommentHandling == store 753 -> CommentOptions = [ process_comment(true) ], 754 Comments = [] 755 ; CommentOptions = [ comments(Comments) ] 756 ), 757 repeat, 758 catch(prolog_read_source_term( 759 In, Term, Expanded, 760 [ term_position(TermPos) 761 | CommentOptions 762 ]), 763 E, report_syntax_error(E, Src, [])), 764 update_condition(Term), 765 stream_position_data(line_count, TermPos, Line), 766 setup_call_cleanup( 767 asserta(source_line(SrcSpec), Ref), 768 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 769 E, print_message(error, E)), 770 erase(Ref)), 771 EOF == true, 772 !. 773 774report_syntax_error(E, _, _) :- 775 fatal_error(E), 776 throw(E). 777report_syntax_error(_, _, Options) :- 778 option(silent(true), Options), 779 !, 780 fail. 781report_syntax_error(E, Src, _Options) :- 782 ( verbose(Src) 783 -> print_message(error, E) 784 ; true 785 ), 786 fail. 787 788fatal_error(time_limit_exceeded). 789fatal_error(error(resource_error(_),_)).
795update_condition((:-Directive)) :- 796 !, 797 update_cond(Directive). 798update_condition(_). 799 800update_cond(if(Cond)) :- 801 !, 802 asserta(current_cond(Cond)). 803update_cond(else) :- 804 retract(current_cond(C0)), 805 !, 806 assert(current_cond(\+C0)). 807update_cond(elif(Cond)) :- 808 retract(current_cond(C0)), 809 !, 810 assert(current_cond((\+C0,Cond))). 811update_cond(endif) :- 812 retract(current_cond(_)), 813 !. 814update_cond(_).
821current_condition(Condition) :- 822 \+ current_cond(_), 823 !, 824 Condition = true. 825current_condition(Condition) :- 826 findall(C, current_cond(C), List), 827 list_to_conj(List, Condition). 828 829list_to_conj([], true). 830list_to_conj([C], C) :- !. 831list_to_conj([H|T], (H,C)) :- 832 list_to_conj(T, C). 833 834 835 /******************************* 836 * PROCESS * 837 *******************************/
849process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 850 is_list(Expanded), % term_expansion into list. 851 !, 852 ( member(Term, Expanded), 853 process(Term, Term0, Src), 854 Term == end_of_file 855 -> EOF = true 856 ; EOF = false 857 ), 858 xref_comments(Comments, TermPos, Src). 859process(end_of_file, _, _, _, _, true) :- 860 !. 861process(Term, Comments, Term0, TermPos, Src, false) :- 862 process(Term, Term0, Src), 863 xref_comments(Comments, TermPos, Src).
867process(_, Term0, _) :- 868 ignore_raw_term(Term0), 869 !. 870process(Term, _Term0, Src) :- 871 process(Term, Src). 872 873ignore_raw_term((:- predicate_options(_,_,_))).
877process(Var, _) :- 878 var(Var), 879 !. % Warn? 880process(end_of_file, _) :- !. 881process((:- Directive), Src) :- 882 !, 883 process_directive(Directive, Src), 884 !. 885process((?- Directive), Src) :- 886 !, 887 process_directive(Directive, Src), 888 !. 889process((Head :- Body), Src) :- 890 !, 891 assert_defined(Src, Head), 892 process_body(Body, Head, Src). 893process((Left => Body), Src) :- 894 !, 895 ( nonvar(Left), 896 Left = (Head, Guard) 897 -> assert_defined(Src, Head), 898 process_body(Guard, Head, Src), 899 process_body(Body, Head, Src) 900 ; assert_defined(Src, Left), 901 process_body(Body, Left, Src) 902 ). 903process(?=>(Head, Body), Src) :- 904 !, 905 assert_defined(Src, Head), 906 process_body(Body, Head, Src). 907process('$source_location'(_File, _Line):Clause, Src) :- 908 !, 909 process(Clause, Src). 910process(Term, Src) :- 911 process_chr(Term, Src), 912 !. 913process(M:(Head :- Body), Src) :- 914 !, 915 process((M:Head :- M:Body), Src). 916process(Head, Src) :- 917 assert_defined(Src, Head). 918 919 920 /******************************* 921 * COMMENTS * 922 *******************************/
926xref_comments([], _Pos, _Src). 927:- if(current_predicate(parse_comment/3)). 928xref_comments([Pos-Comment|T], TermPos, Src) :- 929 ( Pos @> TermPos % comments inside term 930 -> true 931 ; stream_position_data(line_count, Pos, Line), 932 FilePos = Src:Line, 933 ( parse_comment(Comment, FilePos, Parsed) 934 -> assert_comments(Parsed, Src) 935 ; true 936 ), 937 xref_comments(T, TermPos, Src) 938 ). 939 940assert_comments([], _). 941assert_comments([H|T], Src) :- 942 assert_comment(H, Src), 943 assert_comments(T, Src). 944 945assert_comment(section(_Id, Title, Comment), Src) :- 946 assertz(module_comment(Src, Title, Comment)). 947assert_comment(predicate(PI, Summary, Comment), Src) :- 948 pi_to_head(PI, Src, Head), 949 assertz(pred_comment(Head, Src, Summary, Comment)). 950assert_comment(link(PI, PITo), Src) :- 951 pi_to_head(PI, Src, Head), 952 pi_to_head(PITo, Src, HeadTo), 953 assertz(pred_comment_link(Head, Src, HeadTo)). 954assert_comment(mode(Head, Det), Src) :- 955 assertz(pred_mode(Head, Src, Det)). 956 957pi_to_head(PI, Src, Head) :- 958 pi_to_head(PI, Head0), 959 ( Head0 = _:_ 960 -> strip_module(Head0, M, Plain), 961 ( xmodule(M, Src) 962 -> Head = Plain 963 ; Head = M:Plain 964 ) 965 ; Head = Head0 966 ). 967:- endif.
973xref_comment(Source, Title, Comment) :-
974 canonical_source(Source, Src),
975 module_comment(Src, Title, Comment).
981xref_comment(Source, Head, Summary, Comment) :-
982 canonical_source(Source, Src),
983 ( pred_comment(Head, Src, Summary, Comment)
984 ; pred_comment_link(Head, Src, HeadTo),
985 pred_comment(HeadTo, Src, Summary, Comment)
986 ).
993xref_mode(Source, Mode, Det) :-
994 canonical_source(Source, Src),
995 pred_mode(Mode, Src, Det).1002xref_option(Source, Option) :- 1003 canonical_source(Source, Src), 1004 xoption(Src, Option). 1005 1006 1007 /******************************** 1008 * DIRECTIVES * 1009 ********************************/ 1010 1011process_directive(Var, _) :- 1012 var(Var), 1013 !. % error, but that isn't our business 1014process_directive(Dir, _Src) :- 1015 debug(xref(directive), 'Processing :- ~q', [Dir]), 1016 fail. 1017process_directive((A,B), Src) :- % TBD: what about other control 1018 !, 1019 process_directive(A, Src), % structures? 1020 process_directive(B, Src). 1021process_directive(List, Src) :- 1022 is_list(List), 1023 !, 1024 process_directive(consult(List), Src). 1025process_directive(use_module(File, Import), Src) :- 1026 process_use_module2(File, Import, Src, false). 1027process_directive(autoload(File, Import), Src) :- 1028 process_use_module2(File, Import, Src, false). 1029process_directive(require(Import), Src) :- 1030 process_requires(Import, Src). 1031process_directive(expects_dialect(Dialect), Src) :- 1032 process_directive(use_module(library(dialect/Dialect)), Src), 1033 expects_dialect(Dialect). 1034process_directive(reexport(File, Import), Src) :- 1035 process_use_module2(File, Import, Src, true). 1036process_directive(reexport(Modules), Src) :- 1037 process_use_module(Modules, Src, true). 1038process_directive(autoload(Modules), Src) :- 1039 process_use_module(Modules, Src, false). 1040process_directive(use_module(Modules), Src) :- 1041 process_use_module(Modules, Src, false). 1042process_directive(consult(Modules), Src) :- 1043 process_use_module(Modules, Src, false). 1044process_directive(ensure_loaded(Modules), Src) :- 1045 process_use_module(Modules, Src, false). 1046process_directive(load_files(Files, _Options), Src) :- 1047 process_use_module(Files, Src, false). 1048process_directive(include(Files), Src) :- 1049 process_include(Files, Src). 1050process_directive(dynamic(Dynamic), Src) :- 1051 process_predicates(assert_dynamic, Dynamic, Src). 1052process_directive(dynamic(Dynamic, _Options), Src) :- 1053 process_predicates(assert_dynamic, Dynamic, Src). 1054process_directive(thread_local(Dynamic), Src) :- 1055 process_predicates(assert_thread_local, Dynamic, Src). 1056process_directive(multifile(Dynamic), Src) :- 1057 process_predicates(assert_multifile, Dynamic, Src). 1058process_directive(public(Public), Src) :- 1059 process_predicates(assert_public, Public, Src). 1060process_directive(export(Export), Src) :- 1061 process_predicates(assert_export, Export, Src). 1062process_directive(import(Import), Src) :- 1063 process_import(Import, Src). 1064process_directive(module(Module, Export), Src) :- 1065 assert_module(Src, Module), 1066 assert_module_export(Src, Export). 1067process_directive(module(Module, Export, Import), Src) :- 1068 assert_module(Src, Module), 1069 assert_module_export(Src, Export), 1070 assert_module3(Import, Src). 1071process_directive(begin_tests(Unit, _Options), Src) :- 1072 enter_test_unit(Unit, Src). 1073process_directive(begin_tests(Unit), Src) :- 1074 enter_test_unit(Unit, Src). 1075process_directive(end_tests(Unit), Src) :- 1076 leave_test_unit(Unit, Src). 1077process_directive('$set_source_module'(system), Src) :- 1078 assert_module(Src, system). % hack for handling boot/init.pl 1079process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1080 assert_defined_class(Src, Name, Meta, Super, Doc). 1081process_directive(pce_autoload(Name, From), Src) :- 1082 assert_defined_class(Src, Name, imported_from(From)). 1083 1084process_directive(op(P, A, N), Src) :- 1085 xref_push_op(Src, P, A, N). 1086process_directive(set_prolog_flag(Flag, Value), Src) :- 1087 ( Flag == character_escapes 1088 -> set_prolog_flag(character_escapes, Value) 1089 ; true 1090 ), 1091 current_source_line(Line), 1092 xref_set_prolog_flag(Flag, Value, Src, Line). 1093process_directive(style_check(X), _) :- 1094 style_check(X). 1095process_directive(encoding(Enc), _) :- 1096 ( xref_input_stream(Stream) 1097 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1098 ; true % can this happen? 1099 ). 1100process_directive(pce_expansion:push_compile_operators, _) :- 1101 '$current_source_module'(SM), 1102 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1103process_directive(pce_expansion:pop_compile_operators, _) :- 1104 call(pce_expansion:pop_compile_operators). 1105process_directive(meta_predicate(Meta), Src) :- 1106 process_meta_predicate(Meta, Src). 1107process_directive(arithmetic_function(FSpec), Src) :- 1108 arith_callable(FSpec, Goal), 1109 !, 1110 current_source_line(Line), 1111 assert_called(Src, '<directive>'(Line), Goal, Line). 1112process_directive(format_predicate(_, Goal), Src) :- 1113 !, 1114 current_source_line(Line), 1115 assert_called(Src, '<directive>'(Line), Goal, Line). 1116process_directive(if(Cond), Src) :- 1117 !, 1118 current_source_line(Line), 1119 assert_called(Src, '<directive>'(Line), Cond, Line). 1120process_directive(elif(Cond), Src) :- 1121 !, 1122 current_source_line(Line), 1123 assert_called(Src, '<directive>'(Line), Cond, Line). 1124process_directive(else, _) :- !. 1125process_directive(endif, _) :- !. 1126process_directive(Goal, Src) :- 1127 current_source_line(Line), 1128 process_body(Goal, '<directive>'(Line), Src).
1134process_meta_predicate((A,B), Src) :- 1135 !, 1136 process_meta_predicate(A, Src), 1137 process_meta_predicate(B, Src). 1138process_meta_predicate(Decl, Src) :- 1139 process_meta_head(Src, Decl). 1140 1141process_meta_head(Src, Decl) :- % swapped arguments for maplist 1142 compound(Decl), 1143 compound_name_arity(Decl, Name, Arity), 1144 compound_name_arity(Head, Name, Arity), 1145 meta_args(1, Arity, Decl, Head, Meta), 1146 ( ( prolog:meta_goal(Head, _) 1147 ; prolog:called_by(Head, _, _, _) 1148 ; prolog:called_by(Head, _) 1149 ; meta_goal(Head, _) 1150 ) 1151 -> true 1152 ; assert(meta_goal(Head, Meta, Src)) 1153 ). 1154 1155meta_args(I, Arity, _, _, []) :- 1156 I > Arity, 1157 !. 1158meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1159 arg(I, Decl, 0), 1160 !, 1161 arg(I, Head, H), 1162 I2 is I + 1, 1163 meta_args(I2, Arity, Decl, Head, T). 1164meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1165 arg(I, Decl, ^), 1166 !, 1167 arg(I, Head, EH), 1168 setof_goal(EH, H), 1169 I2 is I + 1, 1170 meta_args(I2, Arity, Decl, Head, T). 1171meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1172 arg(I, Decl, //), 1173 !, 1174 arg(I, Head, H), 1175 I2 is I + 1, 1176 meta_args(I2, Arity, Decl, Head, T). 1177meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1178 arg(I, Decl, A), 1179 integer(A), A > 0, 1180 !, 1181 arg(I, Head, H), 1182 I2 is I + 1, 1183 meta_args(I2, Arity, Decl, Head, T). 1184meta_args(I, Arity, Decl, Head, Meta) :- 1185 I2 is I + 1, 1186 meta_args(I2, Arity, Decl, Head, Meta). 1187 1188 1189 /******************************** 1190 * BODY * 1191 ********************************/
1200xref_meta(Source, Head, Called) :-
1201 canonical_source(Source, Src),
1202 xref_meta_src(Head, Called, Src).1217xref_meta_src(Head, Called, Src) :- 1218 meta_goal(Head, Called, Src), 1219 !. 1220xref_meta_src(Head, Called, _) :- 1221 xref_meta(Head, Called), 1222 !. 1223xref_meta_src(Head, Called, _) :- 1224 compound(Head), 1225 compound_name_arity(Head, Name, Arity), 1226 apply_pred(Name), 1227 Arity > 5, 1228 !, 1229 Extra is Arity - 1, 1230 arg(1, Head, G), 1231 Called = [G+Extra]. 1232xref_meta_src(Head, Called, _) :- 1233 predicate_property('$xref_tmp':Head, meta_predicate(Meta)), 1234 !, 1235 Meta =.. [_|Args], 1236 meta_args(Args, 1, Head, Called). 1237 1238meta_args([], _, _, []). 1239meta_args([H0|T0], I, Head, [H|T]) :- 1240 xargs(H0, N), 1241 !, 1242 arg(I, Head, A), 1243 ( N == 0 1244 -> H = A 1245 ; H = (A+N) 1246 ), 1247 I2 is I+1, 1248 meta_args(T0, I2, Head, T). 1249meta_args([_|T0], I, Head, T) :- 1250 I2 is I+1, 1251 meta_args(T0, I2, Head, T). 1252 1253xargs(N, N) :- integer(N), !. 1254xargs(//, 2). 1255xargs(^, 0). 1256 1257apply_pred(call). % built-in 1258apply_pred(maplist). % library(apply_macros) 1259 1260xref_meta((A, B), [A, B]). 1261xref_meta((A; B), [A, B]). 1262xref_meta((A| B), [A, B]). 1263xref_meta((A -> B), [A, B]). 1264xref_meta((A *-> B), [A, B]). 1265xref_meta(findall(_V,G,_L), [G]). 1266xref_meta(findall(_V,G,_L,_T), [G]). 1267xref_meta(findnsols(_N,_V,G,_L), [G]). 1268xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1269xref_meta(setof(_V, EG, _L), [G]) :- 1270 setof_goal(EG, G). 1271xref_meta(bagof(_V, EG, _L), [G]) :- 1272 setof_goal(EG, G). 1273xref_meta(forall(A, B), [A, B]). 1274xref_meta(maplist(G,_), [G+1]). 1275xref_meta(maplist(G,_,_), [G+2]). 1276xref_meta(maplist(G,_,_,_), [G+3]). 1277xref_meta(maplist(G,_,_,_,_), [G+4]). 1278xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1279xref_meta(map_assoc(G, _), [G+1]). 1280xref_meta(map_assoc(G, _, _), [G+2]). 1281xref_meta(checklist(G, _L), [G+1]). 1282xref_meta(sublist(G, _, _), [G+1]). 1283xref_meta(include(G, _, _), [G+1]). 1284xref_meta(exclude(G, _, _), [G+1]). 1285xref_meta(partition(G, _, _, _, _), [G+2]). 1286xref_meta(partition(G, _, _, _),[G+1]). 1287xref_meta(call(G), [G]). 1288xref_meta(call(G, _), [G+1]). 1289xref_meta(call(G, _, _), [G+2]). 1290xref_meta(call(G, _, _, _), [G+3]). 1291xref_meta(call(G, _, _, _, _), [G+4]). 1292xref_meta(not(G), [G]). 1293xref_meta(notrace(G), [G]). 1294xref_meta('$notrace'(G), [G]). 1295xref_meta(\+(G), [G]). 1296xref_meta(ignore(G), [G]). 1297xref_meta(once(G), [G]). 1298xref_meta(initialization(G), [G]). 1299xref_meta(initialization(G,_), [G]). 1300xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1301xref_meta(clause(G, _), [G]). 1302xref_meta(clause(G, _, _), [G]). 1303xref_meta(phrase(G, _A), [//(G)]). 1304xref_meta(phrase(G, _A, _R), [//(G)]). 1305xref_meta(call_dcg(G, _A, _R), [//(G)]). 1306xref_meta(phrase_from_file(G,_),[//(G)]). 1307xref_meta(catch(A, _, B), [A, B]). 1308xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1309xref_meta(thread_create(A,_,_), [A]). 1310xref_meta(thread_create(A,_), [A]). 1311xref_meta(thread_signal(_,A), [A]). 1312xref_meta(thread_idle(A,_), [A]). 1313xref_meta(thread_at_exit(A), [A]). 1314xref_meta(thread_initialization(A), [A]). 1315xref_meta(engine_create(_,A,_), [A]). 1316xref_meta(engine_create(_,A,_,_), [A]). 1317xref_meta(transaction(A), [A]). 1318xref_meta(transaction(A,B,_), [A,B]). 1319xref_meta(snapshot(A), [A]). 1320xref_meta(predsort(A,_,_), [A+3]). 1321xref_meta(call_cleanup(A, B), [A, B]). 1322xref_meta(call_cleanup(A, _, B),[A, B]). 1323xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1324xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1325xref_meta(call_residue_vars(A,_), [A]). 1326xref_meta(with_mutex(_,A), [A]). 1327xref_meta(assume(G), [G]). % library(debug) 1328xref_meta(assertion(G), [G]). % library(debug) 1329xref_meta(freeze(_, G), [G]). 1330xref_meta(when(C, A), [C, A]). 1331xref_meta(time(G), [G]). % development system 1332xref_meta(call_time(G, _), [G]). % development system 1333xref_meta(call_time(G, _, _), [G]). % development system 1334xref_meta(profile(G), [G]). 1335xref_meta(at_halt(G), [G]). 1336xref_meta(call_with_time_limit(_, G), [G]). 1337xref_meta(call_with_depth_limit(G, _, _), [G]). 1338xref_meta(call_with_inference_limit(G, _, _), [G]). 1339xref_meta(alarm(_, G, _), [G]). 1340xref_meta(alarm(_, G, _, _), [G]). 1341xref_meta('$add_directive_wic'(G), [G]). 1342xref_meta(with_output_to(_, G), [G]). 1343xref_meta(if(G), [G]). 1344xref_meta(elif(G), [G]). 1345xref_meta(meta_options(G,_,_), [G+1]). 1346xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1347xref_meta(distinct(G), [G]). % library(solution_sequences) 1348xref_meta(distinct(_, G), [G]). 1349xref_meta(order_by(_, G), [G]). 1350xref_meta(limit(_, G), [G]). 1351xref_meta(offset(_, G), [G]). 1352xref_meta(reset(G,_,_), [G]). 1353xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1354xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1355xref_meta(tnot(G), [G]). 1356xref_meta(not_exists(G), [G]). 1357xref_meta(with_tty_raw(G), [G]). 1358xref_meta(residual_goals(G), [G+2]). 1359 1360 % XPCE meta-predicates 1361xref_meta(pce_global(_, new(_)), _) :- !, fail. 1362xref_meta(pce_global(_, B), [B+1]). 1363xref_meta(ifmaintainer(G), [G]). % used in manual 1364xref_meta(listen(_, G), [G]). % library(broadcast) 1365xref_meta(listen(_, _, G), [G]). 1366xref_meta(in_pce_thread(G), [G]). 1367 1368xref_meta(G, Meta) :- % call user extensions 1369 prolog:meta_goal(G, Meta). 1370xref_meta(G, Meta) :- % Generated from :- meta_predicate 1371 meta_goal(G, Meta). 1372 1373setof_goal(EG, G) :- 1374 var(EG), !, G = EG. 1375setof_goal(_^EG, G) :- 1376 !, 1377 setof_goal(EG, G). 1378setof_goal(G, G). 1379 1380event_xargs(abort, 0). 1381event_xargs(erase, 1). 1382event_xargs(break, 3). 1383event_xargs(frame_finished, 1). 1384event_xargs(thread_exit, 1). 1385event_xargs(this_thread_exit, 0). 1386event_xargs(PI, 2) :- pi_to_head(PI, _).
1392head_of(Var, _) :- 1393 var(Var), !, fail. 1394head_of((Head :- _), Head). 1395head_of(Head, Head).
1403xref_hook(Hook) :- 1404 prolog:hook(Hook). 1405xref_hook(Hook) :- 1406 hook(Hook). 1407 1408 1409hook(attr_portray_hook(_,_)). 1410hook(attr_unify_hook(_,_)). 1411hook(attribute_goals(_,_,_)). 1412hook(goal_expansion(_,_)). 1413hook(term_expansion(_,_)). 1414hook(resource(_,_,_)). 1415hook('$pred_option'(_,_,_,_)). 1416 1417hook(emacs_prolog_colours:goal_classification(_,_)). 1418hook(emacs_prolog_colours:term_colours(_,_)). 1419hook(emacs_prolog_colours:goal_colours(_,_)). 1420hook(emacs_prolog_colours:style(_,_)). 1421hook(emacs_prolog_colours:identify(_,_)). 1422hook(pce_principal:pce_class(_,_,_,_,_,_)). 1423hook(pce_principal:send_implementation(_,_,_)). 1424hook(pce_principal:get_implementation(_,_,_,_)). 1425hook(pce_principal:pce_lazy_get_method(_,_,_)). 1426hook(pce_principal:pce_lazy_send_method(_,_,_)). 1427hook(pce_principal:pce_uses_template(_,_)). 1428hook(prolog:locate_clauses(_,_)). 1429hook(prolog:message(_,_,_)). 1430hook(prolog:error_message(_,_,_)). 1431hook(prolog:message_location(_,_,_)). 1432hook(prolog:message_context(_,_,_)). 1433hook(prolog:message_line_element(_,_)). 1434hook(prolog:debug_control_hook(_)). 1435hook(prolog:help_hook(_)). 1436hook(prolog:show_profile_hook(_,_)). 1437hook(prolog:general_exception(_,_)). 1438hook(prolog:predicate_summary(_,_)). 1439hook(prolog:residual_goals(_,_)). 1440hook(prolog_edit:load). 1441hook(prolog_edit:locate(_,_,_)). 1442hook(shlib:unload_all_foreign_libraries). 1443hook(system:'$foreign_registered'(_, _)). 1444hook(predicate_options:option_decl(_,_,_)). 1445hook(user:exception(_,_,_)). 1446hook(user:file_search_path(_,_)). 1447hook(user:library_directory(_)). 1448hook(user:message_hook(_,_,_)). 1449hook(user:portray(_)). 1450hook(user:prolog_clause_name(_,_)). 1451hook(user:prolog_list_goal(_)). 1452hook(user:prolog_predicate_name(_,_)). 1453hook(user:prolog_trace_interception(_,_,_,_)). 1454hook(user:prolog_exception_hook(_,_,_,_)). 1455hook(sandbox:safe_primitive(_)). 1456hook(sandbox:safe_meta_predicate(_)). 1457hook(sandbox:safe_meta(_,_)). 1458hook(sandbox:safe_global_variable(_)). 1459hook(sandbox:safe_directive(_)).
1466arith_callable(Var, _) :- 1467 var(Var), !, fail. 1468arith_callable(Module:Spec, Module:Goal) :- 1469 !, 1470 arith_callable(Spec, Goal). 1471arith_callable(Name/Arity, Goal) :- 1472 PredArity is Arity + 1, 1473 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1484process_body(Body, Origin, Src) :-
1485 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1486 true).true if there was a
partial evalation inside Goal that has bound variables.1493process_goal(Var, _, _, _) :- 1494 var(Var), 1495 !. 1496process_goal(_:Goal, _, _, _) :- 1497 var(Goal), 1498 !. 1499process_goal(Goal, Origin, Src, P) :- 1500 Goal = (_,_), % problems 1501 !, 1502 phrase(conjunction(Goal), Goals), 1503 process_conjunction(Goals, Origin, Src, P). 1504process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1505 Goal = (_;_), % problems 1506 !, 1507 phrase(disjunction(Goal), Goals), 1508 forall(member(G, Goals), 1509 process_body(G, Origin, Src)). 1510process_goal(Goal, Origin, Src, P) :- 1511 ( ( xmodule(M, Src) 1512 -> true 1513 ; M = user 1514 ), 1515 pi_head(PI, M:Goal), 1516 ( current_predicate(PI), 1517 predicate_property(M:Goal, imported_from(IM)) 1518 -> true 1519 ; PI = M:Name/Arity, 1520 '$find_library'(M, Name, Arity, IM, _Library) 1521 -> true 1522 ; IM = M 1523 ), 1524 prolog:called_by(Goal, IM, M, Called) 1525 ; prolog:called_by(Goal, Called) 1526 ), 1527 !, 1528 must_be(list, Called), 1529 current_source_line(Here), 1530 assert_called(Src, Origin, Goal, Here), 1531 process_called_list(Called, Origin, Src, P). 1532process_goal(Goal, Origin, Src, _) :- 1533 process_xpce_goal(Goal, Origin, Src), 1534 !. 1535process_goal(load_foreign_library(File), _Origin, Src, _) :- 1536 process_foreign(File, Src). 1537process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1538 process_foreign(File, Src). 1539process_goal(use_foreign_library(File), _Origin, Src, _) :- 1540 process_foreign(File, Src). 1541process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1542 process_foreign(File, Src). 1543process_goal(Goal, Origin, Src, P) :- 1544 xref_meta_src(Goal, Metas, Src), 1545 !, 1546 current_source_line(Here), 1547 assert_called(Src, Origin, Goal, Here), 1548 process_called_list(Metas, Origin, Src, P). 1549process_goal(Goal, Origin, Src, _) :- 1550 asserting_goal(Goal, Rule), 1551 !, 1552 current_source_line(Here), 1553 assert_called(Src, Origin, Goal, Here), 1554 process_assert(Rule, Origin, Src). 1555process_goal(Goal, Origin, Src, P) :- 1556 partial_evaluate(Goal, P), 1557 current_source_line(Here), 1558 assert_called(Src, Origin, Goal, Here). 1559 1560disjunction(Var) --> {var(Var), !}, [Var]. 1561disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1562disjunction(G) --> [G]. 1563 1564conjunction(Var) --> {var(Var), !}, [Var]. 1565conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1566conjunction(G) --> [G]. 1567 (RVars, T) :- 1569 term_variables(T, TVars0), 1570 sort(TVars0, TVars), 1571 ord_intersect(RVars, TVars). 1572 1573process_conjunction([], _, _, _). 1574process_conjunction([Disj|Rest], Origin, Src, P) :- 1575 nonvar(Disj), 1576 Disj = (_;_), 1577 Rest \== [], 1578 !, 1579 phrase(disjunction(Disj), Goals), 1580 term_variables(Rest, RVars0), 1581 sort(RVars0, RVars), 1582 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1583 forall(member(G, NonSHaring), 1584 process_body(G, Origin, Src)), 1585 ( Sharing == [] 1586 -> true 1587 ; maplist(term_variables, Sharing, GVars0), 1588 append(GVars0, GVars1), 1589 sort(GVars1, GVars), 1590 ord_intersection(GVars, RVars, SVars), 1591 VT =.. [v|SVars], 1592 findall(VT, 1593 ( member(G, Sharing), 1594 process_goal(G, Origin, Src, PS), 1595 PS == true 1596 ), 1597 Alts0), 1598 ( Alts0 == [] 1599 -> true 1600 ; ( true 1601 ; P = true, 1602 sort(Alts0, Alts1), 1603 variants(Alts1, 10, Alts), 1604 member(VT, Alts) 1605 ) 1606 ) 1607 ), 1608 process_conjunction(Rest, Origin, Src, P). 1609process_conjunction([H|T], Origin, Src, P) :- 1610 process_goal(H, Origin, Src, P), 1611 process_conjunction(T, Origin, Src, P). 1612 1613 1614process_called_list([], _, _, _). 1615process_called_list([H|T], Origin, Src, P) :- 1616 process_meta(H, Origin, Src, P), 1617 process_called_list(T, Origin, Src, P). 1618 1619process_meta(A+N, Origin, Src, P) :- 1620 !, 1621 ( extend(A, N, AX) 1622 -> process_goal(AX, Origin, Src, P) 1623 ; true 1624 ). 1625process_meta(//(A), Origin, Src, P) :- 1626 !, 1627 process_dcg_goal(A, Origin, Src, P). 1628process_meta(G, Origin, Src, P) :- 1629 process_goal(G, Origin, Src, P).
1636process_dcg_goal(Var, _, _, _) :- 1637 var(Var), 1638 !. 1639process_dcg_goal((A,B), Origin, Src, P) :- 1640 !, 1641 process_dcg_goal(A, Origin, Src, P), 1642 process_dcg_goal(B, Origin, Src, P). 1643process_dcg_goal((A;B), Origin, Src, P) :- 1644 !, 1645 process_dcg_goal(A, Origin, Src, P), 1646 process_dcg_goal(B, Origin, Src, P). 1647process_dcg_goal((A|B), Origin, Src, P) :- 1648 !, 1649 process_dcg_goal(A, Origin, Src, P), 1650 process_dcg_goal(B, Origin, Src, P). 1651process_dcg_goal((A->B), Origin, Src, P) :- 1652 !, 1653 process_dcg_goal(A, Origin, Src, P), 1654 process_dcg_goal(B, Origin, Src, P). 1655process_dcg_goal((A*->B), Origin, Src, P) :- 1656 !, 1657 process_dcg_goal(A, Origin, Src, P), 1658 process_dcg_goal(B, Origin, Src, P). 1659process_dcg_goal({Goal}, Origin, Src, P) :- 1660 !, 1661 process_goal(Goal, Origin, Src, P). 1662process_dcg_goal(List, _Origin, _Src, _) :- 1663 is_list(List), 1664 !. % terminal 1665process_dcg_goal(List, _Origin, _Src, _) :- 1666 string(List), 1667 !. % terminal 1668process_dcg_goal(Callable, Origin, Src, P) :- 1669 extend(Callable, 2, Goal), 1670 !, 1671 process_goal(Goal, Origin, Src, P). 1672process_dcg_goal(_, _, _, _). 1673 1674 1675extend(Var, _, _) :- 1676 var(Var), !, fail. 1677extend(M:G, N, M:GX) :- 1678 !, 1679 callable(G), 1680 extend(G, N, GX). 1681extend(G, N, GX) :- 1682 ( compound(G) 1683 -> compound_name_arguments(G, Name, Args), 1684 length(Rest, N), 1685 append(Args, Rest, NArgs), 1686 compound_name_arguments(GX, Name, NArgs) 1687 ; atom(G) 1688 -> length(NArgs, N), 1689 compound_name_arguments(GX, G, NArgs) 1690 ). 1691 1692asserting_goal(assert(Rule), Rule). 1693asserting_goal(asserta(Rule), Rule). 1694asserting_goal(assertz(Rule), Rule). 1695asserting_goal(assert(Rule,_), Rule). 1696asserting_goal(asserta(Rule,_), Rule). 1697asserting_goal(assertz(Rule,_), Rule). 1698 1699process_assert(0, _, _) :- !. % catch variables 1700process_assert((_:-Body), Origin, Src) :- 1701 !, 1702 process_body(Body, Origin, Src). 1703process_assert(_, _, _).
1707variants([], _, []). 1708variants([H|T], Max, List) :- 1709 variants(T, H, Max, List). 1710 1711variants([], H, _, [H]). 1712variants(_, _, 0, []) :- !. 1713variants([H|T], V, Max, List) :- 1714 ( H =@= V 1715 -> variants(T, V, Max, List) 1716 ; List = [V|List2], 1717 Max1 is Max-1, 1718 variants(T, H, Max1, List2) 1719 ).
T = hello(X),
findall(T, T, List),
1733partial_evaluate(Goal, P) :- 1734 eval(Goal), 1735 !, 1736 P = true. 1737partial_evaluate(_, _). 1738 1739eval(X = Y) :- 1740 unify_with_occurs_check(X, Y). 1741 1742 /******************************* 1743 * PLUNIT SUPPORT * 1744 *******************************/ 1745 1746enter_test_unit(Unit, _Src) :- 1747 current_source_line(Line), 1748 asserta(current_test_unit(Unit, Line)). 1749 1750leave_test_unit(Unit, _Src) :- 1751 retractall(current_test_unit(Unit, _)). 1752 1753 1754 /******************************* 1755 * XPCE STUFF * 1756 *******************************/ 1757 1758pce_goal(new(_,_), new(-, new)). 1759pce_goal(send(_,_), send(arg, msg)). 1760pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1761pce_goal(get(_,_,_), get(arg, msg, -)). 1762pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1763pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1764pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1765 1766process_xpce_goal(G, Origin, Src) :- 1767 pce_goal(G, Process), 1768 !, 1769 current_source_line(Here), 1770 assert_called(Src, Origin, G, Here), 1771 ( arg(I, Process, How), 1772 arg(I, G, Term), 1773 process_xpce_arg(How, Term, Origin, Src), 1774 fail 1775 ; true 1776 ). 1777 1778process_xpce_arg(new, Term, Origin, Src) :- 1779 callable(Term), 1780 process_new(Term, Origin, Src). 1781process_xpce_arg(arg, Term, Origin, Src) :- 1782 compound(Term), 1783 process_new(Term, Origin, Src). 1784process_xpce_arg(msg, Term, Origin, Src) :- 1785 compound(Term), 1786 ( arg(_, Term, Arg), 1787 process_xpce_arg(arg, Arg, Origin, Src), 1788 fail 1789 ; true 1790 ). 1791 1792process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1793process_new(Term, Origin, Src) :- 1794 assert_new(Src, Origin, Term), 1795 ( compound(Term), 1796 arg(_, Term, Arg), 1797 process_xpce_arg(arg, Arg, Origin, Src), 1798 fail 1799 ; true 1800 ). 1801 1802assert_new(_, _, Term) :- 1803 \+ callable(Term), 1804 !. 1805assert_new(Src, Origin, Control) :- 1806 functor_name(Control, Class), 1807 pce_control_class(Class), 1808 !, 1809 forall(arg(_, Control, Arg), 1810 assert_new(Src, Origin, Arg)). 1811assert_new(Src, Origin, Term) :- 1812 compound(Term), 1813 arg(1, Term, Prolog), 1814 Prolog == @(prolog), 1815 ( Term =.. [message, _, Selector | T], 1816 atom(Selector) 1817 -> Called =.. [Selector|T], 1818 process_body(Called, Origin, Src) 1819 ; Term =.. [?, _, Selector | T], 1820 atom(Selector) 1821 -> append(T, [_R], T2), 1822 Called =.. [Selector|T2], 1823 process_body(Called, Origin, Src) 1824 ), 1825 fail. 1826assert_new(_, _, @(_)) :- !. 1827assert_new(Src, _, Term) :- 1828 functor_name(Term, Name), 1829 assert_used_class(Src, Name). 1830 1831 1832pce_control_class(and). 1833pce_control_class(or). 1834pce_control_class(if). 1835pce_control_class(not). 1836 1837 1838 /******************************** 1839 * INCLUDED MODULES * 1840 ********************************/
1844process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1845process_use_module([], _, _) :- !. 1846process_use_module([H|T], Src, Reexport) :- 1847 !, 1848 process_use_module(H, Src, Reexport), 1849 process_use_module(T, Src, Reexport). 1850process_use_module(library(pce), Src, Reexport) :- % bit special 1851 !, 1852 xref_public_list(library(pce), Path, Exports, Src), 1853 forall(member(Import, Exports), 1854 process_pce_import(Import, Src, Path, Reexport)). 1855process_use_module(File, Src, Reexport) :- 1856 load_module_if_needed(File), 1857 ( xoption(Src, silent(Silent)) 1858 -> Extra = [silent(Silent)] 1859 ; Extra = [silent(true)] 1860 ), 1861 ( xref_public_list(File, Src, 1862 [ path(Path), 1863 module(M), 1864 exports(Exports), 1865 public(Public), 1866 meta(Meta) 1867 | Extra 1868 ]) 1869 -> assert(uses_file(File, Src, Path)), 1870 assert_import(Src, Exports, _, Path, Reexport), 1871 assert_xmodule_callable(Exports, M, Src, Path), 1872 assert_xmodule_callable(Public, M, Src, Path), 1873 maplist(process_meta_head(Src), Meta), 1874 ( File = library(chr) % hacky 1875 -> assert(mode(chr, Src)) 1876 ; true 1877 ) 1878 ; assert(uses_file(File, Src, '<not_found>')) 1879 ). 1880 1881process_pce_import(Name/Arity, Src, Path, Reexport) :- 1882 atom(Name), 1883 integer(Arity), 1884 !, 1885 functor(Term, Name, Arity), 1886 ( \+ system_predicate(Term), 1887 \+ Term = pce_error(_) % hack!? 1888 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1889 ; true 1890 ). 1891process_pce_import(op(P,T,N), Src, _, _) :- 1892 xref_push_op(Src, P, T, N).
1898process_use_module2(File, Import, Src, Reexport) :-
1899 load_module_if_needed(File),
1900 ( xref_source_file(File, Path, Src)
1901 -> assert(uses_file(File, Src, Path)),
1902 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1903 -> assert_import(Src, Import, Export, Path, Reexport),
1904 forall(( member(Head, Meta),
1905 imported(Head, _, Path)
1906 ),
1907 process_meta_head(Src, Head))
1908 ; true
1909 )
1910 ; assert(uses_file(File, Src, '<not_found>'))
1911 ).1920load_module_if_needed(File) :- 1921 prolog:no_autoload_module(File), 1922 !, 1923 use_module(File, []). 1924load_module_if_needed(_). 1925 1926prologno_autoload_module(library(apply_macros)). 1927prologno_autoload_module(library(arithmetic)). 1928prologno_autoload_module(library(record)). 1929prologno_autoload_module(library(persistency)). 1930prologno_autoload_module(library(pldoc)). 1931prologno_autoload_module(library(settings)). 1932prologno_autoload_module(library(debug)). 1933prologno_autoload_module(library(plunit)).
1938process_requires(Import, Src) :- 1939 is_list(Import), 1940 !, 1941 require_list(Import, Src). 1942process_requires(Var, _Src) :- 1943 var(Var), 1944 !. 1945process_requires((A,B), Src) :- 1946 !, 1947 process_requires(A, Src), 1948 process_requires(B, Src). 1949process_requires(PI, Src) :- 1950 requires(PI, Src). 1951 1952require_list([], _). 1953require_list([H|T], Src) :- 1954 requires(H, Src), 1955 require_list(T, Src). 1956 1957requires(PI, _Src) :- 1958 '$pi_head'(PI, Head), 1959 '$get_predicate_attribute'(system:Head, defined, 1), 1960 !. 1961requires(PI, Src) :- 1962 '$pi_head'(PI, Head), 1963 '$pi_head'(Name/Arity, Head), 1964 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1965 ( imported(Head, Src, Library) 1966 -> true 1967 ; assertz(imported(Head, Src, Library)) 1968 ).
The information collected by this predicate is cached. The cached data is considered valid as long as the modification time of the file does not change.
1999xref_public_list(File, Src, Options) :-
2000 option(path(Path), Options, _),
2001 option(module(Module), Options, _),
2002 option(exports(Exports), Options, _),
2003 option(public(Public), Options, _),
2004 option(meta(Meta), Options, _),
2005 xref_source_file(File, Path, Src, Options),
2006 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
2028xref_public_list(File, Path, Export, Src) :- 2029 xref_source_file(File, Path, Src), 2030 public_list(Path, _, _, Export, _, []). 2031xref_public_list(File, Path, Module, Export, Meta, Src) :- 2032 xref_source_file(File, Path, Src), 2033 public_list(Path, Module, Meta, Export, _, []). 2034xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 2035 xref_source_file(File, Path, Src), 2036 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2046:- dynamic public_list_cache/6. 2047:- volatile public_list_cache/6. 2048 2049public_list(Path, Module, Meta, Export, Public, _Options) :- 2050 public_list_cache(Path, Modified, 2051 Module0, Meta0, Export0, Public0), 2052 time_file(Path, ModifiedNow), 2053 ( abs(Modified-ModifiedNow) < 0.0001 2054 -> !, 2055 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2056 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2057 fail 2058 ). 2059public_list(Path, Module, Meta, Export, Public, Options) :- 2060 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2061 ( Error = error(_,_), 2062 catch(time_file(Path, Modified), Error, fail) 2063 -> asserta(public_list_cache(Path, Modified, 2064 Module0, Meta0, Export0, Public0)) 2065 ; true 2066 ), 2067 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2068 2069public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2070 in_temporary_module( 2071 TempModule, 2072 true, 2073 public_list_diff(TempModule, Path, Module, 2074 Meta, [], Export, [], Public, [], Options)). 2075 2076 2077public_list_diff(TempModule, 2078 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2079 setup_call_cleanup( 2080 public_list_setup(TempModule, Path, In, State), 2081 phrase(read_directives(In, Options, [true]), Directives), 2082 public_list_cleanup(In, State)), 2083 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2084 2085public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2086 prolog_open_source(Path, In), 2087 '$set_source_module'(OldM, TempModule), 2088 set_xref(OldXref). 2089 2090public_list_cleanup(In, state(OldM, OldXref)) :- 2091 '$set_source_module'(OldM), 2092 set_prolog_flag(xref, OldXref), 2093 prolog_close_source(In). 2094 2095 2096read_directives(In, Options, State) --> 2097 { repeat, 2098 catch(prolog_read_source_term(In, Term, Expanded, 2099 [ process_comment(true), 2100 syntax_errors(error) 2101 ]), 2102 E, report_syntax_error(E, -, Options)) 2103 -> nonvar(Term), 2104 Term = (:-_) 2105 }, 2106 !, 2107 terms(Expanded, State, State1), 2108 read_directives(In, Options, State1). 2109read_directives(_, _, _) --> []. 2110 2111terms(Var, State, State) --> { var(Var) }, !. 2112terms([H|T], State0, State) --> 2113 !, 2114 terms(H, State0, State1), 2115 terms(T, State1, State). 2116terms((:-if(Cond)), State0, [True|State0]) --> 2117 !, 2118 { eval_cond(Cond, True) }. 2119terms((:-elif(Cond)), [True0|State], [True|State]) --> 2120 !, 2121 { eval_cond(Cond, True1), 2122 elif(True0, True1, True) 2123 }. 2124terms((:-else), [True0|State], [True|State]) --> 2125 !, 2126 { negate(True0, True) }. 2127terms((:-endif), [_|State], State) --> !. 2128terms(H, State, State) --> 2129 ( {State = [true|_]} 2130 -> [H] 2131 ; [] 2132 ). 2133 2134eval_cond(Cond, true) :- 2135 catch(Cond, _, fail), 2136 !. 2137eval_cond(_, false). 2138 2139elif(true, _, else_false) :- !. 2140elif(false, true, true) :- !. 2141elif(True, _, True). 2142 2143negate(true, false). 2144negate(false, true). 2145negate(else_false, else_false). 2146 2147public_list([(:- module(Module, Export0))|Decls], Path, 2148 Module, Meta, MT, Export, Rest, Public, PT) :- 2149 !, 2150 ( is_list(Export0) 2151 -> append(Export0, Reexport, Export) 2152 ; Reexport = Export 2153 ), 2154 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2155public_list([(:- encoding(_))|Decls], Path, 2156 Module, Meta, MT, Export, Rest, Public, PT) :- 2157 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2158 2159public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2160public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2161 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2162 !, 2163 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2164public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2165 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2166 2167public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2168 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2169public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2170 public_from_import(Import, Spec, Path, Reexport, Rest). 2171public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2172 phrase(meta_decls(Decl), Meta, MT). 2173public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2174 phrase(public_decls(Decl), Public, PT).
2180reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2181reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2182 !, 2183 xref_source_file(H, Path, Src), 2184 public_list(Path, _Module, Meta0, Export0, Public0, []), 2185 append(Meta0, MT1, Meta), 2186 append(Export0, ET1, Export), 2187 append(Public0, PT1, Public), 2188 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2189reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2190 xref_source_file(Spec, Path, Src), 2191 public_list(Path, _Module, Meta0, Export0, Public0, []), 2192 append(Meta0, MT, Meta), 2193 append(Export0, ET, Export), 2194 append(Public0, PT, Public). 2195 2196public_from_import(except(Map), Path, Src, Export, Rest) :- 2197 !, 2198 xref_public_list(Path, _, AllExports, Src), 2199 except(Map, AllExports, NewExports), 2200 append(NewExports, Rest, Export). 2201public_from_import(Import, _, _, Export, Rest) :- 2202 import_name_map(Import, Export, Rest).
2207except([], Exports, Exports). 2208except([PI0 as NewName|Map], Exports0, Exports) :- 2209 !, 2210 canonical_pi(PI0, PI), 2211 map_as(Exports0, PI, NewName, Exports1), 2212 except(Map, Exports1, Exports). 2213except([PI0|Map], Exports0, Exports) :- 2214 canonical_pi(PI0, PI), 2215 select(PI2, Exports0, Exports1), 2216 same_pi(PI, PI2), 2217 !, 2218 except(Map, Exports1, Exports). 2219 2220 2221map_as([PI|T], Repl, As, [PI2|T]) :- 2222 same_pi(Repl, PI), 2223 !, 2224 pi_as(PI, As, PI2). 2225map_as([H|T0], Repl, As, [H|T]) :- 2226 map_as(T0, Repl, As, T). 2227 2228pi_as(_/Arity, Name, Name/Arity). 2229pi_as(_//Arity, Name, Name//Arity). 2230 2231import_name_map([], L, L). 2232import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2233 !, 2234 import_name_map(T0, T, Tail). 2235import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2236 !, 2237 import_name_map(T0, T, Tail). 2238import_name_map([H|T0], [H|T], Tail) :- 2239 import_name_map(T0, T, Tail). 2240 2241canonical_pi(Name//Arity0, PI) :- 2242 integer(Arity0), 2243 !, 2244 PI = Name/Arity, 2245 Arity is Arity0 + 2. 2246canonical_pi(PI, PI). 2247 2248same_pi(Canonical, PI2) :- 2249 canonical_pi(PI2, Canonical). 2250 2251meta_decls(Var) --> 2252 { var(Var) }, 2253 !. 2254meta_decls((A,B)) --> 2255 !, 2256 meta_decls(A), 2257 meta_decls(B). 2258meta_decls(A) --> 2259 [A]. 2260 2261public_decls(Var) --> 2262 { var(Var) }, 2263 !. 2264public_decls((A,B)) --> 2265 !, 2266 public_decls(A), 2267 public_decls(B). 2268public_decls(A) --> 2269 [A]. 2270 2271 /******************************* 2272 * INCLUDE * 2273 *******************************/ 2274 2275process_include([], _) :- !. 2276process_include([H|T], Src) :- 2277 !, 2278 process_include(H, Src), 2279 process_include(T, Src). 2280process_include(File, Src) :- 2281 callable(File), 2282 !, 2283 ( once(xref_input(ParentSrc, _)), 2284 xref_source_file(File, Path, ParentSrc) 2285 -> ( ( uses_file(_, Src, Path) 2286 ; Path == Src 2287 ) 2288 -> true 2289 ; assert(uses_file(File, Src, Path)), 2290 ( xoption(Src, process_include(true)) 2291 -> findall(O, xoption(Src, O), Options), 2292 setup_call_cleanup( 2293 open_include_file(Path, In, Refs), 2294 collect(Src, Path, In, Options), 2295 close_include(In, Refs)) 2296 ; true 2297 ) 2298 ) 2299 ; assert(uses_file(File, Src, '<not_found>')) 2300 ). 2301process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2309open_include_file(Path, In, [Ref]) :- 2310 once(xref_input(_, Parent)), 2311 stream_property(Parent, encoding(Enc)), 2312 '$push_input_context'(xref_include), 2313 catch(( prolog:xref_open_source(Path, In) 2314 -> catch(set_stream(In, encoding(Enc)), 2315 error(_,_), true) % deal with non-file input 2316 ; include_encoding(Enc, Options), 2317 open(Path, read, In, Options) 2318 ), E, 2319 ( '$pop_input_context', throw(E))), 2320 catch(( peek_char(In, #) % Deal with #! script 2321 -> skip(In, 10) 2322 ; true 2323 ), E, 2324 ( close_include(In, []), throw(E))), 2325 asserta(xref_input(Path, In), Ref). 2326 2327include_encoding(wchar_t, []) :- !. 2328include_encoding(Enc, [encoding(Enc)]). 2329 2330 2331close_include(In, Refs) :- 2332 maplist(erase, Refs), 2333 close(In, [force(true)]), 2334 '$pop_input_context'.
2340process_foreign(Spec, Src) :- 2341 ground(Spec), 2342 current_foreign_library(Spec, Defined), 2343 !, 2344 ( xmodule(Module, Src) 2345 -> true 2346 ; Module = user 2347 ), 2348 process_foreign_defined(Defined, Module, Src). 2349process_foreign(_, _). 2350 2351process_foreign_defined([], _, _). 2352process_foreign_defined([H|T], M, Src) :- 2353 ( H = M:Head 2354 -> assert_foreign(Src, Head) 2355 ; assert_foreign(Src, H) 2356 ), 2357 process_foreign_defined(T, M, Src). 2358 2359 2360 /******************************* 2361 * CHR SUPPORT * 2362 *******************************/ 2363 2364/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2365This part of the file supports CHR. Our choice is between making special 2366hooks to make CHR expansion work and then handle the (complex) expanded 2367code or process the CHR source directly. The latter looks simpler, 2368though I don't like the idea of adding support for libraries to this 2369module. A file is supposed to be a CHR file if it uses a 2370use_module(library(chr) or contains a :- constraint/1 directive. As an 2371extra bonus we get the source-locations right :-) 2372- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2373 2374process_chr(@(_Name, Rule), Src) :- 2375 mode(chr, Src), 2376 process_chr(Rule, Src). 2377process_chr(pragma(Rule, _Pragma), Src) :- 2378 mode(chr, Src), 2379 process_chr(Rule, Src). 2380process_chr(<=>(Head, Body), Src) :- 2381 mode(chr, Src), 2382 chr_head(Head, Src, H), 2383 chr_body(Body, H, Src). 2384process_chr(==>(Head, Body), Src) :- 2385 mode(chr, Src), 2386 chr_head(Head, H, Src), 2387 chr_body(Body, H, Src). 2388process_chr((:- chr_constraint(_)), Src) :- 2389 ( mode(chr, Src) 2390 -> true 2391 ; assert(mode(chr, Src)) 2392 ). 2393 2394chr_head(X, _, _) :- 2395 var(X), 2396 !. % Illegal. Warn? 2397chr_head(\(A,B), Src, H) :- 2398 chr_head(A, Src, H), 2399 process_body(B, H, Src). 2400chr_head((H0,B), Src, H) :- 2401 chr_defined(H0, Src, H), 2402 process_body(B, H, Src). 2403chr_head(H0, Src, H) :- 2404 chr_defined(H0, Src, H). 2405 2406chr_defined(X, _, _) :- 2407 var(X), 2408 !. 2409chr_defined(#(C,_Id), Src, C) :- 2410 !, 2411 assert_constraint(Src, C). 2412chr_defined(A, Src, A) :- 2413 assert_constraint(Src, A). 2414 2415chr_body(X, From, Src) :- 2416 var(X), 2417 !, 2418 process_body(X, From, Src). 2419chr_body('|'(Guard, Goals), H, Src) :- 2420 !, 2421 chr_body(Guard, H, Src), 2422 chr_body(Goals, H, Src). 2423chr_body(G, From, Src) :- 2424 process_body(G, From, Src). 2425 2426assert_constraint(_, Head) :- 2427 var(Head), 2428 !. 2429assert_constraint(Src, Head) :- 2430 constraint(Head, Src, _), 2431 !. 2432assert_constraint(Src, Head) :- 2433 generalise_term(Head, Term), 2434 current_source_line(Line), 2435 assert(constraint(Term, Src, Line)). 2436 2437 2438 /******************************** 2439 * PHASE 1 ASSERTIONS * 2440 ********************************/
2447assert_called(_, _, Var, _) :- 2448 var(Var), 2449 !. 2450assert_called(Src, From, Goal, Line) :- 2451 var(From), 2452 !, 2453 assert_called(Src, '<unknown>', Goal, Line). 2454assert_called(_, _, Goal, _) :- 2455 expand_hide_called(Goal), 2456 !. 2457assert_called(Src, Origin, M:G, Line) :- 2458 !, 2459 ( atom(M), 2460 callable(G) 2461 -> current_condition(Cond), 2462 ( xmodule(M, Src) % explicit call to own module 2463 -> assert_called(Src, Origin, G, Line) 2464 ; called(M:G, Src, Origin, Cond, Line) % already registered 2465 -> true 2466 ; hide_called(M:G, Src) % not interesting (now) 2467 -> true 2468 ; generalise(Origin, OTerm), 2469 generalise(G, GTerm) 2470 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2471 ; true 2472 ) 2473 ; true % call to variable module 2474 ). 2475assert_called(Src, _, Goal, _) :- 2476 ( xmodule(M, Src) 2477 -> M \== system 2478 ; M = user 2479 ), 2480 hide_called(M:Goal, Src), 2481 !. 2482assert_called(Src, Origin, Goal, Line) :- 2483 current_condition(Cond), 2484 ( called(Goal, Src, Origin, Cond, Line) 2485 -> true 2486 ; generalise(Origin, OTerm), 2487 generalise(Goal, Term) 2488 -> assert(called(Term, Src, OTerm, Cond, Line)) 2489 ; true 2490 ).
2498expand_hide_called(pce_principal:send_implementation(_, _, _)). 2499expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2500expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2501expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2502 2503assert_defined(Src, Goal) :- 2504 Goal = test(_Test), 2505 current_test_unit(Unit, Line), 2506 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2507 fail. 2508assert_defined(Src, Goal) :- 2509 Goal = test(_Test, _Options), 2510 current_test_unit(Unit, Line), 2511 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2512 fail. 2513assert_defined(Src, Goal) :- 2514 defined(Goal, Src, _), 2515 !. 2516assert_defined(Src, Goal) :- 2517 generalise(Goal, Term), 2518 current_source_line(Line), 2519 assert(defined(Term, Src, Line)). 2520 2521assert_foreign(Src, Goal) :- 2522 foreign(Goal, Src, _), 2523 !. 2524assert_foreign(Src, Goal) :- 2525 generalise(Goal, Term), 2526 current_source_line(Line), 2527 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2539assert_import(_, [], _, _, _) :- !. 2540assert_import(Src, [H|T], Export, From, Reexport) :- 2541 !, 2542 assert_import(Src, H, Export, From, Reexport), 2543 assert_import(Src, T, Export, From, Reexport). 2544assert_import(Src, except(Except), Export, From, Reexport) :- 2545 !, 2546 is_list(Export), 2547 !, 2548 except(Except, Export, Import), 2549 assert_import(Src, Import, _All, From, Reexport). 2550assert_import(Src, Import as Name, Export, From, Reexport) :- 2551 !, 2552 pi_to_head(Import, Term0), 2553 rename_goal(Term0, Name, Term), 2554 ( in_export_list(Term0, Export) 2555 -> assert(imported(Term, Src, From)), 2556 assert_reexport(Reexport, Src, Term) 2557 ; current_source_line(Line), 2558 assert_called(Src, '<directive>'(Line), Term0, Line) 2559 ). 2560assert_import(Src, Import, Export, From, Reexport) :- 2561 pi_to_head(Import, Term), 2562 !, 2563 ( in_export_list(Term, Export) 2564 -> assert(imported(Term, Src, From)), 2565 assert_reexport(Reexport, Src, Term) 2566 ; current_source_line(Line), 2567 assert_called(Src, '<directive>'(Line), Term, Line) 2568 ). 2569assert_import(Src, op(P,T,N), _, _, _) :- 2570 xref_push_op(Src, P,T,N). 2571 2572in_export_list(_Head, Export) :- 2573 var(Export), 2574 !. 2575in_export_list(Head, Export) :- 2576 member(PI, Export), 2577 pi_to_head(PI, Head). 2578 2579assert_reexport(false, _, _) :- !. 2580assert_reexport(true, Src, Term) :- 2581 assert(exported(Term, Src)).
2587process_import(M:PI, Src) :- 2588 pi_to_head(PI, Head), 2589 !, 2590 ( atom(M), 2591 current_module(M), 2592 module_property(M, file(From)) 2593 -> true 2594 ; From = '<unknown>' 2595 ), 2596 assert(imported(Head, Src, From)). 2597process_import(_, _).
2606assert_xmodule_callable([], _, _, _). 2607assert_xmodule_callable([PI|T], M, Src, From) :- 2608 ( pi_to_head(M:PI, Head) 2609 -> assert(imported(Head, Src, From)) 2610 ; true 2611 ), 2612 assert_xmodule_callable(T, M, Src, From).
2619assert_op(Src, op(P,T,M:N)) :-
2620 ( '$current_source_module'(M)
2621 -> Name = N
2622 ; Name = M:N
2623 ),
2624 ( xop(Src, op(P,T,Name))
2625 -> true
2626 ; assert(xop(Src, op(P,T,Name)))
2627 ).2634assert_module(Src, Module) :- 2635 xmodule(Module, Src), 2636 !. 2637assert_module(Src, Module) :- 2638 '$set_source_module'(Module), 2639 assert(xmodule(Module, Src)), 2640 ( module_property(Module, class(system)) 2641 -> retractall(xoption(Src, register_called(_))), 2642 assert(xoption(Src, register_called(all))) 2643 ; true 2644 ). 2645 2646assert_module_export(_, []) :- !. 2647assert_module_export(Src, [H|T]) :- 2648 !, 2649 assert_module_export(Src, H), 2650 assert_module_export(Src, T). 2651assert_module_export(Src, PI) :- 2652 pi_to_head(PI, Term), 2653 !, 2654 assert(exported(Term, Src)). 2655assert_module_export(Src, op(P, A, N)) :- 2656 xref_push_op(Src, P, A, N).
2662assert_module3([], _) :- !. 2663assert_module3([H|T], Src) :- 2664 !, 2665 assert_module3(H, Src), 2666 assert_module3(T, Src). 2667assert_module3(Option, Src) :- 2668 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2677process_predicates(Closure, Preds, Src) :- 2678 is_list(Preds), 2679 !, 2680 process_predicate_list(Preds, Closure, Src). 2681process_predicates(Closure, as(Preds, _Options), Src) :- 2682 !, 2683 process_predicates(Closure, Preds, Src). 2684process_predicates(Closure, Preds, Src) :- 2685 process_predicate_comma(Preds, Closure, Src). 2686 2687process_predicate_list([], _, _). 2688process_predicate_list([H|T], Closure, Src) :- 2689 ( nonvar(H) 2690 -> call(Closure, H, Src) 2691 ; true 2692 ), 2693 process_predicate_list(T, Closure, Src). 2694 2695process_predicate_comma(Var, _, _) :- 2696 var(Var), 2697 !. 2698process_predicate_comma(M:(A,B), Closure, Src) :- 2699 !, 2700 process_predicate_comma(M:A, Closure, Src), 2701 process_predicate_comma(M:B, Closure, Src). 2702process_predicate_comma((A,B), Closure, Src) :- 2703 !, 2704 process_predicate_comma(A, Closure, Src), 2705 process_predicate_comma(B, Closure, Src). 2706process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2707 !, 2708 process_predicate_comma(Spec, Closure, Src). 2709process_predicate_comma(A, Closure, Src) :- 2710 call(Closure, A, Src). 2711 2712 2713assert_dynamic(PI, Src) :- 2714 pi_to_head(PI, Term), 2715 ( thread_local(Term, Src, _) % dynamic after thread_local has 2716 -> true % no effect 2717 ; current_source_line(Line), 2718 assert(dynamic(Term, Src, Line)) 2719 ). 2720 2721assert_thread_local(PI, Src) :- 2722 pi_to_head(PI, Term), 2723 current_source_line(Line), 2724 assert(thread_local(Term, Src, Line)). 2725 2726assert_multifile(PI, Src) :- % :- multifile(Spec) 2727 pi_to_head(PI, Term), 2728 current_source_line(Line), 2729 assert(multifile(Term, Src, Line)). 2730 2731assert_public(PI, Src) :- % :- public(Spec) 2732 pi_to_head(PI, Term), 2733 current_source_line(Line), 2734 assert_called(Src, '<public>'(Line), Term, Line), 2735 assert(public(Term, Src, Line)). 2736 2737assert_export(PI, Src) :- % :- export(Spec) 2738 pi_to_head(PI, Term), 2739 !, 2740 assert(exported(Term, Src)).
2747pi_to_head(Var, _) :- 2748 var(Var), !, fail. 2749pi_to_head(M:PI, M:Term) :- 2750 !, 2751 pi_to_head(PI, Term). 2752pi_to_head(Name/Arity, Term) :- 2753 functor(Term, Name, Arity). 2754pi_to_head(Name//DCGArity, Term) :- 2755 Arity is DCGArity+2, 2756 functor(Term, Name, Arity). 2757 2758 2759assert_used_class(Src, Name) :- 2760 used_class(Name, Src), 2761 !. 2762assert_used_class(Src, Name) :- 2763 assert(used_class(Name, Src)). 2764 2765assert_defined_class(Src, Name, _Meta, _Super, _) :- 2766 defined_class(Name, _, _, Src, _), 2767 !. 2768assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2769assert_defined_class(Src, Name, Meta, Super, Summary) :- 2770 current_source_line(Line), 2771 ( Summary == @(default) 2772 -> Atom = '' 2773 ; is_list(Summary) 2774 -> atom_codes(Atom, Summary) 2775 ; string(Summary) 2776 -> atom_concat(Summary, '', Atom) 2777 ), 2778 assert(defined_class(Name, Super, Atom, Src, Line)), 2779 ( Meta = @(_) 2780 -> true 2781 ; assert_used_class(Src, Meta) 2782 ), 2783 assert_used_class(Src, Super). 2784 2785assert_defined_class(Src, Name, imported_from(_File)) :- 2786 defined_class(Name, _, _, Src, _), 2787 !. 2788assert_defined_class(Src, Name, imported_from(File)) :- 2789 assert(defined_class(Name, _, '', Src, file(File))). 2790 2791 2792 /******************************** 2793 * UTILITIES * 2794 ********************************/
2800generalise(Var, Var) :- 2801 var(Var), 2802 !. % error? 2803generalise(pce_principal:send_implementation(Id, _, _), 2804 pce_principal:send_implementation(Id, _, _)) :- 2805 atom(Id), 2806 !. 2807generalise(pce_principal:get_implementation(Id, _, _, _), 2808 pce_principal:get_implementation(Id, _, _, _)) :- 2809 atom(Id), 2810 !. 2811generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2812generalise(test(Test), test(Test)) :- 2813 current_test_unit(_,_), 2814 ground(Test), 2815 !. 2816generalise(test(Test, _), test(Test, _)) :- 2817 current_test_unit(_,_), 2818 ground(Test), 2819 !. 2820generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !. 2821generalise(Module:Goal0, Module:Goal) :- 2822 atom(Module), 2823 !, 2824 generalise(Goal0, Goal). 2825generalise(Term0, Term) :- 2826 callable(Term0), 2827 generalise_term(Term0, Term). 2828 2829 2830 /******************************* 2831 * SOURCE MANAGEMENT * 2832 *******************************/ 2833 2834/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2835This section of the file contains hookable predicates to reason about 2836sources. The built-in code here can only deal with files. The XPCE 2837library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2838can do cross-referencing on PceEmacs edit buffers. Other examples for 2839hooking can be databases, (HTTP) URIs, etc. 2840- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2841 2842:- multifile 2843 prolog:xref_source_directory/2, % +Source, -Dir 2844 prolog:xref_source_file/3. % +Spec, -Path, +Options
2852xref_source_file(Plain, File, Source) :- 2853 xref_source_file(Plain, File, Source, []). 2854 2855xref_source_file(QSpec, File, Source, Options) :- 2856 nonvar(QSpec), QSpec = _:Spec, 2857 !, 2858 must_be(acyclic, Spec), 2859 xref_source_file(Spec, File, Source, Options). 2860xref_source_file(Spec, File, Source, Options) :- 2861 nonvar(Spec), 2862 prolog:xref_source_file(Spec, File, 2863 [ relative_to(Source) 2864 | Options 2865 ]), 2866 !. 2867xref_source_file(Plain, File, Source, Options) :- 2868 atom(Plain), 2869 \+ is_absolute_file_name(Plain), 2870 ( prolog:xref_source_directory(Source, Dir) 2871 -> true 2872 ; atom(Source), 2873 file_directory_name(Source, Dir) 2874 ), 2875 atomic_list_concat([Dir, /, Plain], Spec0), 2876 absolute_file_name(Spec0, Spec), 2877 do_xref_source_file(Spec, File, Options), 2878 !. 2879xref_source_file(Spec, File, Source, Options) :- 2880 do_xref_source_file(Spec, File, 2881 [ relative_to(Source) 2882 | Options 2883 ]), 2884 !. 2885xref_source_file(_, _, _, Options) :- 2886 option(silent(true), Options), 2887 !, 2888 fail. 2889xref_source_file(Spec, _, Src, _Options) :- 2890 verbose(Src), 2891 print_message(warning, error(existence_error(file, Spec), _)), 2892 fail. 2893 2894do_xref_source_file(Spec, File, Options) :- 2895 nonvar(Spec), 2896 option(file_type(Type), Options, prolog), 2897 absolute_file_name(Spec, File, 2898 [ file_type(Type), 2899 access(read), 2900 file_errors(fail) 2901 ]), 2902 !.
2908canonical_source(Source, Src) :-
2909 ( ground(Source)
2910 -> prolog_canonical_source(Source, Src)
2911 ; Source = Src
2912 ).name()
goals.2919goal_name_arity(Goal, Name, Arity) :- 2920 ( compound(Goal) 2921 -> compound_name_arity(Goal, Name, Arity) 2922 ; atom(Goal) 2923 -> Name = Goal, Arity = 0 2924 ). 2925 2926generalise_term(Specific, General) :- 2927 ( compound(Specific) 2928 -> compound_name_arity(Specific, Name, Arity), 2929 compound_name_arity(General, Name, Arity) 2930 ; General = Specific 2931 ). 2932 2933functor_name(Term, Name) :- 2934 ( compound(Term) 2935 -> compound_name_arity(Term, Name, _) 2936 ; atom(Term) 2937 -> Name = Term 2938 ). 2939 2940rename_goal(Goal0, Name, Goal) :- 2941 ( compound(Goal0) 2942 -> compound_name_arity(Goal0, _, Arity), 2943 compound_name_arity(Goal, Name, Arity) 2944 ; Goal = Name 2945 )
Prolog cross-referencer data collection
This library collects information on defined and used objects in Prolog source files. Typically these are predicates, but we expect the library to deal with other types of objects in the future. The library is a building block for tools doing dependency tracking in applications. Dependency tracking is useful to reveal the structure of an unknown program or detect missing components at compile time, but also for program transformation or minimising a program saved state by only saving the reachable objects.
The library is exploited by two graphical tools in the SWI-Prolog environment: the XPCE front-end started by gxref/0, and library(prolog_colour), which exploits this library for its syntax highlighting.
For all predicates described below, Source is the source that is processed. This is normally a filename in any notation acceptable to the file loading predicates (see load_files/2). Input handling is done by the library(prolog_source), which may be hooked to process any source that can be translated into a Prolog stream holding Prolog source text. Callable is a callable term (see callable/1). Callables do not carry a module qualifier unless the referred predicate is not in the module defined by Source.