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-2023, 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:- use_module(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 (declared)/4, % Head, How, Src, Line 116 defined/3, % Head, Src, Line 117 meta_goal/3, % Head, Called, Src 118 foreign/3, % Head, Src, Line 119 constraint/3, % Head, Src, Line 120 imported/3, % Head, Src, From 121 exported/2, % Head, Src 122 xmodule/2, % Module, Src 123 uses_file/3, % Spec, Src, Path 124 xop/2, % Src, Op 125 source/2, % Src, Time 126 used_class/2, % Name, Src 127 defined_class/5, % Name, Super, Summary, Src, Line 128 (mode)/2, % Mode, Src 129 xoption/2, % Src, Option 130 xflag/4, % Name, Value, Src, Line 131 grammar_rule/2, % Head, Src 132 module_comment/3, % Src, Title, Comment 133 pred_comment/4, % Head, Src, Summary, Comment 134 pred_comment_link/3, % Head, Src, HeadTo 135 pred_mode/3. % Head, Src, Det 136 137:- create_prolog_flag(xref, false, [type(boolean)]).
174:- predicate_options(xref_source_file/4, 4, 175 [ file_type(oneof([txt,prolog,directory])), 176 silent(boolean) 177 ]). 178:- predicate_options(xref_public_list/3, 3, 179 [ path(-atom), 180 module(-atom), 181 exports(-list(any)), 182 public(-list(any)), 183 meta(-list(any)), 184 silent(boolean) 185 ]). 186 187 188 /******************************* 189 * HOOKS * 190 *******************************/
217:- multifile 218 prolog:called_by/4, % +Goal, +Module, +Context, -Called 219 prolog:called_by/2, % +Goal, -Called 220 prolog:meta_goal/2, % +Goal, -Pattern 221 prolog:hook/1, % +Callable 222 prolog:generated_predicate/1, % :PI 223 prolog:no_autoload_module/1. % Module is not suitable for autoloading. 224 225:- meta_predicate 226 prolog:generated_predicate(). 227 228:- dynamic 229 meta_goal/2. 230 231:- meta_predicate 232 process_predicates(, , ). 233 234 /******************************* 235 * BUILT-INS * 236 *******************************/
register_called.244hide_called(Callable, Src) :- 245 xoption(Src, register_called(Which)), 246 !, 247 mode_hide_called(Which, Callable). 248hide_called(Callable, _) :- 249 mode_hide_called(non_built_in, Callable). 250 251mode_hide_called(all, _) :- !, fail. 252mode_hide_called(non_iso, _:Goal) :- 253 goal_name_arity(Goal, Name, Arity), 254 current_predicate(system:Name/Arity), 255 predicate_property(system:Goal, iso). 256mode_hide_called(non_built_in, _:Goal) :- 257 goal_name_arity(Goal, Name, Arity), 258 current_predicate(system:Name/Arity), 259 predicate_property(system:Goal, built_in). 260mode_hide_called(non_built_in, M:Goal) :- 261 goal_name_arity(Goal, Name, Arity), 262 current_predicate(M:Name/Arity), 263 predicate_property(M:Goal, built_in).
269system_predicate(Goal) :- 270 goal_name_arity(Goal, Name, Arity), 271 current_predicate(system:Name/Arity), % avoid autoloading 272 predicate_property(system:Goal, built_in), 273 !. 274 275 276 /******************************** 277 * TOPLEVEL * 278 ********************************/ 279 280verbose(Src) :- 281 \+ xoption(Src, silent(true)). 282 283:- thread_local 284 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).312xref_source(Source) :- 313 xref_source(Source, []). 314 315xref_source(Source, Options) :- 316 prolog_canonical_source(Source, Src), 317 ( last_modified(Source, Modified) 318 -> ( source(Src, Modified) 319 -> true 320 ; xref_clean(Src), 321 assert(source(Src, Modified)), 322 do_xref(Src, Options) 323 ) 324 ; xref_clean(Src), 325 get_time(Now), 326 assert(source(Src, Now)), 327 do_xref(Src, Options) 328 ). 329 330do_xref(Src, Options) :- 331 must_be(list, Options), 332 setup_call_cleanup( 333 xref_setup(Src, In, Options, State), 334 collect(Src, Src, In, Options), 335 xref_cleanup(State)). 336 337last_modified(Source, Modified) :- 338 prolog:xref_source_time(Source, Modified), 339 !. 340last_modified(Source, Modified) :- 341 atom(Source), 342 \+ is_global_url(Source), 343 exists_file(Source), 344 time_file(Source, Modified). 345 346is_global_url(File) :- 347 sub_atom(File, B, _, _, '://'), 348 !, 349 B > 1, 350 sub_atom(File, 0, B, _, Scheme), 351 atom_codes(Scheme, Codes), 352 maplist(between(0'a, 0'z), Codes). 353 354xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :- 355 maplist(assert_option(Src), Options), 356 assert_default_options(Src), 357 current_prolog_flag(emulated_dialect, Dialect), 358 prolog_open_source(Src, In), 359 set_initial_mode(In, Options), 360 asserta(xref_input(Src, In), SRef), 361 set_xref(Xref), 362 ( verbose(Src) 363 -> HRefs = [] 364 ; asserta((user:thread_message_hook(_,Level,_) :- 365 hide_message(Level)), 366 Ref), 367 HRefs = [Ref] 368 ). 369 370hide_message(warning). 371hide_message(error). 372hide_message(informational). 373 374assert_option(_, Var) :- 375 var(Var), 376 !, 377 instantiation_error(Var). 378assert_option(Src, silent(Boolean)) :- 379 !, 380 must_be(boolean, Boolean), 381 assert(xoption(Src, silent(Boolean))). 382assert_option(Src, register_called(Which)) :- 383 !, 384 must_be(oneof([all,non_iso,non_built_in]), Which), 385 assert(xoption(Src, register_called(Which))). 386assert_option(Src, comments(CommentHandling)) :- 387 !, 388 must_be(oneof([store,collect,ignore]), CommentHandling), 389 assert(xoption(Src, comments(CommentHandling))). 390assert_option(Src, module(Module)) :- 391 !, 392 must_be(atom, Module), 393 assert(xoption(Src, module(Module))). 394assert_option(Src, process_include(Boolean)) :- 395 !, 396 must_be(boolean, Boolean), 397 assert(xoption(Src, process_include(Boolean))). 398 399assert_default_options(Src) :- 400 ( xref_option_default(Opt), 401 generalise_term(Opt, Gen), 402 ( xoption(Src, Gen) 403 -> true 404 ; assertz(xoption(Src, Opt)) 405 ), 406 fail 407 ; true 408 ). 409 410xref_option_default(silent(false)). 411xref_option_default(register_called(non_built_in)). 412xref_option_default(comments(collect)). 413xref_option_default(process_include(true)).
419xref_cleanup(state(In, Dialect, Xref, Refs)) :- 420 prolog_close_source(In), 421 set_prolog_flag(emulated_dialect, Dialect), 422 set_prolog_flag(xref, Xref), 423 maplist(erase, Refs). 424 425set_xref(Xref) :- 426 current_prolog_flag(xref, Xref), 427 set_prolog_flag(xref, true). 428 429:- meta_predicate 430 with_xref(). 431 432with_xref(Goal) :- 433 current_prolog_flag(xref, Xref), 434 ( Xref == true 435 -> call(Goal) 436 ; setup_call_cleanup( 437 set_prolog_flag(xref, true), 438 Goal, 439 set_prolog_flag(xref, Xref)) 440 ).
450set_initial_mode(_Stream, Options) :- 451 option(module(Module), Options), 452 !, 453 '$set_source_module'(Module). 454set_initial_mode(Stream, _) :- 455 stream_property(Stream, file_name(Path)), 456 source_file_property(Path, load_context(M, _, Opts)), 457 !, 458 '$set_source_module'(M), 459 ( option(dialect(Dialect), Opts) 460 -> expects_dialect(Dialect) 461 ; true 462 ). 463set_initial_mode(_, _) :- 464 '$set_source_module'(user).
470xref_input_stream(Stream) :-
471 xref_input(_, Var),
472 !,
473 Stream = Var.480xref_push_op(Src, P, T, N0) :- 481 '$current_source_module'(M0), 482 strip_module(M0:N0, M, N), 483 ( is_list(N), 484 N \== [] 485 -> maplist(push_op(Src, P, T, M), N) 486 ; push_op(Src, P, T, M, N) 487 ). 488 489push_op(Src, P, T, M0, N0) :- 490 strip_module(M0:N0, M, N), 491 Name = M:N, 492 valid_op(op(P,T,Name)), 493 push_op(P, T, Name), 494 assert_op(Src, op(P,T,Name)), 495 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 496 497valid_op(op(P,T,M:N)) :- 498 atom(M), 499 valid_op_name(N), 500 integer(P), 501 between(0, 1200, P), 502 atom(T), 503 op_type(T). 504 505valid_op_name(N) :- 506 atom(N), 507 !. 508valid_op_name(N) :- 509 N == []. 510 511op_type(xf). 512op_type(yf). 513op_type(fx). 514op_type(fy). 515op_type(xfx). 516op_type(xfy). 517op_type(yfx).
523xref_set_prolog_flag(Flag, Value, Src, Line) :- 524 atom(Flag), 525 !, 526 assertz(xflag(Flag, Value, Src, Line)). 527xref_set_prolog_flag(_, _, _, _).
533xref_clean(Source) :- 534 prolog_canonical_source(Source, Src), 535 retractall(called(_, Src, _Origin, _Cond, _Line)), 536 retractall(dynamic(_, Src, Line)), 537 retractall(multifile(_, Src, Line)), 538 retractall(public(_, Src, Line)), 539 retractall(declared(_, _, Src, Line)), 540 retractall(defined(_, Src, Line)), 541 retractall(meta_goal(_, _, Src)), 542 retractall(foreign(_, Src, Line)), 543 retractall(constraint(_, Src, Line)), 544 retractall(imported(_, Src, _From)), 545 retractall(exported(_, Src)), 546 retractall(uses_file(_, Src, _)), 547 retractall(xmodule(_, Src)), 548 retractall(xop(Src, _)), 549 retractall(grammar_rule(_, Src)), 550 retractall(xoption(Src, _)), 551 retractall(xflag(_Name, _Value, Src, Line)), 552 retractall(source(Src, _)), 553 retractall(used_class(_, Src)), 554 retractall(defined_class(_, _, _, Src, _)), 555 retractall(mode(_, Src)), 556 retractall(module_comment(Src, _, _)), 557 retractall(pred_comment(_, Src, _, _)), 558 retractall(pred_comment_link(_, Src, _)), 559 retractall(pred_mode(_, Src, _)). 560 561 562 /******************************* 563 * READ RESULTS * 564 *******************************/
570xref_current_source(Source) :-
571 source(Source, _Time).
578xref_done(Source, Time) :-
579 prolog_canonical_source(Source, Src),
580 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.
602xref_called(Source, Called, By) :- 603 xref_called(Source, Called, By, _). 604 605xref_called(Source, Called, By, Cond) :- 606 canonical_source(Source, Src), 607 distinct(Called-By, called(Called, Src, By, Cond, _)). 608 609xref_called(Source, Called, By, Cond, Line) :- 610 canonical_source(Source, Src), 611 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)633xref_defined(Source, Called, How) :- 634 nonvar(Source), 635 !, 636 canonical_source(Source, Src), 637 xref_defined2(How, Src, Called). 638xref_defined(Source, Called, How) :- 639 xref_defined2(How, Src, Called), 640 canonical_source(Source, Src). 641 642xref_defined2(dynamic(Line), Src, Called) :- 643 dynamic(Called, Src, Line). 644xref_defined2(thread_local(Line), Src, Called) :- 645 thread_local(Called, Src, Line). 646xref_defined2(multifile(Line), Src, Called) :- 647 multifile(Called, Src, Line). 648xref_defined2(public(Line), Src, Called) :- 649 public(Called, Src, Line). 650xref_defined2(local(Line), Src, Called) :- 651 defined(Called, Src, Line). 652xref_defined2(foreign(Line), Src, Called) :- 653 foreign(Called, Src, Line). 654xref_defined2(constraint(Line), Src, Called) :- 655 ( constraint(Called, Src, Line) 656 -> true 657 ; declared(Called, chr_constraint, Src, Line) 658 ). 659xref_defined2(imported(From), Src, Called) :- 660 imported(Called, Src, From). 661xref_defined2(dcg, Src, Called) :- 662 grammar_rule(Called, Src).
670xref_definition_line(local(Line), Line). 671xref_definition_line(dynamic(Line), Line). 672xref_definition_line(thread_local(Line), Line). 673xref_definition_line(multifile(Line), Line). 674xref_definition_line(public(Line), Line). 675xref_definition_line(constraint(Line), Line). 676xref_definition_line(foreign(Line), Line).
683xref_exported(Source, Called) :-
684 prolog_canonical_source(Source, Src),
685 exported(Called, Src).691xref_module(Source, Module) :- 692 nonvar(Source), 693 !, 694 prolog_canonical_source(Source, Src), 695 xmodule(Module, Src). 696xref_module(Source, Module) :- 697 xmodule(Module, Src), 698 prolog_canonical_source(Source, Src).
708xref_uses_file(Source, Spec, Path) :-
709 prolog_canonical_source(Source, Src),
710 uses_file(Spec, Src, Path).
720xref_op(Source, Op) :-
721 prolog_canonical_source(Source, Src),
722 xop(Src, Op).730xref_prolog_flag(Source, Flag, Value, Line) :- 731 prolog_canonical_source(Source, Src), 732 xflag(Flag, Value, Src, Line). 733 734xref_built_in(Head) :- 735 system_predicate(Head). 736 737xref_used_class(Source, Class) :- 738 prolog_canonical_source(Source, Src), 739 used_class(Class, Src). 740 741xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 742 prolog_canonical_source(Source, Src), 743 defined_class(Class, Super, Summary, Src, Line), 744 integer(Line), 745 !. 746xref_defined_class(Source, Class, file(File)) :- 747 prolog_canonical_source(Source, Src), 748 defined_class(Class, _, _, Src, file(File)). 749 750:- thread_local 751 current_cond/1, 752 source_line/1, 753 current_test_unit/2. 754 755current_source_line(Line) :- 756 source_line(Var), 757 !, 758 Line = Var.
766collect(Src, File, In, Options) :- 767 ( Src == File 768 -> SrcSpec = Line 769 ; SrcSpec = (File:Line) 770 ), 771 ( current_prolog_flag(xref_store_comments, OldStore) 772 -> true 773 ; OldStore = false 774 ), 775 option(comments(CommentHandling), Options, collect), 776 ( CommentHandling == ignore 777 -> CommentOptions = [], 778 Comments = [] 779 ; CommentHandling == store 780 -> CommentOptions = [ process_comment(true) ], 781 Comments = [], 782 set_prolog_flag(xref_store_comments, true) 783 ; CommentOptions = [ comments(Comments) ] 784 ), 785 repeat, 786 catch(prolog_read_source_term( 787 In, Term, Expanded, 788 [ term_position(TermPos) 789 | CommentOptions 790 ]), 791 E, report_syntax_error(E, Src, [])), 792 update_condition(Term), 793 stream_position_data(line_count, TermPos, Line), 794 setup_call_cleanup( 795 asserta(source_line(SrcSpec), Ref), 796 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 797 E, print_message(error, E)), 798 erase(Ref)), 799 EOF == true, 800 !, 801 set_prolog_flag(xref_store_comments, OldStore). 802 803report_syntax_error(E, _, _) :- 804 fatal_error(E), 805 throw(E). 806report_syntax_error(_, _, Options) :- 807 option(silent(true), Options), 808 !, 809 fail. 810report_syntax_error(E, Src, _Options) :- 811 ( verbose(Src) 812 -> print_message(error, E) 813 ; true 814 ), 815 fail. 816 817fatal_error(time_limit_exceeded). 818fatal_error(error(resource_error(_),_)).
824update_condition((:-Directive)) :- 825 !, 826 update_cond(Directive). 827update_condition(_). 828 829update_cond(if(Cond)) :- 830 !, 831 asserta(current_cond(Cond)). 832update_cond(else) :- 833 retract(current_cond(C0)), 834 !, 835 assert(current_cond(\+C0)). 836update_cond(elif(Cond)) :- 837 retract(current_cond(C0)), 838 !, 839 assert(current_cond((\+C0,Cond))). 840update_cond(endif) :- 841 retract(current_cond(_)), 842 !. 843update_cond(_).
850current_condition(Condition) :- 851 \+ current_cond(_), 852 !, 853 Condition = true. 854current_condition(Condition) :- 855 findall(C, current_cond(C), List), 856 list_to_conj(List, Condition). 857 858list_to_conj([], true). 859list_to_conj([C], C) :- !. 860list_to_conj([H|T], (H,C)) :- 861 list_to_conj(T, C). 862 863 864 /******************************* 865 * PROCESS * 866 *******************************/
878process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 879 is_list(Expanded), % term_expansion into list. 880 !, 881 ( member(Term, Expanded), 882 process(Term, Term0, Src), 883 Term == end_of_file 884 -> EOF = true 885 ; EOF = false 886 ), 887 xref_comments(Comments, TermPos, Src). 888process(end_of_file, _, _, _, _, true) :- 889 !. 890process(Term, Comments, Term0, TermPos, Src, false) :- 891 process(Term, Term0, Src), 892 xref_comments(Comments, TermPos, Src).
896process(_, Term0, _) :- 897 ignore_raw_term(Term0), 898 !. 899process(Head :- Body, Head0 --> _, Src) :- 900 pi_head(F/A, Head), 901 pi_head(F/A0, Head0), 902 A =:= A0 + 2, 903 !, 904 assert_grammar_rule(Src, Head), 905 process((Head :- Body), Src). 906process(Term, _Term0, Src) :- 907 process(Term, Src). 908 909ignore_raw_term((:- predicate_options(_,_,_))).
913process(Var, _) :- 914 var(Var), 915 !. % Warn? 916process(end_of_file, _) :- !. 917process((:- Directive), Src) :- 918 !, 919 process_directive(Directive, Src), 920 !. 921process((?- Directive), Src) :- 922 !, 923 process_directive(Directive, Src), 924 !. 925process((Head :- Body), Src) :- 926 !, 927 assert_defined(Src, Head), 928 process_body(Body, Head, Src). 929process((Left => Body), Src) :- 930 !, 931 ( nonvar(Left), 932 Left = (Head, Guard) 933 -> assert_defined(Src, Head), 934 process_body(Guard, Head, Src), 935 process_body(Body, Head, Src) 936 ; assert_defined(Src, Left), 937 process_body(Body, Left, Src) 938 ). 939process(?=>(Head, Body), Src) :- 940 !, 941 assert_defined(Src, Head), 942 process_body(Body, Head, Src). 943process('$source_location'(_File, _Line):Clause, Src) :- 944 !, 945 process(Clause, Src). 946process(Term, Src) :- 947 process_chr(Term, Src), 948 !. 949process(M:(Head :- Body), Src) :- 950 !, 951 process((M:Head :- M:Body), Src). 952process(Head, Src) :- 953 assert_defined(Src, Head). 954 955 956 /******************************* 957 * COMMENTS * 958 *******************************/
962xref_comments([], _Pos, _Src). 963:- if(current_predicate(parse_comment/3)). 964xref_comments([Pos-Comment|T], TermPos, Src) :- 965 ( Pos @> TermPos % comments inside term 966 -> true 967 ; stream_position_data(line_count, Pos, Line), 968 FilePos = Src:Line, 969 ( parse_comment(Comment, FilePos, Parsed) 970 -> assert_comments(Parsed, Src) 971 ; true 972 ), 973 xref_comments(T, TermPos, Src) 974 ). 975 976assert_comments([], _). 977assert_comments([H|T], Src) :- 978 assert_comment(H, Src), 979 assert_comments(T, Src). 980 981assert_comment(section(_Id, Title, Comment), Src) :- 982 assertz(module_comment(Src, Title, Comment)). 983assert_comment(predicate(PI, Summary, Comment), Src) :- 984 pi_to_head(PI, Src, Head), 985 assertz(pred_comment(Head, Src, Summary, Comment)). 986assert_comment(link(PI, PITo), Src) :- 987 pi_to_head(PI, Src, Head), 988 pi_to_head(PITo, Src, HeadTo), 989 assertz(pred_comment_link(Head, Src, HeadTo)). 990assert_comment(mode(Head, Det), Src) :- 991 assertz(pred_mode(Head, Src, Det)). 992 993pi_to_head(PI, Src, Head) :- 994 pi_to_head(PI, Head0), 995 ( Head0 = _:_ 996 -> strip_module(Head0, M, Plain), 997 ( xmodule(M, Src) 998 -> Head = Plain 999 ; Head = M:Plain 1000 ) 1001 ; Head = Head0 1002 ). 1003:- endif.
1009xref_comment(Source, Title, Comment) :-
1010 canonical_source(Source, Src),
1011 module_comment(Src, Title, Comment).
1017xref_comment(Source, Head, Summary, Comment) :-
1018 canonical_source(Source, Src),
1019 ( pred_comment(Head, Src, Summary, Comment)
1020 ; pred_comment_link(Head, Src, HeadTo),
1021 pred_comment(HeadTo, Src, Summary, Comment)
1022 ).
1029xref_mode(Source, Mode, Det) :-
1030 canonical_source(Source, Src),
1031 pred_mode(Mode, Src, Det).1038xref_option(Source, Option) :- 1039 canonical_source(Source, Src), 1040 xoption(Src, Option). 1041 1042 1043 /******************************** 1044 * DIRECTIVES * 1045 ********************************/ 1046 1047process_directive(Var, _) :- 1048 var(Var), 1049 !. % error, but that isn't our business 1050process_directive(Dir, _Src) :- 1051 debug(xref(directive), 'Processing :- ~q', [Dir]), 1052 fail. 1053process_directive((A,B), Src) :- % TBD: what about other control 1054 !, 1055 process_directive(A, Src), % structures? 1056 process_directive(B, Src). 1057process_directive(List, Src) :- 1058 is_list(List), 1059 !, 1060 process_directive(consult(List), Src). 1061process_directive(use_module(File, Import), Src) :- 1062 process_use_module2(File, Import, Src, false). 1063process_directive(autoload(File, Import), Src) :- 1064 process_use_module2(File, Import, Src, false). 1065process_directive(require(Import), Src) :- 1066 process_requires(Import, Src). 1067process_directive(expects_dialect(Dialect), Src) :- 1068 process_directive(use_module(library(dialect/Dialect)), Src), 1069 expects_dialect(Dialect). 1070process_directive(reexport(File, Import), Src) :- 1071 process_use_module2(File, Import, Src, true). 1072process_directive(reexport(Modules), Src) :- 1073 process_use_module(Modules, Src, true). 1074process_directive(autoload(Modules), Src) :- 1075 process_use_module(Modules, Src, false). 1076process_directive(use_module(Modules), Src) :- 1077 process_use_module(Modules, Src, false). 1078process_directive(consult(Modules), Src) :- 1079 process_use_module(Modules, Src, false). 1080process_directive(ensure_loaded(Modules), Src) :- 1081 process_use_module(Modules, Src, false). 1082process_directive(load_files(Files, _Options), Src) :- 1083 process_use_module(Files, Src, false). 1084process_directive(include(Files), Src) :- 1085 process_include(Files, Src). 1086process_directive(dynamic(Dynamic), Src) :- 1087 process_predicates(assert_dynamic, Dynamic, Src). 1088process_directive(dynamic(Dynamic, _Options), Src) :- 1089 process_predicates(assert_dynamic, Dynamic, Src). 1090process_directive(thread_local(Dynamic), Src) :- 1091 process_predicates(assert_thread_local, Dynamic, Src). 1092process_directive(multifile(Dynamic), Src) :- 1093 process_predicates(assert_multifile, Dynamic, Src). 1094process_directive(public(Public), Src) :- 1095 process_predicates(assert_public, Public, Src). 1096process_directive(export(Export), Src) :- 1097 process_predicates(assert_export, Export, Src). 1098process_directive(import(Import), Src) :- 1099 process_import(Import, Src). 1100process_directive(module(Module, Export), Src) :- 1101 assert_module(Src, Module), 1102 assert_module_export(Src, Export). 1103process_directive(module(Module, Export, Import), Src) :- 1104 assert_module(Src, Module), 1105 assert_module_export(Src, Export), 1106 assert_module3(Import, Src). 1107process_directive(begin_tests(Unit, _Options), Src) :- 1108 enter_test_unit(Unit, Src). 1109process_directive(begin_tests(Unit), Src) :- 1110 enter_test_unit(Unit, Src). 1111process_directive(end_tests(Unit), Src) :- 1112 leave_test_unit(Unit, Src). 1113process_directive('$set_source_module'(system), Src) :- 1114 assert_module(Src, system). % hack for handling boot/init.pl 1115process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1116 assert_defined_class(Src, Name, Meta, Super, Doc). 1117process_directive(pce_autoload(Name, From), Src) :- 1118 assert_defined_class(Src, Name, imported_from(From)). 1119 1120process_directive(op(P, A, N), Src) :- 1121 xref_push_op(Src, P, A, N). 1122process_directive(set_prolog_flag(Flag, Value), Src) :- 1123 ( Flag == character_escapes 1124 -> set_prolog_flag(character_escapes, Value) 1125 ; true 1126 ), 1127 current_source_line(Line), 1128 xref_set_prolog_flag(Flag, Value, Src, Line). 1129process_directive(style_check(X), _) :- 1130 style_check(X). 1131process_directive(encoding(Enc), _) :- 1132 ( xref_input_stream(Stream) 1133 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1134 ; true % can this happen? 1135 ). 1136process_directive(pce_expansion:push_compile_operators, _) :- 1137 '$current_source_module'(SM), 1138 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1139process_directive(pce_expansion:pop_compile_operators, _) :- 1140 call(pce_expansion:pop_compile_operators). 1141process_directive(meta_predicate(Meta), Src) :- 1142 process_meta_predicate(Meta, Src). 1143process_directive(arithmetic_function(FSpec), Src) :- 1144 arith_callable(FSpec, Goal), 1145 !, 1146 current_source_line(Line), 1147 assert_called(Src, '<directive>'(Line), Goal, Line). 1148process_directive(format_predicate(_, Goal), Src) :- 1149 !, 1150 current_source_line(Line), 1151 assert_called(Src, '<directive>'(Line), Goal, Line). 1152process_directive(if(Cond), Src) :- 1153 !, 1154 current_source_line(Line), 1155 assert_called(Src, '<directive>'(Line), Cond, Line). 1156process_directive(elif(Cond), Src) :- 1157 !, 1158 current_source_line(Line), 1159 assert_called(Src, '<directive>'(Line), Cond, Line). 1160process_directive(else, _) :- !. 1161process_directive(endif, _) :- !. 1162process_directive(Goal, Src) :- 1163 current_source_line(Line), 1164 process_body(Goal, '<directive>'(Line), Src).
1170process_meta_predicate((A,B), Src) :- 1171 !, 1172 process_meta_predicate(A, Src), 1173 process_meta_predicate(B, Src). 1174process_meta_predicate(Decl, Src) :- 1175 process_meta_head(Src, Decl). 1176 1177process_meta_head(Src, Decl) :- % swapped arguments for maplist 1178 compound(Decl), 1179 compound_name_arity(Decl, Name, Arity), 1180 compound_name_arity(Head, Name, Arity), 1181 meta_args(1, Arity, Decl, Head, Meta), 1182 ( ( prolog:meta_goal(Head, _) 1183 ; prolog:called_by(Head, _, _, _) 1184 ; prolog:called_by(Head, _) 1185 ; meta_goal(Head, _) 1186 ) 1187 -> true 1188 ; assert(meta_goal(Head, Meta, Src)) 1189 ). 1190 1191meta_args(I, Arity, _, _, []) :- 1192 I > Arity, 1193 !. 1194meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1195 arg(I, Decl, 0), 1196 !, 1197 arg(I, Head, H), 1198 I2 is I + 1, 1199 meta_args(I2, Arity, Decl, Head, T). 1200meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1201 arg(I, Decl, ^), 1202 !, 1203 arg(I, Head, EH), 1204 setof_goal(EH, H), 1205 I2 is I + 1, 1206 meta_args(I2, Arity, Decl, Head, T). 1207meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1208 arg(I, Decl, //), 1209 !, 1210 arg(I, Head, H), 1211 I2 is I + 1, 1212 meta_args(I2, Arity, Decl, Head, T). 1213meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1214 arg(I, Decl, A), 1215 integer(A), A > 0, 1216 !, 1217 arg(I, Head, H), 1218 I2 is I + 1, 1219 meta_args(I2, Arity, Decl, Head, T). 1220meta_args(I, Arity, Decl, Head, Meta) :- 1221 I2 is I + 1, 1222 meta_args(I2, Arity, Decl, Head, Meta). 1223 1224 1225 /******************************** 1226 * BODY * 1227 ********************************/
1236xref_meta(Source, Head, Called) :-
1237 canonical_source(Source, Src),
1238 xref_meta_src(Head, Called, Src).1253xref_meta_src(Head, Called, Src) :- 1254 meta_goal(Head, Called, Src), 1255 !. 1256xref_meta_src(Head, Called, _) :- 1257 xref_meta(Head, Called), 1258 !. 1259xref_meta_src(Head, Called, _) :- 1260 compound(Head), 1261 compound_name_arity(Head, Name, Arity), 1262 apply_pred(Name), 1263 Arity > 5, 1264 !, 1265 Extra is Arity - 1, 1266 arg(1, Head, G), 1267 Called = [G+Extra]. 1268xref_meta_src(Head, Called, _) :- 1269 with_xref(predicate_property('$xref_tmp':Head, meta_predicate(Meta))), 1270 !, 1271 Meta =.. [_|Args], 1272 meta_args(Args, 1, Head, Called). 1273 1274meta_args([], _, _, []). 1275meta_args([H0|T0], I, Head, [H|T]) :- 1276 xargs(H0, N), 1277 !, 1278 arg(I, Head, A), 1279 ( N == 0 1280 -> H = A 1281 ; H = (A+N) 1282 ), 1283 I2 is I+1, 1284 meta_args(T0, I2, Head, T). 1285meta_args([_|T0], I, Head, T) :- 1286 I2 is I+1, 1287 meta_args(T0, I2, Head, T). 1288 1289xargs(N, N) :- integer(N), !. 1290xargs(//, 2). 1291xargs(^, 0). 1292 1293apply_pred(call). % built-in 1294apply_pred(maplist). % library(apply_macros) 1295 1296xref_meta((A, B), [A, B]). 1297xref_meta((A; B), [A, B]). 1298xref_meta((A| B), [A, B]). 1299xref_meta((A -> B), [A, B]). 1300xref_meta((A *-> B), [A, B]). 1301xref_meta(findall(_V,G,_L), [G]). 1302xref_meta(findall(_V,G,_L,_T), [G]). 1303xref_meta(findnsols(_N,_V,G,_L), [G]). 1304xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1305xref_meta(setof(_V, EG, _L), [G]) :- 1306 setof_goal(EG, G). 1307xref_meta(bagof(_V, EG, _L), [G]) :- 1308 setof_goal(EG, G). 1309xref_meta(forall(A, B), [A, B]). 1310xref_meta(maplist(G,_), [G+1]). 1311xref_meta(maplist(G,_,_), [G+2]). 1312xref_meta(maplist(G,_,_,_), [G+3]). 1313xref_meta(maplist(G,_,_,_,_), [G+4]). 1314xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1315xref_meta(map_assoc(G, _), [G+1]). 1316xref_meta(map_assoc(G, _, _), [G+2]). 1317xref_meta(checklist(G, _L), [G+1]). 1318xref_meta(sublist(G, _, _), [G+1]). 1319xref_meta(include(G, _, _), [G+1]). 1320xref_meta(exclude(G, _, _), [G+1]). 1321xref_meta(partition(G, _, _, _, _), [G+2]). 1322xref_meta(partition(G, _, _, _),[G+1]). 1323xref_meta(call(G), [G]). 1324xref_meta(call(G, _), [G+1]). 1325xref_meta(call(G, _, _), [G+2]). 1326xref_meta(call(G, _, _, _), [G+3]). 1327xref_meta(call(G, _, _, _, _), [G+4]). 1328xref_meta(not(G), [G]). 1329xref_meta(notrace(G), [G]). 1330xref_meta('$notrace'(G), [G]). 1331xref_meta(\+(G), [G]). 1332xref_meta(ignore(G), [G]). 1333xref_meta(once(G), [G]). 1334xref_meta(initialization(G), [G]). 1335xref_meta(initialization(G,_), [G]). 1336xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1337xref_meta(clause(G, _), [G]). 1338xref_meta(clause(G, _, _), [G]). 1339xref_meta(phrase(G, _A), [//(G)]). 1340xref_meta(phrase(G, _A, _R), [//(G)]). 1341xref_meta(call_dcg(G, _A, _R), [//(G)]). 1342xref_meta(phrase_from_file(G,_),[//(G)]). 1343xref_meta(catch(A, _, B), [A, B]). 1344xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1345xref_meta(thread_create(A,_,_), [A]). 1346xref_meta(thread_create(A,_), [A]). 1347xref_meta(thread_signal(_,A), [A]). 1348xref_meta(thread_idle(A,_), [A]). 1349xref_meta(thread_at_exit(A), [A]). 1350xref_meta(thread_initialization(A), [A]). 1351xref_meta(engine_create(_,A,_), [A]). 1352xref_meta(engine_create(_,A,_,_), [A]). 1353xref_meta(transaction(A), [A]). 1354xref_meta(transaction(A,B,_), [A,B]). 1355xref_meta(snapshot(A), [A]). 1356xref_meta(predsort(A,_,_), [A+3]). 1357xref_meta(call_cleanup(A, B), [A, B]). 1358xref_meta(call_cleanup(A, _, B),[A, B]). 1359xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1360xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1361xref_meta(call_residue_vars(A,_), [A]). 1362xref_meta(with_mutex(_,A), [A]). 1363xref_meta(assume(G), [G]). % library(debug) 1364xref_meta(assertion(G), [G]). % library(debug) 1365xref_meta(freeze(_, G), [G]). 1366xref_meta(when(C, A), [C, A]). 1367xref_meta(time(G), [G]). % development system 1368xref_meta(call_time(G, _), [G]). % development system 1369xref_meta(call_time(G, _, _), [G]). % development system 1370xref_meta(profile(G), [G]). 1371xref_meta(at_halt(G), [G]). 1372xref_meta(call_with_time_limit(_, G), [G]). 1373xref_meta(call_with_depth_limit(G, _, _), [G]). 1374xref_meta(call_with_inference_limit(G, _, _), [G]). 1375xref_meta(alarm(_, G, _), [G]). 1376xref_meta(alarm(_, G, _, _), [G]). 1377xref_meta('$add_directive_wic'(G), [G]). 1378xref_meta(with_output_to(_, G), [G]). 1379xref_meta(if(G), [G]). 1380xref_meta(elif(G), [G]). 1381xref_meta(meta_options(G,_,_), [G+1]). 1382xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1383xref_meta(distinct(G), [G]). % library(solution_sequences) 1384xref_meta(distinct(_, G), [G]). 1385xref_meta(order_by(_, G), [G]). 1386xref_meta(limit(_, G), [G]). 1387xref_meta(offset(_, G), [G]). 1388xref_meta(reset(G,_,_), [G]). 1389xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1390xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1391xref_meta(tnot(G), [G]). 1392xref_meta(not_exists(G), [G]). 1393xref_meta(with_tty_raw(G), [G]). 1394xref_meta(residual_goals(G), [G+2]). 1395 1396 % XPCE meta-predicates 1397xref_meta(pce_global(_, new(_)), _) :- !, fail. 1398xref_meta(pce_global(_, B), [B+1]). 1399xref_meta(ifmaintainer(G), [G]). % used in manual 1400xref_meta(listen(_, G), [G]). % library(broadcast) 1401xref_meta(listen(_, _, G), [G]). 1402xref_meta(in_pce_thread(G), [G]). 1403 1404xref_meta(G, Meta) :- % call user extensions 1405 prolog:meta_goal(G, Meta). 1406xref_meta(G, Meta) :- % Generated from :- meta_predicate 1407 meta_goal(G, Meta). 1408 1409setof_goal(EG, G) :- 1410 var(EG), !, G = EG. 1411setof_goal(_^EG, G) :- 1412 !, 1413 setof_goal(EG, G). 1414setof_goal(G, G). 1415 1416event_xargs(abort, 0). 1417event_xargs(erase, 1). 1418event_xargs(break, 3). 1419event_xargs(frame_finished, 1). 1420event_xargs(thread_exit, 1). 1421event_xargs(this_thread_exit, 0). 1422event_xargs(PI, 2) :- pi_to_head(PI, _).
1428head_of(Var, _) :- 1429 var(Var), !, fail. 1430head_of((Head :- _), Head). 1431head_of(Head, Head).
1439xref_hook(Hook) :- 1440 prolog:hook(Hook). 1441xref_hook(Hook) :- 1442 hook(Hook). 1443 1444 1445hook(attr_portray_hook(_,_)). 1446hook(attr_unify_hook(_,_)). 1447hook(attribute_goals(_,_,_)). 1448hook(goal_expansion(_,_)). 1449hook(term_expansion(_,_)). 1450hook(resource(_,_,_)). 1451hook('$pred_option'(_,_,_,_)). 1452 1453hook(emacs_prolog_colours:goal_classification(_,_)). 1454hook(emacs_prolog_colours:goal_colours(_,_)). 1455hook(emacs_prolog_colours:identify(_,_)). 1456hook(emacs_prolog_colours:style(_,_)). 1457hook(emacs_prolog_colours:term_colours(_,_)). 1458hook(pce_principal:get_implementation(_,_,_,_)). 1459hook(pce_principal:pce_class(_,_,_,_,_,_)). 1460hook(pce_principal:pce_lazy_get_method(_,_,_)). 1461hook(pce_principal:pce_lazy_send_method(_,_,_)). 1462hook(pce_principal:pce_uses_template(_,_)). 1463hook(pce_principal:send_implementation(_,_,_)). 1464hook(predicate_options:option_decl(_,_,_)). 1465hook(prolog:debug_control_hook(_)). 1466hook(prolog:error_message(_,_,_)). 1467hook(prolog:expand_answer(_,_,_)). 1468hook(prolog:general_exception(_,_)). 1469hook(prolog:help_hook(_)). 1470hook(prolog:locate_clauses(_,_)). 1471hook(prolog:message(_,_,_)). 1472hook(prolog:message_context(_,_,_)). 1473hook(prolog:message_line_element(_,_)). 1474hook(prolog:message_location(_,_,_)). 1475hook(prolog:predicate_summary(_,_)). 1476hook(prolog:prolog_exception_hook(_,_,_,_,_)). 1477hook(prolog:residual_goals(_,_)). 1478hook(prolog:show_profile_hook(_,_)). 1479hook(prolog_edit:load). 1480hook(prolog_edit:locate(_,_,_)). 1481hook(sandbox:safe_directive(_)). 1482hook(sandbox:safe_global_variable(_)). 1483hook(sandbox:safe_meta(_,_)). 1484hook(sandbox:safe_meta_predicate(_)). 1485hook(sandbox:safe_primitive(_)). 1486hook(sandbox:safe_prolog_flag(_,_)). 1487hook(shlib:unload_all_foreign_libraries). 1488hook(system:'$foreign_registered'(_, _)). 1489hook(user:exception(_,_,_)). 1490hook(user:expand_answer(_,_)). 1491hook(user:expand_query(_,_,_,_)). 1492hook(user:file_search_path(_,_)). 1493hook(user:library_directory(_)). 1494hook(user:message_hook(_,_,_)). 1495hook(user:portray(_)). 1496hook(user:prolog_clause_name(_,_)). 1497hook(user:prolog_list_goal(_)). 1498hook(user:prolog_predicate_name(_,_)). 1499hook(user:prolog_trace_interception(_,_,_,_)).
1505arith_callable(Var, _) :- 1506 var(Var), !, fail. 1507arith_callable(Module:Spec, Module:Goal) :- 1508 !, 1509 arith_callable(Spec, Goal). 1510arith_callable(Name/Arity, Goal) :- 1511 PredArity is Arity + 1, 1512 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1523process_body(Body, Origin, Src) :-
1524 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1525 true).true if there was a
partial evalation inside Goal that has bound variables.1532process_goal(Var, _, _, _) :- 1533 var(Var), 1534 !. 1535process_goal(_:Goal, _, _, _) :- 1536 var(Goal), 1537 !. 1538process_goal(Goal, Origin, Src, P) :- 1539 Goal = (_,_), % problems 1540 !, 1541 phrase(conjunction(Goal), Goals), 1542 process_conjunction(Goals, Origin, Src, P). 1543process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1544 Goal = (_;_), % problems 1545 !, 1546 phrase(disjunction(Goal), Goals), 1547 forall(member(G, Goals), 1548 process_body(G, Origin, Src)). 1549process_goal(Goal, Origin, Src, P) :- 1550 ( ( xmodule(M, Src) 1551 -> true 1552 ; M = user 1553 ), 1554 pi_head(PI, M:Goal), 1555 ( current_predicate(PI), 1556 predicate_property(M:Goal, imported_from(IM)) 1557 -> true 1558 ; PI = M:Name/Arity, 1559 '$find_library'(M, Name, Arity, IM, _Library) 1560 -> true 1561 ; IM = M 1562 ), 1563 prolog:called_by(Goal, IM, M, Called) 1564 ; prolog:called_by(Goal, Called) 1565 ), 1566 !, 1567 must_be(list, Called), 1568 current_source_line(Here), 1569 assert_called(Src, Origin, Goal, Here), 1570 process_called_list(Called, Origin, Src, P). 1571process_goal(Goal, Origin, Src, _) :- 1572 process_xpce_goal(Goal, Origin, Src), 1573 !. 1574process_goal(load_foreign_library(File), _Origin, Src, _) :- 1575 process_foreign(File, Src). 1576process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1577 process_foreign(File, Src). 1578process_goal(use_foreign_library(File), _Origin, Src, _) :- 1579 process_foreign(File, Src). 1580process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1581 process_foreign(File, Src). 1582process_goal(Goal, Origin, Src, P) :- 1583 xref_meta_src(Goal, Metas, Src), 1584 !, 1585 current_source_line(Here), 1586 assert_called(Src, Origin, Goal, Here), 1587 process_called_list(Metas, Origin, Src, P). 1588process_goal(Goal, Origin, Src, _) :- 1589 asserting_goal(Goal, Rule), 1590 !, 1591 current_source_line(Here), 1592 assert_called(Src, Origin, Goal, Here), 1593 process_assert(Rule, Origin, Src). 1594process_goal(Goal, Origin, Src, P) :- 1595 partial_evaluate(Goal, P), 1596 current_source_line(Here), 1597 assert_called(Src, Origin, Goal, Here). 1598 1599disjunction(Var) --> {var(Var), !}, [Var]. 1600disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1601disjunction(G) --> [G]. 1602 1603conjunction(Var) --> {var(Var), !}, [Var]. 1604conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1605conjunction(G) --> [G]. 1606 (RVars, T) :- 1608 term_variables(T, TVars0), 1609 sort(TVars0, TVars), 1610 ord_intersect(RVars, TVars). 1611 1612process_conjunction([], _, _, _). 1613process_conjunction([Disj|Rest], Origin, Src, P) :- 1614 nonvar(Disj), 1615 Disj = (_;_), 1616 Rest \== [], 1617 !, 1618 phrase(disjunction(Disj), Goals), 1619 term_variables(Rest, RVars0), 1620 sort(RVars0, RVars), 1621 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1622 forall(member(G, NonSHaring), 1623 process_body(G, Origin, Src)), 1624 ( Sharing == [] 1625 -> true 1626 ; maplist(term_variables, Sharing, GVars0), 1627 append(GVars0, GVars1), 1628 sort(GVars1, GVars), 1629 ord_intersection(GVars, RVars, SVars), 1630 VT =.. [v|SVars], 1631 findall(VT, 1632 ( member(G, Sharing), 1633 process_goal(G, Origin, Src, PS), 1634 PS == true 1635 ), 1636 Alts0), 1637 ( Alts0 == [] 1638 -> true 1639 ; ( true 1640 ; P = true, 1641 sort(Alts0, Alts1), 1642 variants(Alts1, 10, Alts), 1643 member(VT, Alts) 1644 ) 1645 ) 1646 ), 1647 process_conjunction(Rest, Origin, Src, P). 1648process_conjunction([H|T], Origin, Src, P) :- 1649 process_goal(H, Origin, Src, P), 1650 process_conjunction(T, Origin, Src, P). 1651 1652 1653process_called_list([], _, _, _). 1654process_called_list([H|T], Origin, Src, P) :- 1655 process_meta(H, Origin, Src, P), 1656 process_called_list(T, Origin, Src, P). 1657 1658process_meta(A+N, Origin, Src, P) :- 1659 !, 1660 ( extend(A, N, AX) 1661 -> process_goal(AX, Origin, Src, P) 1662 ; true 1663 ). 1664process_meta(//(A), Origin, Src, P) :- 1665 !, 1666 process_dcg_goal(A, Origin, Src, P). 1667process_meta(G, Origin, Src, P) :- 1668 process_goal(G, Origin, Src, P).
1675process_dcg_goal(Var, _, _, _) :- 1676 var(Var), 1677 !. 1678process_dcg_goal((A,B), Origin, Src, P) :- 1679 !, 1680 process_dcg_goal(A, Origin, Src, P), 1681 process_dcg_goal(B, Origin, Src, P). 1682process_dcg_goal((A;B), Origin, Src, P) :- 1683 !, 1684 process_dcg_goal(A, Origin, Src, P), 1685 process_dcg_goal(B, Origin, Src, P). 1686process_dcg_goal((A|B), Origin, Src, P) :- 1687 !, 1688 process_dcg_goal(A, Origin, Src, P), 1689 process_dcg_goal(B, Origin, Src, P). 1690process_dcg_goal((A->B), Origin, Src, P) :- 1691 !, 1692 process_dcg_goal(A, Origin, Src, P), 1693 process_dcg_goal(B, Origin, Src, P). 1694process_dcg_goal((A*->B), Origin, Src, P) :- 1695 !, 1696 process_dcg_goal(A, Origin, Src, P), 1697 process_dcg_goal(B, Origin, Src, P). 1698process_dcg_goal({Goal}, Origin, Src, P) :- 1699 !, 1700 process_goal(Goal, Origin, Src, P). 1701process_dcg_goal(List, _Origin, _Src, _) :- 1702 is_list(List), 1703 !. % terminal 1704process_dcg_goal(List, _Origin, _Src, _) :- 1705 string(List), 1706 !. % terminal 1707process_dcg_goal(Callable, Origin, Src, P) :- 1708 extend(Callable, 2, Goal), 1709 !, 1710 process_goal(Goal, Origin, Src, P). 1711process_dcg_goal(_, _, _, _). 1712 1713 1714extend(Var, _, _) :- 1715 var(Var), !, fail. 1716extend(M:G, N, M:GX) :- 1717 !, 1718 callable(G), 1719 extend(G, N, GX). 1720extend(G, N, GX) :- 1721 ( compound(G) 1722 -> compound_name_arguments(G, Name, Args), 1723 length(Rest, N), 1724 append(Args, Rest, NArgs), 1725 compound_name_arguments(GX, Name, NArgs) 1726 ; atom(G) 1727 -> length(NArgs, N), 1728 compound_name_arguments(GX, G, NArgs) 1729 ). 1730 1731asserting_goal(assert(Rule), Rule). 1732asserting_goal(asserta(Rule), Rule). 1733asserting_goal(assertz(Rule), Rule). 1734asserting_goal(assert(Rule,_), Rule). 1735asserting_goal(asserta(Rule,_), Rule). 1736asserting_goal(assertz(Rule,_), Rule). 1737 1738process_assert(0, _, _) :- !. % catch variables 1739process_assert((_:-Body), Origin, Src) :- 1740 !, 1741 process_body(Body, Origin, Src). 1742process_assert(_, _, _).
1746variants([], _, []). 1747variants([H|T], Max, List) :- 1748 variants(T, H, Max, List). 1749 1750variants([], H, _, [H]). 1751variants(_, _, 0, []) :- !. 1752variants([H|T], V, Max, List) :- 1753 ( H =@= V 1754 -> variants(T, V, Max, List) 1755 ; List = [V|List2], 1756 Max1 is Max-1, 1757 variants(T, H, Max1, List2) 1758 ).
T = hello(X),
findall(T, T, List),
1772partial_evaluate(Goal, P) :- 1773 eval(Goal), 1774 !, 1775 P = true. 1776partial_evaluate(_, _). 1777 1778eval(X = Y) :- 1779 unify_with_occurs_check(X, Y). 1780 1781 /******************************* 1782 * PLUNIT SUPPORT * 1783 *******************************/ 1784 1785enter_test_unit(Unit, _Src) :- 1786 current_source_line(Line), 1787 asserta(current_test_unit(Unit, Line)). 1788 1789leave_test_unit(Unit, _Src) :- 1790 retractall(current_test_unit(Unit, _)). 1791 1792 1793 /******************************* 1794 * XPCE STUFF * 1795 *******************************/ 1796 1797pce_goal(new(_,_), new(-, new)). 1798pce_goal(send(_,_), send(arg, msg)). 1799pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1800pce_goal(get(_,_,_), get(arg, msg, -)). 1801pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1802pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1803pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1804 1805process_xpce_goal(G, Origin, Src) :- 1806 pce_goal(G, Process), 1807 !, 1808 current_source_line(Here), 1809 assert_called(Src, Origin, G, Here), 1810 ( arg(I, Process, How), 1811 arg(I, G, Term), 1812 process_xpce_arg(How, Term, Origin, Src), 1813 fail 1814 ; true 1815 ). 1816 1817process_xpce_arg(new, Term, Origin, Src) :- 1818 callable(Term), 1819 process_new(Term, Origin, Src). 1820process_xpce_arg(arg, Term, Origin, Src) :- 1821 compound(Term), 1822 process_new(Term, Origin, Src). 1823process_xpce_arg(msg, Term, Origin, Src) :- 1824 compound(Term), 1825 ( arg(_, Term, Arg), 1826 process_xpce_arg(arg, Arg, Origin, Src), 1827 fail 1828 ; true 1829 ). 1830 1831process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1832process_new(Term, Origin, Src) :- 1833 assert_new(Src, Origin, Term), 1834 ( compound(Term), 1835 arg(_, Term, Arg), 1836 process_xpce_arg(arg, Arg, Origin, Src), 1837 fail 1838 ; true 1839 ). 1840 1841assert_new(_, _, Term) :- 1842 \+ callable(Term), 1843 !. 1844assert_new(Src, Origin, Control) :- 1845 functor_name(Control, Class), 1846 pce_control_class(Class), 1847 !, 1848 forall(arg(_, Control, Arg), 1849 assert_new(Src, Origin, Arg)). 1850assert_new(Src, Origin, Term) :- 1851 compound(Term), 1852 arg(1, Term, Prolog), 1853 Prolog == @(prolog), 1854 ( Term =.. [message, _, Selector | T], 1855 atom(Selector) 1856 -> Called =.. [Selector|T], 1857 process_body(Called, Origin, Src) 1858 ; Term =.. [?, _, Selector | T], 1859 atom(Selector) 1860 -> append(T, [_R], T2), 1861 Called =.. [Selector|T2], 1862 process_body(Called, Origin, Src) 1863 ), 1864 fail. 1865assert_new(_, _, @(_)) :- !. 1866assert_new(Src, _, Term) :- 1867 functor_name(Term, Name), 1868 assert_used_class(Src, Name). 1869 1870 1871pce_control_class(and). 1872pce_control_class(or). 1873pce_control_class(if). 1874pce_control_class(not). 1875 1876 1877 /******************************** 1878 * INCLUDED MODULES * 1879 ********************************/
1883process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1884process_use_module([], _, _) :- !. 1885process_use_module([H|T], Src, Reexport) :- 1886 !, 1887 process_use_module(H, Src, Reexport), 1888 process_use_module(T, Src, Reexport). 1889process_use_module(library(pce), Src, Reexport) :- % bit special 1890 !, 1891 xref_public_list(library(pce), Path, Exports, Src), 1892 forall(member(Import, Exports), 1893 process_pce_import(Import, Src, Path, Reexport)). 1894process_use_module(File, Src, Reexport) :- 1895 load_module_if_needed(File), 1896 ( xoption(Src, silent(Silent)) 1897 -> Extra = [silent(Silent)] 1898 ; Extra = [silent(true)] 1899 ), 1900 ( xref_public_list(File, Src, 1901 [ path(Path), 1902 module(M), 1903 exports(Exports), 1904 public(Public), 1905 meta(Meta) 1906 | Extra 1907 ]) 1908 -> assert(uses_file(File, Src, Path)), 1909 assert_import(Src, Exports, _, Path, Reexport), 1910 assert_xmodule_callable(Exports, M, Src, Path), 1911 assert_xmodule_callable(Public, M, Src, Path), 1912 maplist(process_meta_head(Src), Meta), 1913 ( File = library(chr) % hacky 1914 -> assert(mode(chr, Src)) 1915 ; true 1916 ) 1917 ; assert(uses_file(File, Src, '<not_found>')) 1918 ). 1919 1920process_pce_import(Name/Arity, Src, Path, Reexport) :- 1921 atom(Name), 1922 integer(Arity), 1923 !, 1924 functor(Term, Name, Arity), 1925 ( \+ system_predicate(Term), 1926 \+ Term = pce_error(_) % hack!? 1927 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1928 ; true 1929 ). 1930process_pce_import(op(P,T,N), Src, _, _) :- 1931 xref_push_op(Src, P, T, N).
1937process_use_module2(File, Import, Src, Reexport) :-
1938 load_module_if_needed(File),
1939 ( xref_source_file(File, Path, Src)
1940 -> assert(uses_file(File, Src, Path)),
1941 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1942 -> assert_import(Src, Import, Export, Path, Reexport),
1943 forall(( member(Head, Meta),
1944 imported(Head, _, Path)
1945 ),
1946 process_meta_head(Src, Head))
1947 ; true
1948 )
1949 ; assert(uses_file(File, Src, '<not_found>'))
1950 ).1959load_module_if_needed(File) :- 1960 prolog:no_autoload_module(File), 1961 !, 1962 use_module(File, []). 1963load_module_if_needed(_). 1964 1965prologno_autoload_module(library(apply_macros)). 1966prologno_autoload_module(library(arithmetic)). 1967prologno_autoload_module(library(record)). 1968prologno_autoload_module(library(persistency)). 1969prologno_autoload_module(library(pldoc)). 1970prologno_autoload_module(library(settings)). 1971prologno_autoload_module(library(debug)). 1972prologno_autoload_module(library(plunit)). 1973prologno_autoload_module(library(macros)). 1974prologno_autoload_module(library(yall)).
1979process_requires(Import, Src) :- 1980 is_list(Import), 1981 !, 1982 require_list(Import, Src). 1983process_requires(Var, _Src) :- 1984 var(Var), 1985 !. 1986process_requires((A,B), Src) :- 1987 !, 1988 process_requires(A, Src), 1989 process_requires(B, Src). 1990process_requires(PI, Src) :- 1991 requires(PI, Src). 1992 1993require_list([], _). 1994require_list([H|T], Src) :- 1995 requires(H, Src), 1996 require_list(T, Src). 1997 1998requires(PI, _Src) :- 1999 '$pi_head'(PI, Head), 2000 '$get_predicate_attribute'(system:Head, defined, 1), 2001 !. 2002requires(PI, Src) :- 2003 '$pi_head'(PI, Head), 2004 '$pi_head'(Name/Arity, Head), 2005 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 2006 ( imported(Head, Src, Library) 2007 -> true 2008 ; assertz(imported(Head, Src, Library)) 2009 ).
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.
2040xref_public_list(File, Src, Options) :-
2041 option(path(Path), Options, _),
2042 option(module(Module), Options, _),
2043 option(exports(Exports), Options, _),
2044 option(public(Public), Options, _),
2045 option(meta(Meta), Options, _),
2046 xref_source_file(File, Path, Src, Options),
2047 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
2069xref_public_list(File, Path, Export, Src) :- 2070 xref_source_file(File, Path, Src), 2071 public_list(Path, _, _, Export, _, []). 2072xref_public_list(File, Path, Module, Export, Meta, Src) :- 2073 xref_source_file(File, Path, Src), 2074 public_list(Path, Module, Meta, Export, _, []). 2075xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 2076 xref_source_file(File, Path, Src), 2077 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2087:- dynamic public_list_cache/6. 2088:- volatile public_list_cache/6. 2089 2090public_list(Path, Module, Meta, Export, Public, _Options) :- 2091 public_list_cache(Path, Modified, 2092 Module0, Meta0, Export0, Public0), 2093 time_file(Path, ModifiedNow), 2094 ( abs(Modified-ModifiedNow) < 0.0001 2095 -> !, 2096 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2097 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2098 fail 2099 ). 2100public_list(Path, Module, Meta, Export, Public, Options) :- 2101 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2102 ( Error = error(_,_), 2103 catch(time_file(Path, Modified), Error, fail) 2104 -> asserta(public_list_cache(Path, Modified, 2105 Module0, Meta0, Export0, Public0)) 2106 ; true 2107 ), 2108 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2109 2110public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2111 in_temporary_module( 2112 TempModule, 2113 true, 2114 public_list_diff(TempModule, Path, Module, 2115 Meta, [], Export, [], Public, [], Options)). 2116 2117 2118public_list_diff(TempModule, 2119 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2120 setup_call_cleanup( 2121 public_list_setup(TempModule, Path, In, State), 2122 phrase(read_directives(In, Options, [true]), Directives), 2123 public_list_cleanup(In, State)), 2124 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2125 2126public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2127 prolog_open_source(Path, In), 2128 '$set_source_module'(OldM, TempModule), 2129 set_xref(OldXref). 2130 2131public_list_cleanup(In, state(OldM, OldXref)) :- 2132 '$set_source_module'(OldM), 2133 set_prolog_flag(xref, OldXref), 2134 prolog_close_source(In). 2135 2136 2137read_directives(In, Options, State) --> 2138 { repeat, 2139 catch(prolog_read_source_term(In, Term, Expanded, 2140 [ process_comment(true), 2141 syntax_errors(error) 2142 ]), 2143 E, report_syntax_error(E, -, Options)) 2144 -> nonvar(Term), 2145 Term = (:-_) 2146 }, 2147 !, 2148 terms(Expanded, State, State1), 2149 read_directives(In, Options, State1). 2150read_directives(_, _, _) --> []. 2151 2152terms(Var, State, State) --> { var(Var) }, !. 2153terms([H|T], State0, State) --> 2154 !, 2155 terms(H, State0, State1), 2156 terms(T, State1, State). 2157terms((:-if(Cond)), State0, [True|State0]) --> 2158 !, 2159 { eval_cond(Cond, True) }. 2160terms((:-elif(Cond)), [True0|State], [True|State]) --> 2161 !, 2162 { eval_cond(Cond, True1), 2163 elif(True0, True1, True) 2164 }. 2165terms((:-else), [True0|State], [True|State]) --> 2166 !, 2167 { negate(True0, True) }. 2168terms((:-endif), [_|State], State) --> !. 2169terms(H, State, State) --> 2170 ( {State = [true|_]} 2171 -> [H] 2172 ; [] 2173 ). 2174 2175eval_cond(Cond, true) :- 2176 catch(Cond, _, fail), 2177 !. 2178eval_cond(_, false). 2179 2180elif(true, _, else_false) :- !. 2181elif(false, true, true) :- !. 2182elif(True, _, True). 2183 2184negate(true, false). 2185negate(false, true). 2186negate(else_false, else_false). 2187 2188public_list([(:- module(Module, Export0))|Decls], Path, 2189 Module, Meta, MT, Export, Rest, Public, PT) :- 2190 !, 2191 ( is_list(Export0) 2192 -> append(Export0, Reexport, Export) 2193 ; Reexport = Export 2194 ), 2195 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2196public_list([(:- encoding(_))|Decls], Path, 2197 Module, Meta, MT, Export, Rest, Public, PT) :- 2198 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2199 2200public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2201public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2202 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2203 !, 2204 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2205public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2206 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2207 2208public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2209 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2210public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2211 public_from_import(Import, Spec, Path, Reexport, Rest). 2212public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2213 phrase(meta_decls(Decl), Meta, MT). 2214public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2215 phrase(public_decls(Decl), Public, PT).
2221reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2222reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2223 !, 2224 xref_source_file(H, Path, Src), 2225 public_list(Path, _Module, Meta0, Export0, Public0, []), 2226 append(Meta0, MT1, Meta), 2227 append(Export0, ET1, Export), 2228 append(Public0, PT1, Public), 2229 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2230reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2231 xref_source_file(Spec, Path, Src), 2232 public_list(Path, _Module, Meta0, Export0, Public0, []), 2233 append(Meta0, MT, Meta), 2234 append(Export0, ET, Export), 2235 append(Public0, PT, Public). 2236 2237public_from_import(except(Map), Path, Src, Export, Rest) :- 2238 !, 2239 xref_public_list(Path, _, AllExports, Src), 2240 except(Map, AllExports, NewExports), 2241 append(NewExports, Rest, Export). 2242public_from_import(Import, _, _, Export, Rest) :- 2243 import_name_map(Import, Export, Rest).
2248except([], Exports, Exports). 2249except([PI0 as NewName|Map], Exports0, Exports) :- 2250 !, 2251 canonical_pi(PI0, PI), 2252 map_as(Exports0, PI, NewName, Exports1), 2253 except(Map, Exports1, Exports). 2254except([PI0|Map], Exports0, Exports) :- 2255 canonical_pi(PI0, PI), 2256 select(PI2, Exports0, Exports1), 2257 same_pi(PI, PI2), 2258 !, 2259 except(Map, Exports1, Exports). 2260 2261 2262map_as([PI|T], Repl, As, [PI2|T]) :- 2263 same_pi(Repl, PI), 2264 !, 2265 pi_as(PI, As, PI2). 2266map_as([H|T0], Repl, As, [H|T]) :- 2267 map_as(T0, Repl, As, T). 2268 2269pi_as(_/Arity, Name, Name/Arity). 2270pi_as(_//Arity, Name, Name//Arity). 2271 2272import_name_map([], L, L). 2273import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2274 !, 2275 import_name_map(T0, T, Tail). 2276import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2277 !, 2278 import_name_map(T0, T, Tail). 2279import_name_map([H|T0], [H|T], Tail) :- 2280 import_name_map(T0, T, Tail). 2281 2282canonical_pi(Name//Arity0, PI) :- 2283 integer(Arity0), 2284 !, 2285 PI = Name/Arity, 2286 Arity is Arity0 + 2. 2287canonical_pi(PI, PI). 2288 2289same_pi(Canonical, PI2) :- 2290 canonical_pi(PI2, Canonical). 2291 2292meta_decls(Var) --> 2293 { var(Var) }, 2294 !. 2295meta_decls((A,B)) --> 2296 !, 2297 meta_decls(A), 2298 meta_decls(B). 2299meta_decls(A) --> 2300 [A]. 2301 2302public_decls(Var) --> 2303 { var(Var) }, 2304 !. 2305public_decls((A,B)) --> 2306 !, 2307 public_decls(A), 2308 public_decls(B). 2309public_decls(A) --> 2310 [A]. 2311 2312 /******************************* 2313 * INCLUDE * 2314 *******************************/ 2315 2316process_include([], _) :- !. 2317process_include([H|T], Src) :- 2318 !, 2319 process_include(H, Src), 2320 process_include(T, Src). 2321process_include(File, Src) :- 2322 callable(File), 2323 !, 2324 ( once(xref_input(ParentSrc, _)), 2325 xref_source_file(File, Path, ParentSrc) 2326 -> ( ( uses_file(_, Src, Path) 2327 ; Path == Src 2328 ) 2329 -> true 2330 ; assert(uses_file(File, Src, Path)), 2331 ( xoption(Src, process_include(true)) 2332 -> findall(O, xoption(Src, O), Options), 2333 setup_call_cleanup( 2334 open_include_file(Path, In, Refs), 2335 collect(Src, Path, In, Options), 2336 close_include(In, Refs)) 2337 ; true 2338 ) 2339 ) 2340 ; assert(uses_file(File, Src, '<not_found>')) 2341 ). 2342process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2350open_include_file(Path, In, [Ref]) :- 2351 once(xref_input(_, Parent)), 2352 stream_property(Parent, encoding(Enc)), 2353 '$push_input_context'(xref_include), 2354 catch(( prolog:xref_open_source(Path, In) 2355 -> catch(set_stream(In, encoding(Enc)), 2356 error(_,_), true) % deal with non-file input 2357 ; include_encoding(Enc, Options), 2358 open(Path, read, In, Options) 2359 ), E, 2360 ( '$pop_input_context', throw(E))), 2361 catch(( peek_char(In, #) % Deal with #! script 2362 -> skip(In, 10) 2363 ; true 2364 ), E, 2365 ( close_include(In, []), throw(E))), 2366 asserta(xref_input(Path, In), Ref). 2367 2368include_encoding(wchar_t, []) :- !. 2369include_encoding(Enc, [encoding(Enc)]). 2370 2371 2372close_include(In, Refs) :- 2373 maplist(erase, Refs), 2374 close(In, [force(true)]), 2375 '$pop_input_context'.
2381process_foreign(Spec, Src) :- 2382 ground(Spec), 2383 current_foreign_library(Spec, Defined), 2384 !, 2385 ( xmodule(Module, Src) 2386 -> true 2387 ; Module = user 2388 ), 2389 process_foreign_defined(Defined, Module, Src). 2390process_foreign(_, _). 2391 2392process_foreign_defined([], _, _). 2393process_foreign_defined([H|T], M, Src) :- 2394 ( H = M:Head 2395 -> assert_foreign(Src, Head) 2396 ; assert_foreign(Src, H) 2397 ), 2398 process_foreign_defined(T, M, Src). 2399 2400 2401 /******************************* 2402 * CHR SUPPORT * 2403 *******************************/ 2404 2405/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2406This part of the file supports CHR. Our choice is between making special 2407hooks to make CHR expansion work and then handle the (complex) expanded 2408code or process the CHR source directly. The latter looks simpler, 2409though I don't like the idea of adding support for libraries to this 2410module. A file is supposed to be a CHR file if it uses a 2411use_module(library(chr) or contains a :- constraint/1 directive. As an 2412extra bonus we get the source-locations right :-) 2413- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2414 2415process_chr(@(_Name, Rule), Src) :- 2416 mode(chr, Src), 2417 process_chr(Rule, Src). 2418process_chr(pragma(Rule, _Pragma), Src) :- 2419 mode(chr, Src), 2420 process_chr(Rule, Src). 2421process_chr(<=>(Head, Body), Src) :- 2422 mode(chr, Src), 2423 chr_head(Head, Src, H), 2424 chr_body(Body, H, Src). 2425process_chr(==>(Head, Body), Src) :- 2426 mode(chr, Src), 2427 chr_head(Head, H, Src), 2428 chr_body(Body, H, Src). 2429process_chr((:- chr_constraint(Decls)), Src) :- 2430 ( mode(chr, Src) 2431 -> true 2432 ; assert(mode(chr, Src)) 2433 ), 2434 chr_decls(Decls, Src). 2435 2436chr_decls((A,B), Src) => 2437 chr_decls(A, Src), 2438 chr_decls(B, Src). 2439chr_decls(Head, Src) => 2440 generalise_term(Head, Gen), 2441 ( declared(Gen, chr_constraint, Src, _) 2442 -> true 2443 ; current_source_line(Line), 2444 assertz(declared(Gen, chr_constraint, Src, Line)) 2445 ). 2446 2447chr_head(X, _, _) :- 2448 var(X), 2449 !. % Illegal. Warn? 2450chr_head(\(A,B), Src, H) :- 2451 chr_head(A, Src, H), 2452 process_body(B, H, Src). 2453chr_head((H0,B), Src, H) :- 2454 chr_defined(H0, Src, H), 2455 process_body(B, H, Src). 2456chr_head(H0, Src, H) :- 2457 chr_defined(H0, Src, H). 2458 2459chr_defined(X, _, _) :- 2460 var(X), 2461 !. 2462chr_defined(#(C,_Id), Src, C) :- 2463 !, 2464 assert_constraint(Src, C). 2465chr_defined(A, Src, A) :- 2466 assert_constraint(Src, A). 2467 2468chr_body(X, From, Src) :- 2469 var(X), 2470 !, 2471 process_body(X, From, Src). 2472chr_body('|'(Guard, Goals), H, Src) :- 2473 !, 2474 chr_body(Guard, H, Src), 2475 chr_body(Goals, H, Src). 2476chr_body(G, From, Src) :- 2477 process_body(G, From, Src). 2478 2479assert_constraint(_, Head) :- 2480 var(Head), 2481 !. 2482assert_constraint(Src, Head) :- 2483 constraint(Head, Src, _), 2484 !. 2485assert_constraint(Src, Head) :- 2486 generalise_term(Head, Term), 2487 current_source_line(Line), 2488 assert(constraint(Term, Src, Line)). 2489 2490 2491 /******************************** 2492 * PHASE 1 ASSERTIONS * 2493 ********************************/
2500assert_called(_, _, Var, _) :- 2501 var(Var), 2502 !. 2503assert_called(Src, From, Goal, Line) :- 2504 var(From), 2505 !, 2506 assert_called(Src, '<unknown>', Goal, Line). 2507assert_called(_, _, Goal, _) :- 2508 expand_hide_called(Goal), 2509 !. 2510assert_called(Src, Origin, M:G, Line) :- 2511 !, 2512 ( atom(M), 2513 callable(G) 2514 -> current_condition(Cond), 2515 ( xmodule(M, Src) % explicit call to own module 2516 -> assert_called(Src, Origin, G, Line) 2517 ; called(M:G, Src, Origin, Cond, Line) % already registered 2518 -> true 2519 ; hide_called(M:G, Src) % not interesting (now) 2520 -> true 2521 ; generalise(Origin, OTerm), 2522 generalise(G, GTerm) 2523 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2524 ; true 2525 ) 2526 ; true % call to variable module 2527 ). 2528assert_called(Src, _, Goal, _) :- 2529 ( xmodule(M, Src) 2530 -> M \== system 2531 ; M = user 2532 ), 2533 hide_called(M:Goal, Src), 2534 !. 2535assert_called(Src, Origin, Goal, Line) :- 2536 current_condition(Cond), 2537 ( called(Goal, Src, Origin, Cond, Line) 2538 -> true 2539 ; generalise(Origin, OTerm), 2540 generalise(Goal, Term) 2541 -> assert(called(Term, Src, OTerm, Cond, Line)) 2542 ; true 2543 ).
2551expand_hide_called(pce_principal:send_implementation(_, _, _)). 2552expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2553expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2554expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2555 2556assert_defined(Src, Goal) :- 2557 Goal = test(_Test), 2558 current_test_unit(Unit, Line), 2559 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2560 fail. 2561assert_defined(Src, Goal) :- 2562 Goal = test(_Test, _Options), 2563 current_test_unit(Unit, Line), 2564 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2565 fail. 2566assert_defined(Src, Goal) :- 2567 defined(Goal, Src, _), 2568 !. 2569assert_defined(Src, Goal) :- 2570 generalise(Goal, Term), 2571 current_source_line(Line), 2572 assert(defined(Term, Src, Line)). 2573 2574assert_foreign(Src, Goal) :- 2575 foreign(Goal, Src, _), 2576 !. 2577assert_foreign(Src, Goal) :- 2578 generalise(Goal, Term), 2579 current_source_line(Line), 2580 assert(foreign(Term, Src, Line)). 2581 2582assert_grammar_rule(Src, Goal) :- 2583 grammar_rule(Goal, Src), 2584 !. 2585assert_grammar_rule(Src, Goal) :- 2586 generalise(Goal, Term), 2587 assert(grammar_rule(Term, Src)).
true, re-export the
imported predicates.
2600assert_import(_, [], _, _, _) :- !. 2601assert_import(Src, [H|T], Export, From, Reexport) :- 2602 !, 2603 assert_import(Src, H, Export, From, Reexport), 2604 assert_import(Src, T, Export, From, Reexport). 2605assert_import(Src, except(Except), Export, From, Reexport) :- 2606 !, 2607 is_list(Export), 2608 !, 2609 except(Except, Export, Import), 2610 assert_import(Src, Import, _All, From, Reexport). 2611assert_import(Src, Import as Name, Export, From, Reexport) :- 2612 !, 2613 pi_to_head(Import, Term0), 2614 rename_goal(Term0, Name, Term), 2615 ( in_export_list(Term0, Export) 2616 -> assert(imported(Term, Src, From)), 2617 assert_reexport(Reexport, Src, Term) 2618 ; current_source_line(Line), 2619 assert_called(Src, '<directive>'(Line), Term0, Line) 2620 ). 2621assert_import(Src, Import, Export, From, Reexport) :- 2622 pi_to_head(Import, Term), 2623 !, 2624 ( in_export_list(Term, Export) 2625 -> assert(imported(Term, Src, From)), 2626 assert_reexport(Reexport, Src, Term) 2627 ; current_source_line(Line), 2628 assert_called(Src, '<directive>'(Line), Term, Line) 2629 ). 2630assert_import(Src, op(P,T,N), _, _, _) :- 2631 xref_push_op(Src, P,T,N). 2632 2633in_export_list(_Head, Export) :- 2634 var(Export), 2635 !. 2636in_export_list(Head, Export) :- 2637 member(PI, Export), 2638 pi_to_head(PI, Head). 2639 2640assert_reexport(false, _, _) :- !. 2641assert_reexport(true, Src, Term) :- 2642 assert(exported(Term, Src)).
2648process_import(M:PI, Src) :- 2649 pi_to_head(PI, Head), 2650 !, 2651 ( atom(M), 2652 current_module(M), 2653 module_property(M, file(From)) 2654 -> true 2655 ; From = '<unknown>' 2656 ), 2657 assert(imported(Head, Src, From)). 2658process_import(_, _).
2667assert_xmodule_callable([], _, _, _). 2668assert_xmodule_callable([PI|T], M, Src, From) :- 2669 ( pi_to_head(M:PI, Head) 2670 -> assert(imported(Head, Src, From)) 2671 ; true 2672 ), 2673 assert_xmodule_callable(T, M, Src, From).
2680assert_op(Src, op(P,T,M:N)) :-
2681 ( '$current_source_module'(M)
2682 -> Name = N
2683 ; Name = M:N
2684 ),
2685 ( xop(Src, op(P,T,Name))
2686 -> true
2687 ; assert(xop(Src, op(P,T,Name)))
2688 ).2695assert_module(Src, Module) :- 2696 xmodule(Module, Src), 2697 !. 2698assert_module(Src, Module) :- 2699 '$set_source_module'(Module), 2700 assert(xmodule(Module, Src)), 2701 ( module_property(Module, class(system)) 2702 -> retractall(xoption(Src, register_called(_))), 2703 assert(xoption(Src, register_called(all))) 2704 ; true 2705 ). 2706 2707assert_module_export(_, []) :- !. 2708assert_module_export(Src, [H|T]) :- 2709 !, 2710 assert_module_export(Src, H), 2711 assert_module_export(Src, T). 2712assert_module_export(Src, PI) :- 2713 pi_to_head(PI, Term), 2714 !, 2715 assert(exported(Term, Src)). 2716assert_module_export(Src, op(P, A, N)) :- 2717 xref_push_op(Src, P, A, N).
2723assert_module3([], _) :- !. 2724assert_module3([H|T], Src) :- 2725 !, 2726 assert_module3(H, Src), 2727 assert_module3(T, Src). 2728assert_module3(Option, Src) :- 2729 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2738process_predicates(Closure, Preds, Src) :- 2739 is_list(Preds), 2740 !, 2741 process_predicate_list(Preds, Closure, Src). 2742process_predicates(Closure, as(Preds, _Options), Src) :- 2743 !, 2744 process_predicates(Closure, Preds, Src). 2745process_predicates(Closure, Preds, Src) :- 2746 process_predicate_comma(Preds, Closure, Src). 2747 2748process_predicate_list([], _, _). 2749process_predicate_list([H|T], Closure, Src) :- 2750 ( nonvar(H) 2751 -> call(Closure, H, Src) 2752 ; true 2753 ), 2754 process_predicate_list(T, Closure, Src). 2755 2756process_predicate_comma(Var, _, _) :- 2757 var(Var), 2758 !. 2759process_predicate_comma(M:(A,B), Closure, Src) :- 2760 !, 2761 process_predicate_comma(M:A, Closure, Src), 2762 process_predicate_comma(M:B, Closure, Src). 2763process_predicate_comma((A,B), Closure, Src) :- 2764 !, 2765 process_predicate_comma(A, Closure, Src), 2766 process_predicate_comma(B, Closure, Src). 2767process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2768 !, 2769 process_predicate_comma(Spec, Closure, Src). 2770process_predicate_comma(A, Closure, Src) :- 2771 call(Closure, A, Src). 2772 2773 2774assert_dynamic(PI, Src) :- 2775 pi_to_head(PI, Term), 2776 ( thread_local(Term, Src, _) % dynamic after thread_local has 2777 -> true % no effect 2778 ; current_source_line(Line), 2779 assert(dynamic(Term, Src, Line)) 2780 ). 2781 2782assert_thread_local(PI, Src) :- 2783 pi_to_head(PI, Term), 2784 current_source_line(Line), 2785 assert(thread_local(Term, Src, Line)). 2786 2787assert_multifile(PI, Src) :- % :- multifile(Spec) 2788 pi_to_head(PI, Term), 2789 current_source_line(Line), 2790 assert(multifile(Term, Src, Line)). 2791 2792assert_public(PI, Src) :- % :- public(Spec) 2793 pi_to_head(PI, Term), 2794 current_source_line(Line), 2795 assert_called(Src, '<public>'(Line), Term, Line), 2796 assert(public(Term, Src, Line)). 2797 2798assert_export(PI, Src) :- % :- export(Spec) 2799 pi_to_head(PI, Term), 2800 !, 2801 assert(exported(Term, Src)).
2808pi_to_head(Var, _) :- 2809 var(Var), !, fail. 2810pi_to_head(M:PI, M:Term) :- 2811 !, 2812 pi_to_head(PI, Term). 2813pi_to_head(Name/Arity, Term) :- 2814 functor(Term, Name, Arity). 2815pi_to_head(Name//DCGArity, Term) :- 2816 Arity is DCGArity+2, 2817 functor(Term, Name, Arity). 2818 2819 2820assert_used_class(Src, Name) :- 2821 used_class(Name, Src), 2822 !. 2823assert_used_class(Src, Name) :- 2824 assert(used_class(Name, Src)). 2825 2826assert_defined_class(Src, Name, _Meta, _Super, _) :- 2827 defined_class(Name, _, _, Src, _), 2828 !. 2829assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2830assert_defined_class(Src, Name, Meta, Super, Summary) :- 2831 current_source_line(Line), 2832 ( Summary == @(default) 2833 -> Atom = '' 2834 ; is_list(Summary) 2835 -> atom_codes(Atom, Summary) 2836 ; string(Summary) 2837 -> atom_concat(Summary, '', Atom) 2838 ), 2839 assert(defined_class(Name, Super, Atom, Src, Line)), 2840 ( Meta = @(_) 2841 -> true 2842 ; assert_used_class(Src, Meta) 2843 ), 2844 assert_used_class(Src, Super). 2845 2846assert_defined_class(Src, Name, imported_from(_File)) :- 2847 defined_class(Name, _, _, Src, _), 2848 !. 2849assert_defined_class(Src, Name, imported_from(File)) :- 2850 assert(defined_class(Name, _, '', Src, file(File))). 2851 2852 2853 /******************************** 2854 * UTILITIES * 2855 ********************************/
2861generalise(Var, Var) :- 2862 var(Var), 2863 !. % error? 2864generalise(pce_principal:send_implementation(Id, _, _), 2865 pce_principal:send_implementation(Id, _, _)) :- 2866 atom(Id), 2867 !. 2868generalise(pce_principal:get_implementation(Id, _, _, _), 2869 pce_principal:get_implementation(Id, _, _, _)) :- 2870 atom(Id), 2871 !. 2872generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2873generalise(test(Test), test(Test)) :- 2874 current_test_unit(_,_), 2875 ground(Test), 2876 !. 2877generalise(test(Test, _), test(Test, _)) :- 2878 current_test_unit(_,_), 2879 ground(Test), 2880 !. 2881generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !. 2882generalise(Module:Goal0, Module:Goal) :- 2883 atom(Module), 2884 !, 2885 generalise(Goal0, Goal). 2886generalise(Term0, Term) :- 2887 callable(Term0), 2888 generalise_term(Term0, Term). 2889 2890 2891 /******************************* 2892 * SOURCE MANAGEMENT * 2893 *******************************/ 2894 2895/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2896This section of the file contains hookable predicates to reason about 2897sources. The built-in code here can only deal with files. The XPCE 2898library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2899can do cross-referencing on PceEmacs edit buffers. Other examples for 2900hooking can be databases, (HTTP) URIs, etc. 2901- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2902 2903:- multifile 2904 prolog:xref_source_directory/2, % +Source, -Dir 2905 prolog:xref_source_file/3. % +Spec, -Path, +Options
2913xref_source_file(Plain, File, Source) :- 2914 xref_source_file(Plain, File, Source, []). 2915 2916xref_source_file(QSpec, File, Source, Options) :- 2917 nonvar(QSpec), QSpec = _:Spec, 2918 !, 2919 must_be(acyclic, Spec), 2920 xref_source_file(Spec, File, Source, Options). 2921xref_source_file(Spec, File, Source, Options) :- 2922 nonvar(Spec), 2923 prolog:xref_source_file(Spec, File, 2924 [ relative_to(Source) 2925 | Options 2926 ]), 2927 !. 2928xref_source_file(Plain, File, Source, Options) :- 2929 atom(Plain), 2930 \+ is_absolute_file_name(Plain), 2931 ( prolog:xref_source_directory(Source, Dir) 2932 -> true 2933 ; atom(Source), 2934 file_directory_name(Source, Dir) 2935 ), 2936 atomic_list_concat([Dir, /, Plain], Spec0), 2937 absolute_file_name(Spec0, Spec), 2938 do_xref_source_file(Spec, File, Options), 2939 !. 2940xref_source_file(Spec, File, Source, Options) :- 2941 do_xref_source_file(Spec, File, 2942 [ relative_to(Source) 2943 | Options 2944 ]), 2945 !. 2946xref_source_file(_, _, _, Options) :- 2947 option(silent(true), Options), 2948 !, 2949 fail. 2950xref_source_file(Spec, _, Src, _Options) :- 2951 verbose(Src), 2952 print_message(warning, error(existence_error(file, Spec), _)), 2953 fail. 2954 2955do_xref_source_file(Spec, File, Options) :- 2956 nonvar(Spec), 2957 option(file_type(Type), Options, prolog), 2958 absolute_file_name(Spec, File, 2959 [ file_type(Type), 2960 access(read), 2961 file_errors(fail) 2962 ]), 2963 !.
2969canonical_source(Source, Src) :-
2970 ( ground(Source)
2971 -> prolog_canonical_source(Source, Src)
2972 ; Source = Src
2973 ).name()
goals.2980goal_name_arity(Goal, Name, Arity) :- 2981 ( compound(Goal) 2982 -> compound_name_arity(Goal, Name, Arity) 2983 ; atom(Goal) 2984 -> Name = Goal, Arity = 0 2985 ). 2986 2987generalise_term(Specific, General) :- 2988 ( compound(Specific) 2989 -> compound_name_arity(Specific, Name, Arity), 2990 compound_name_arity(General, Name, Arity) 2991 ; General = Specific 2992 ). 2993 2994functor_name(Term, Name) :- 2995 ( compound(Term) 2996 -> compound_name_arity(Term, Name, _) 2997 ; atom(Term) 2998 -> Name = Term 2999 ). 3000 3001rename_goal(Goal0, Name, Goal) :- 3002 ( compound(Goal0) 3003 -> compound_name_arity(Goal0, _, Arity), 3004 compound_name_arity(Goal, Name, Arity) 3005 ; Goal = Name 3006 )
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.