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 set_prolog_flag(xref_store_comments, true) 756 ; CommentOptions = [ comments(Comments) ] 757 ), 758 repeat, 759 catch(prolog_read_source_term( 760 In, Term, Expanded, 761 [ term_position(TermPos) 762 | CommentOptions 763 ]), 764 E, report_syntax_error(E, Src, [])), 765 update_condition(Term), 766 stream_position_data(line_count, TermPos, Line), 767 setup_call_cleanup( 768 asserta(source_line(SrcSpec), Ref), 769 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 770 E, print_message(error, E)), 771 erase(Ref)), 772 EOF == true, 773 !, 774 set_prolog_flag(xref_store_comments, false). 775 776report_syntax_error(E, _, _) :- 777 fatal_error(E), 778 throw(E). 779report_syntax_error(_, _, Options) :- 780 option(silent(true), Options), 781 !, 782 fail. 783report_syntax_error(E, Src, _Options) :- 784 ( verbose(Src) 785 -> print_message(error, E) 786 ; true 787 ), 788 fail. 789 790fatal_error(time_limit_exceeded). 791fatal_error(error(resource_error(_),_)).
797update_condition((:-Directive)) :- 798 !, 799 update_cond(Directive). 800update_condition(_). 801 802update_cond(if(Cond)) :- 803 !, 804 asserta(current_cond(Cond)). 805update_cond(else) :- 806 retract(current_cond(C0)), 807 !, 808 assert(current_cond(\+C0)). 809update_cond(elif(Cond)) :- 810 retract(current_cond(C0)), 811 !, 812 assert(current_cond((\+C0,Cond))). 813update_cond(endif) :- 814 retract(current_cond(_)), 815 !. 816update_cond(_).
823current_condition(Condition) :- 824 \+ current_cond(_), 825 !, 826 Condition = true. 827current_condition(Condition) :- 828 findall(C, current_cond(C), List), 829 list_to_conj(List, Condition). 830 831list_to_conj([], true). 832list_to_conj([C], C) :- !. 833list_to_conj([H|T], (H,C)) :- 834 list_to_conj(T, C). 835 836 837 /******************************* 838 * PROCESS * 839 *******************************/
851process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 852 is_list(Expanded), % term_expansion into list. 853 !, 854 ( member(Term, Expanded), 855 process(Term, Term0, Src), 856 Term == end_of_file 857 -> EOF = true 858 ; EOF = false 859 ), 860 xref_comments(Comments, TermPos, Src). 861process(end_of_file, _, _, _, _, true) :- 862 !. 863process(Term, Comments, Term0, TermPos, Src, false) :- 864 process(Term, Term0, Src), 865 xref_comments(Comments, TermPos, Src).
869process(_, Term0, _) :- 870 ignore_raw_term(Term0), 871 !. 872process(Term, _Term0, Src) :- 873 process(Term, Src). 874 875ignore_raw_term((:- predicate_options(_,_,_))).
879process(Var, _) :- 880 var(Var), 881 !. % Warn? 882process(end_of_file, _) :- !. 883process((:- Directive), Src) :- 884 !, 885 process_directive(Directive, Src), 886 !. 887process((?- Directive), Src) :- 888 !, 889 process_directive(Directive, Src), 890 !. 891process((Head :- Body), Src) :- 892 !, 893 assert_defined(Src, Head), 894 process_body(Body, Head, Src). 895process((Left => Body), Src) :- 896 !, 897 ( nonvar(Left), 898 Left = (Head, Guard) 899 -> assert_defined(Src, Head), 900 process_body(Guard, Head, Src), 901 process_body(Body, Head, Src) 902 ; assert_defined(Src, Left), 903 process_body(Body, Left, Src) 904 ). 905process(?=>(Head, Body), Src) :- 906 !, 907 assert_defined(Src, Head), 908 process_body(Body, Head, Src). 909process('$source_location'(_File, _Line):Clause, Src) :- 910 !, 911 process(Clause, Src). 912process(Term, Src) :- 913 process_chr(Term, Src), 914 !. 915process(M:(Head :- Body), Src) :- 916 !, 917 process((M:Head :- M:Body), Src). 918process(Head, Src) :- 919 assert_defined(Src, Head). 920 921 922 /******************************* 923 * COMMENTS * 924 *******************************/
928xref_comments([], _Pos, _Src). 929:- if(current_predicate(parse_comment/3)). 930xref_comments([Pos-Comment|T], TermPos, Src) :- 931 ( Pos @> TermPos % comments inside term 932 -> true 933 ; stream_position_data(line_count, Pos, Line), 934 FilePos = Src:Line, 935 ( parse_comment(Comment, FilePos, Parsed) 936 -> assert_comments(Parsed, Src) 937 ; true 938 ), 939 xref_comments(T, TermPos, Src) 940 ). 941 942assert_comments([], _). 943assert_comments([H|T], Src) :- 944 assert_comment(H, Src), 945 assert_comments(T, Src). 946 947assert_comment(section(_Id, Title, Comment), Src) :- 948 assertz(module_comment(Src, Title, Comment)). 949assert_comment(predicate(PI, Summary, Comment), Src) :- 950 pi_to_head(PI, Src, Head), 951 assertz(pred_comment(Head, Src, Summary, Comment)). 952assert_comment(link(PI, PITo), Src) :- 953 pi_to_head(PI, Src, Head), 954 pi_to_head(PITo, Src, HeadTo), 955 assertz(pred_comment_link(Head, Src, HeadTo)). 956assert_comment(mode(Head, Det), Src) :- 957 assertz(pred_mode(Head, Src, Det)). 958 959pi_to_head(PI, Src, Head) :- 960 pi_to_head(PI, Head0), 961 ( Head0 = _:_ 962 -> strip_module(Head0, M, Plain), 963 ( xmodule(M, Src) 964 -> Head = Plain 965 ; Head = M:Plain 966 ) 967 ; Head = Head0 968 ). 969:- endif.
975xref_comment(Source, Title, Comment) :-
976 canonical_source(Source, Src),
977 module_comment(Src, Title, Comment).
983xref_comment(Source, Head, Summary, Comment) :-
984 canonical_source(Source, Src),
985 ( pred_comment(Head, Src, Summary, Comment)
986 ; pred_comment_link(Head, Src, HeadTo),
987 pred_comment(HeadTo, Src, Summary, Comment)
988 ).
995xref_mode(Source, Mode, Det) :-
996 canonical_source(Source, Src),
997 pred_mode(Mode, Src, Det).1004xref_option(Source, Option) :- 1005 canonical_source(Source, Src), 1006 xoption(Src, Option). 1007 1008 1009 /******************************** 1010 * DIRECTIVES * 1011 ********************************/ 1012 1013process_directive(Var, _) :- 1014 var(Var), 1015 !. % error, but that isn't our business 1016process_directive(Dir, _Src) :- 1017 debug(xref(directive), 'Processing :- ~q', [Dir]), 1018 fail. 1019process_directive((A,B), Src) :- % TBD: what about other control 1020 !, 1021 process_directive(A, Src), % structures? 1022 process_directive(B, Src). 1023process_directive(List, Src) :- 1024 is_list(List), 1025 !, 1026 process_directive(consult(List), Src). 1027process_directive(use_module(File, Import), Src) :- 1028 process_use_module2(File, Import, Src, false). 1029process_directive(autoload(File, Import), Src) :- 1030 process_use_module2(File, Import, Src, false). 1031process_directive(require(Import), Src) :- 1032 process_requires(Import, Src). 1033process_directive(expects_dialect(Dialect), Src) :- 1034 process_directive(use_module(library(dialect/Dialect)), Src), 1035 expects_dialect(Dialect). 1036process_directive(reexport(File, Import), Src) :- 1037 process_use_module2(File, Import, Src, true). 1038process_directive(reexport(Modules), Src) :- 1039 process_use_module(Modules, Src, true). 1040process_directive(autoload(Modules), Src) :- 1041 process_use_module(Modules, Src, false). 1042process_directive(use_module(Modules), Src) :- 1043 process_use_module(Modules, Src, false). 1044process_directive(consult(Modules), Src) :- 1045 process_use_module(Modules, Src, false). 1046process_directive(ensure_loaded(Modules), Src) :- 1047 process_use_module(Modules, Src, false). 1048process_directive(load_files(Files, _Options), Src) :- 1049 process_use_module(Files, Src, false). 1050process_directive(include(Files), Src) :- 1051 process_include(Files, Src). 1052process_directive(dynamic(Dynamic), Src) :- 1053 process_predicates(assert_dynamic, Dynamic, Src). 1054process_directive(dynamic(Dynamic, _Options), Src) :- 1055 process_predicates(assert_dynamic, Dynamic, Src). 1056process_directive(thread_local(Dynamic), Src) :- 1057 process_predicates(assert_thread_local, Dynamic, Src). 1058process_directive(multifile(Dynamic), Src) :- 1059 process_predicates(assert_multifile, Dynamic, Src). 1060process_directive(public(Public), Src) :- 1061 process_predicates(assert_public, Public, Src). 1062process_directive(export(Export), Src) :- 1063 process_predicates(assert_export, Export, Src). 1064process_directive(import(Import), Src) :- 1065 process_import(Import, Src). 1066process_directive(module(Module, Export), Src) :- 1067 assert_module(Src, Module), 1068 assert_module_export(Src, Export). 1069process_directive(module(Module, Export, Import), Src) :- 1070 assert_module(Src, Module), 1071 assert_module_export(Src, Export), 1072 assert_module3(Import, Src). 1073process_directive(begin_tests(Unit, _Options), Src) :- 1074 enter_test_unit(Unit, Src). 1075process_directive(begin_tests(Unit), Src) :- 1076 enter_test_unit(Unit, Src). 1077process_directive(end_tests(Unit), Src) :- 1078 leave_test_unit(Unit, Src). 1079process_directive('$set_source_module'(system), Src) :- 1080 assert_module(Src, system). % hack for handling boot/init.pl 1081process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1082 assert_defined_class(Src, Name, Meta, Super, Doc). 1083process_directive(pce_autoload(Name, From), Src) :- 1084 assert_defined_class(Src, Name, imported_from(From)). 1085 1086process_directive(op(P, A, N), Src) :- 1087 xref_push_op(Src, P, A, N). 1088process_directive(set_prolog_flag(Flag, Value), Src) :- 1089 ( Flag == character_escapes 1090 -> set_prolog_flag(character_escapes, Value) 1091 ; true 1092 ), 1093 current_source_line(Line), 1094 xref_set_prolog_flag(Flag, Value, Src, Line). 1095process_directive(style_check(X), _) :- 1096 style_check(X). 1097process_directive(encoding(Enc), _) :- 1098 ( xref_input_stream(Stream) 1099 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1100 ; true % can this happen? 1101 ). 1102process_directive(pce_expansion:push_compile_operators, _) :- 1103 '$current_source_module'(SM), 1104 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1105process_directive(pce_expansion:pop_compile_operators, _) :- 1106 call(pce_expansion:pop_compile_operators). 1107process_directive(meta_predicate(Meta), Src) :- 1108 process_meta_predicate(Meta, Src). 1109process_directive(arithmetic_function(FSpec), Src) :- 1110 arith_callable(FSpec, Goal), 1111 !, 1112 current_source_line(Line), 1113 assert_called(Src, '<directive>'(Line), Goal, Line). 1114process_directive(format_predicate(_, Goal), Src) :- 1115 !, 1116 current_source_line(Line), 1117 assert_called(Src, '<directive>'(Line), Goal, Line). 1118process_directive(if(Cond), Src) :- 1119 !, 1120 current_source_line(Line), 1121 assert_called(Src, '<directive>'(Line), Cond, Line). 1122process_directive(elif(Cond), Src) :- 1123 !, 1124 current_source_line(Line), 1125 assert_called(Src, '<directive>'(Line), Cond, Line). 1126process_directive(else, _) :- !. 1127process_directive(endif, _) :- !. 1128process_directive(Goal, Src) :- 1129 current_source_line(Line), 1130 process_body(Goal, '<directive>'(Line), Src).
1136process_meta_predicate((A,B), Src) :- 1137 !, 1138 process_meta_predicate(A, Src), 1139 process_meta_predicate(B, Src). 1140process_meta_predicate(Decl, Src) :- 1141 process_meta_head(Src, Decl). 1142 1143process_meta_head(Src, Decl) :- % swapped arguments for maplist 1144 compound(Decl), 1145 compound_name_arity(Decl, Name, Arity), 1146 compound_name_arity(Head, Name, Arity), 1147 meta_args(1, Arity, Decl, Head, Meta), 1148 ( ( prolog:meta_goal(Head, _) 1149 ; prolog:called_by(Head, _, _, _) 1150 ; prolog:called_by(Head, _) 1151 ; meta_goal(Head, _) 1152 ) 1153 -> true 1154 ; assert(meta_goal(Head, Meta, Src)) 1155 ). 1156 1157meta_args(I, Arity, _, _, []) :- 1158 I > Arity, 1159 !. 1160meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1161 arg(I, Decl, 0), 1162 !, 1163 arg(I, Head, H), 1164 I2 is I + 1, 1165 meta_args(I2, Arity, Decl, Head, T). 1166meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1167 arg(I, Decl, ^), 1168 !, 1169 arg(I, Head, EH), 1170 setof_goal(EH, H), 1171 I2 is I + 1, 1172 meta_args(I2, Arity, Decl, Head, T). 1173meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1174 arg(I, Decl, //), 1175 !, 1176 arg(I, Head, H), 1177 I2 is I + 1, 1178 meta_args(I2, Arity, Decl, Head, T). 1179meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1180 arg(I, Decl, A), 1181 integer(A), A > 0, 1182 !, 1183 arg(I, Head, H), 1184 I2 is I + 1, 1185 meta_args(I2, Arity, Decl, Head, T). 1186meta_args(I, Arity, Decl, Head, Meta) :- 1187 I2 is I + 1, 1188 meta_args(I2, Arity, Decl, Head, Meta). 1189 1190 1191 /******************************** 1192 * BODY * 1193 ********************************/
1202xref_meta(Source, Head, Called) :-
1203 canonical_source(Source, Src),
1204 xref_meta_src(Head, Called, Src).1219xref_meta_src(Head, Called, Src) :- 1220 meta_goal(Head, Called, Src), 1221 !. 1222xref_meta_src(Head, Called, _) :- 1223 xref_meta(Head, Called), 1224 !. 1225xref_meta_src(Head, Called, _) :- 1226 compound(Head), 1227 compound_name_arity(Head, Name, Arity), 1228 apply_pred(Name), 1229 Arity > 5, 1230 !, 1231 Extra is Arity - 1, 1232 arg(1, Head, G), 1233 Called = [G+Extra]. 1234xref_meta_src(Head, Called, _) :- 1235 predicate_property('$xref_tmp':Head, meta_predicate(Meta)), 1236 !, 1237 Meta =.. [_|Args], 1238 meta_args(Args, 1, Head, Called). 1239 1240meta_args([], _, _, []). 1241meta_args([H0|T0], I, Head, [H|T]) :- 1242 xargs(H0, N), 1243 !, 1244 arg(I, Head, A), 1245 ( N == 0 1246 -> H = A 1247 ; H = (A+N) 1248 ), 1249 I2 is I+1, 1250 meta_args(T0, I2, Head, T). 1251meta_args([_|T0], I, Head, T) :- 1252 I2 is I+1, 1253 meta_args(T0, I2, Head, T). 1254 1255xargs(N, N) :- integer(N), !. 1256xargs(//, 2). 1257xargs(^, 0). 1258 1259apply_pred(call). % built-in 1260apply_pred(maplist). % library(apply_macros) 1261 1262xref_meta((A, B), [A, B]). 1263xref_meta((A; B), [A, B]). 1264xref_meta((A| B), [A, B]). 1265xref_meta((A -> B), [A, B]). 1266xref_meta((A *-> B), [A, B]). 1267xref_meta(findall(_V,G,_L), [G]). 1268xref_meta(findall(_V,G,_L,_T), [G]). 1269xref_meta(findnsols(_N,_V,G,_L), [G]). 1270xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1271xref_meta(setof(_V, EG, _L), [G]) :- 1272 setof_goal(EG, G). 1273xref_meta(bagof(_V, EG, _L), [G]) :- 1274 setof_goal(EG, G). 1275xref_meta(forall(A, B), [A, B]). 1276xref_meta(maplist(G,_), [G+1]). 1277xref_meta(maplist(G,_,_), [G+2]). 1278xref_meta(maplist(G,_,_,_), [G+3]). 1279xref_meta(maplist(G,_,_,_,_), [G+4]). 1280xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1281xref_meta(map_assoc(G, _), [G+1]). 1282xref_meta(map_assoc(G, _, _), [G+2]). 1283xref_meta(checklist(G, _L), [G+1]). 1284xref_meta(sublist(G, _, _), [G+1]). 1285xref_meta(include(G, _, _), [G+1]). 1286xref_meta(exclude(G, _, _), [G+1]). 1287xref_meta(partition(G, _, _, _, _), [G+2]). 1288xref_meta(partition(G, _, _, _),[G+1]). 1289xref_meta(call(G), [G]). 1290xref_meta(call(G, _), [G+1]). 1291xref_meta(call(G, _, _), [G+2]). 1292xref_meta(call(G, _, _, _), [G+3]). 1293xref_meta(call(G, _, _, _, _), [G+4]). 1294xref_meta(not(G), [G]). 1295xref_meta(notrace(G), [G]). 1296xref_meta('$notrace'(G), [G]). 1297xref_meta(\+(G), [G]). 1298xref_meta(ignore(G), [G]). 1299xref_meta(once(G), [G]). 1300xref_meta(initialization(G), [G]). 1301xref_meta(initialization(G,_), [G]). 1302xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1303xref_meta(clause(G, _), [G]). 1304xref_meta(clause(G, _, _), [G]). 1305xref_meta(phrase(G, _A), [//(G)]). 1306xref_meta(phrase(G, _A, _R), [//(G)]). 1307xref_meta(call_dcg(G, _A, _R), [//(G)]). 1308xref_meta(phrase_from_file(G,_),[//(G)]). 1309xref_meta(catch(A, _, B), [A, B]). 1310xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1311xref_meta(thread_create(A,_,_), [A]). 1312xref_meta(thread_create(A,_), [A]). 1313xref_meta(thread_signal(_,A), [A]). 1314xref_meta(thread_idle(A,_), [A]). 1315xref_meta(thread_at_exit(A), [A]). 1316xref_meta(thread_initialization(A), [A]). 1317xref_meta(engine_create(_,A,_), [A]). 1318xref_meta(engine_create(_,A,_,_), [A]). 1319xref_meta(transaction(A), [A]). 1320xref_meta(transaction(A,B,_), [A,B]). 1321xref_meta(snapshot(A), [A]). 1322xref_meta(predsort(A,_,_), [A+3]). 1323xref_meta(call_cleanup(A, B), [A, B]). 1324xref_meta(call_cleanup(A, _, B),[A, B]). 1325xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1326xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1327xref_meta(call_residue_vars(A,_), [A]). 1328xref_meta(with_mutex(_,A), [A]). 1329xref_meta(assume(G), [G]). % library(debug) 1330xref_meta(assertion(G), [G]). % library(debug) 1331xref_meta(freeze(_, G), [G]). 1332xref_meta(when(C, A), [C, A]). 1333xref_meta(time(G), [G]). % development system 1334xref_meta(call_time(G, _), [G]). % development system 1335xref_meta(call_time(G, _, _), [G]). % development system 1336xref_meta(profile(G), [G]). 1337xref_meta(at_halt(G), [G]). 1338xref_meta(call_with_time_limit(_, G), [G]). 1339xref_meta(call_with_depth_limit(G, _, _), [G]). 1340xref_meta(call_with_inference_limit(G, _, _), [G]). 1341xref_meta(alarm(_, G, _), [G]). 1342xref_meta(alarm(_, G, _, _), [G]). 1343xref_meta('$add_directive_wic'(G), [G]). 1344xref_meta(with_output_to(_, G), [G]). 1345xref_meta(if(G), [G]). 1346xref_meta(elif(G), [G]). 1347xref_meta(meta_options(G,_,_), [G+1]). 1348xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1349xref_meta(distinct(G), [G]). % library(solution_sequences) 1350xref_meta(distinct(_, G), [G]). 1351xref_meta(order_by(_, G), [G]). 1352xref_meta(limit(_, G), [G]). 1353xref_meta(offset(_, G), [G]). 1354xref_meta(reset(G,_,_), [G]). 1355xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1356xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1357xref_meta(tnot(G), [G]). 1358xref_meta(not_exists(G), [G]). 1359xref_meta(with_tty_raw(G), [G]). 1360xref_meta(residual_goals(G), [G+2]). 1361 1362 % XPCE meta-predicates 1363xref_meta(pce_global(_, new(_)), _) :- !, fail. 1364xref_meta(pce_global(_, B), [B+1]). 1365xref_meta(ifmaintainer(G), [G]). % used in manual 1366xref_meta(listen(_, G), [G]). % library(broadcast) 1367xref_meta(listen(_, _, G), [G]). 1368xref_meta(in_pce_thread(G), [G]). 1369 1370xref_meta(G, Meta) :- % call user extensions 1371 prolog:meta_goal(G, Meta). 1372xref_meta(G, Meta) :- % Generated from :- meta_predicate 1373 meta_goal(G, Meta). 1374 1375setof_goal(EG, G) :- 1376 var(EG), !, G = EG. 1377setof_goal(_^EG, G) :- 1378 !, 1379 setof_goal(EG, G). 1380setof_goal(G, G). 1381 1382event_xargs(abort, 0). 1383event_xargs(erase, 1). 1384event_xargs(break, 3). 1385event_xargs(frame_finished, 1). 1386event_xargs(thread_exit, 1). 1387event_xargs(this_thread_exit, 0). 1388event_xargs(PI, 2) :- pi_to_head(PI, _).
1394head_of(Var, _) :- 1395 var(Var), !, fail. 1396head_of((Head :- _), Head). 1397head_of(Head, Head).
1405xref_hook(Hook) :- 1406 prolog:hook(Hook). 1407xref_hook(Hook) :- 1408 hook(Hook). 1409 1410 1411hook(attr_portray_hook(_,_)). 1412hook(attr_unify_hook(_,_)). 1413hook(attribute_goals(_,_,_)). 1414hook(goal_expansion(_,_)). 1415hook(term_expansion(_,_)). 1416hook(resource(_,_,_)). 1417hook('$pred_option'(_,_,_,_)). 1418 1419hook(emacs_prolog_colours:goal_classification(_,_)). 1420hook(emacs_prolog_colours:term_colours(_,_)). 1421hook(emacs_prolog_colours:goal_colours(_,_)). 1422hook(emacs_prolog_colours:style(_,_)). 1423hook(emacs_prolog_colours:identify(_,_)). 1424hook(pce_principal:pce_class(_,_,_,_,_,_)). 1425hook(pce_principal:send_implementation(_,_,_)). 1426hook(pce_principal:get_implementation(_,_,_,_)). 1427hook(pce_principal:pce_lazy_get_method(_,_,_)). 1428hook(pce_principal:pce_lazy_send_method(_,_,_)). 1429hook(pce_principal:pce_uses_template(_,_)). 1430hook(prolog:locate_clauses(_,_)). 1431hook(prolog:message(_,_,_)). 1432hook(prolog:error_message(_,_,_)). 1433hook(prolog:message_location(_,_,_)). 1434hook(prolog:message_context(_,_,_)). 1435hook(prolog:message_line_element(_,_)). 1436hook(prolog:debug_control_hook(_)). 1437hook(prolog:help_hook(_)). 1438hook(prolog:show_profile_hook(_,_)). 1439hook(prolog:general_exception(_,_)). 1440hook(prolog:predicate_summary(_,_)). 1441hook(prolog:residual_goals(_,_)). 1442hook(prolog_edit:load). 1443hook(prolog_edit:locate(_,_,_)). 1444hook(shlib:unload_all_foreign_libraries). 1445hook(system:'$foreign_registered'(_, _)). 1446hook(predicate_options:option_decl(_,_,_)). 1447hook(user:exception(_,_,_)). 1448hook(user:file_search_path(_,_)). 1449hook(user:library_directory(_)). 1450hook(user:message_hook(_,_,_)). 1451hook(user:portray(_)). 1452hook(user:prolog_clause_name(_,_)). 1453hook(user:prolog_list_goal(_)). 1454hook(user:prolog_predicate_name(_,_)). 1455hook(user:prolog_trace_interception(_,_,_,_)). 1456hook(prolog:prolog_exception_hook(_,_,_,_,_)). 1457hook(sandbox:safe_primitive(_)). 1458hook(sandbox:safe_meta_predicate(_)). 1459hook(sandbox:safe_meta(_,_)). 1460hook(sandbox:safe_global_variable(_)). 1461hook(sandbox:safe_directive(_)).
1468arith_callable(Var, _) :- 1469 var(Var), !, fail. 1470arith_callable(Module:Spec, Module:Goal) :- 1471 !, 1472 arith_callable(Spec, Goal). 1473arith_callable(Name/Arity, Goal) :- 1474 PredArity is Arity + 1, 1475 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1486process_body(Body, Origin, Src) :-
1487 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1488 true).true if there was a
partial evalation inside Goal that has bound variables.1495process_goal(Var, _, _, _) :- 1496 var(Var), 1497 !. 1498process_goal(_:Goal, _, _, _) :- 1499 var(Goal), 1500 !. 1501process_goal(Goal, Origin, Src, P) :- 1502 Goal = (_,_), % problems 1503 !, 1504 phrase(conjunction(Goal), Goals), 1505 process_conjunction(Goals, Origin, Src, P). 1506process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1507 Goal = (_;_), % problems 1508 !, 1509 phrase(disjunction(Goal), Goals), 1510 forall(member(G, Goals), 1511 process_body(G, Origin, Src)). 1512process_goal(Goal, Origin, Src, P) :- 1513 ( ( xmodule(M, Src) 1514 -> true 1515 ; M = user 1516 ), 1517 pi_head(PI, M:Goal), 1518 ( current_predicate(PI), 1519 predicate_property(M:Goal, imported_from(IM)) 1520 -> true 1521 ; PI = M:Name/Arity, 1522 '$find_library'(M, Name, Arity, IM, _Library) 1523 -> true 1524 ; IM = M 1525 ), 1526 prolog:called_by(Goal, IM, M, Called) 1527 ; prolog:called_by(Goal, Called) 1528 ), 1529 !, 1530 must_be(list, Called), 1531 current_source_line(Here), 1532 assert_called(Src, Origin, Goal, Here), 1533 process_called_list(Called, Origin, Src, P). 1534process_goal(Goal, Origin, Src, _) :- 1535 process_xpce_goal(Goal, Origin, Src), 1536 !. 1537process_goal(load_foreign_library(File), _Origin, Src, _) :- 1538 process_foreign(File, Src). 1539process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1540 process_foreign(File, Src). 1541process_goal(use_foreign_library(File), _Origin, Src, _) :- 1542 process_foreign(File, Src). 1543process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1544 process_foreign(File, Src). 1545process_goal(Goal, Origin, Src, P) :- 1546 xref_meta_src(Goal, Metas, Src), 1547 !, 1548 current_source_line(Here), 1549 assert_called(Src, Origin, Goal, Here), 1550 process_called_list(Metas, Origin, Src, P). 1551process_goal(Goal, Origin, Src, _) :- 1552 asserting_goal(Goal, Rule), 1553 !, 1554 current_source_line(Here), 1555 assert_called(Src, Origin, Goal, Here), 1556 process_assert(Rule, Origin, Src). 1557process_goal(Goal, Origin, Src, P) :- 1558 partial_evaluate(Goal, P), 1559 current_source_line(Here), 1560 assert_called(Src, Origin, Goal, Here). 1561 1562disjunction(Var) --> {var(Var), !}, [Var]. 1563disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1564disjunction(G) --> [G]. 1565 1566conjunction(Var) --> {var(Var), !}, [Var]. 1567conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1568conjunction(G) --> [G]. 1569 (RVars, T) :- 1571 term_variables(T, TVars0), 1572 sort(TVars0, TVars), 1573 ord_intersect(RVars, TVars). 1574 1575process_conjunction([], _, _, _). 1576process_conjunction([Disj|Rest], Origin, Src, P) :- 1577 nonvar(Disj), 1578 Disj = (_;_), 1579 Rest \== [], 1580 !, 1581 phrase(disjunction(Disj), Goals), 1582 term_variables(Rest, RVars0), 1583 sort(RVars0, RVars), 1584 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1585 forall(member(G, NonSHaring), 1586 process_body(G, Origin, Src)), 1587 ( Sharing == [] 1588 -> true 1589 ; maplist(term_variables, Sharing, GVars0), 1590 append(GVars0, GVars1), 1591 sort(GVars1, GVars), 1592 ord_intersection(GVars, RVars, SVars), 1593 VT =.. [v|SVars], 1594 findall(VT, 1595 ( member(G, Sharing), 1596 process_goal(G, Origin, Src, PS), 1597 PS == true 1598 ), 1599 Alts0), 1600 ( Alts0 == [] 1601 -> true 1602 ; ( true 1603 ; P = true, 1604 sort(Alts0, Alts1), 1605 variants(Alts1, 10, Alts), 1606 member(VT, Alts) 1607 ) 1608 ) 1609 ), 1610 process_conjunction(Rest, Origin, Src, P). 1611process_conjunction([H|T], Origin, Src, P) :- 1612 process_goal(H, Origin, Src, P), 1613 process_conjunction(T, Origin, Src, P). 1614 1615 1616process_called_list([], _, _, _). 1617process_called_list([H|T], Origin, Src, P) :- 1618 process_meta(H, Origin, Src, P), 1619 process_called_list(T, Origin, Src, P). 1620 1621process_meta(A+N, Origin, Src, P) :- 1622 !, 1623 ( extend(A, N, AX) 1624 -> process_goal(AX, Origin, Src, P) 1625 ; true 1626 ). 1627process_meta(//(A), Origin, Src, P) :- 1628 !, 1629 process_dcg_goal(A, Origin, Src, P). 1630process_meta(G, Origin, Src, P) :- 1631 process_goal(G, Origin, Src, P).
1638process_dcg_goal(Var, _, _, _) :- 1639 var(Var), 1640 !. 1641process_dcg_goal((A,B), Origin, Src, P) :- 1642 !, 1643 process_dcg_goal(A, Origin, Src, P), 1644 process_dcg_goal(B, Origin, Src, P). 1645process_dcg_goal((A;B), Origin, Src, P) :- 1646 !, 1647 process_dcg_goal(A, Origin, Src, P), 1648 process_dcg_goal(B, Origin, Src, P). 1649process_dcg_goal((A|B), Origin, Src, P) :- 1650 !, 1651 process_dcg_goal(A, Origin, Src, P), 1652 process_dcg_goal(B, Origin, Src, P). 1653process_dcg_goal((A->B), Origin, Src, P) :- 1654 !, 1655 process_dcg_goal(A, Origin, Src, P), 1656 process_dcg_goal(B, Origin, Src, P). 1657process_dcg_goal((A*->B), Origin, Src, P) :- 1658 !, 1659 process_dcg_goal(A, Origin, Src, P), 1660 process_dcg_goal(B, Origin, Src, P). 1661process_dcg_goal({Goal}, Origin, Src, P) :- 1662 !, 1663 process_goal(Goal, Origin, Src, P). 1664process_dcg_goal(List, _Origin, _Src, _) :- 1665 is_list(List), 1666 !. % terminal 1667process_dcg_goal(List, _Origin, _Src, _) :- 1668 string(List), 1669 !. % terminal 1670process_dcg_goal(Callable, Origin, Src, P) :- 1671 extend(Callable, 2, Goal), 1672 !, 1673 process_goal(Goal, Origin, Src, P). 1674process_dcg_goal(_, _, _, _). 1675 1676 1677extend(Var, _, _) :- 1678 var(Var), !, fail. 1679extend(M:G, N, M:GX) :- 1680 !, 1681 callable(G), 1682 extend(G, N, GX). 1683extend(G, N, GX) :- 1684 ( compound(G) 1685 -> compound_name_arguments(G, Name, Args), 1686 length(Rest, N), 1687 append(Args, Rest, NArgs), 1688 compound_name_arguments(GX, Name, NArgs) 1689 ; atom(G) 1690 -> length(NArgs, N), 1691 compound_name_arguments(GX, G, NArgs) 1692 ). 1693 1694asserting_goal(assert(Rule), Rule). 1695asserting_goal(asserta(Rule), Rule). 1696asserting_goal(assertz(Rule), Rule). 1697asserting_goal(assert(Rule,_), Rule). 1698asserting_goal(asserta(Rule,_), Rule). 1699asserting_goal(assertz(Rule,_), Rule). 1700 1701process_assert(0, _, _) :- !. % catch variables 1702process_assert((_:-Body), Origin, Src) :- 1703 !, 1704 process_body(Body, Origin, Src). 1705process_assert(_, _, _).
1709variants([], _, []). 1710variants([H|T], Max, List) :- 1711 variants(T, H, Max, List). 1712 1713variants([], H, _, [H]). 1714variants(_, _, 0, []) :- !. 1715variants([H|T], V, Max, List) :- 1716 ( H =@= V 1717 -> variants(T, V, Max, List) 1718 ; List = [V|List2], 1719 Max1 is Max-1, 1720 variants(T, H, Max1, List2) 1721 ).
T = hello(X),
findall(T, T, List),
1735partial_evaluate(Goal, P) :- 1736 eval(Goal), 1737 !, 1738 P = true. 1739partial_evaluate(_, _). 1740 1741eval(X = Y) :- 1742 unify_with_occurs_check(X, Y). 1743 1744 /******************************* 1745 * PLUNIT SUPPORT * 1746 *******************************/ 1747 1748enter_test_unit(Unit, _Src) :- 1749 current_source_line(Line), 1750 asserta(current_test_unit(Unit, Line)). 1751 1752leave_test_unit(Unit, _Src) :- 1753 retractall(current_test_unit(Unit, _)). 1754 1755 1756 /******************************* 1757 * XPCE STUFF * 1758 *******************************/ 1759 1760pce_goal(new(_,_), new(-, new)). 1761pce_goal(send(_,_), send(arg, msg)). 1762pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1763pce_goal(get(_,_,_), get(arg, msg, -)). 1764pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1765pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1766pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1767 1768process_xpce_goal(G, Origin, Src) :- 1769 pce_goal(G, Process), 1770 !, 1771 current_source_line(Here), 1772 assert_called(Src, Origin, G, Here), 1773 ( arg(I, Process, How), 1774 arg(I, G, Term), 1775 process_xpce_arg(How, Term, Origin, Src), 1776 fail 1777 ; true 1778 ). 1779 1780process_xpce_arg(new, Term, Origin, Src) :- 1781 callable(Term), 1782 process_new(Term, Origin, Src). 1783process_xpce_arg(arg, Term, Origin, Src) :- 1784 compound(Term), 1785 process_new(Term, Origin, Src). 1786process_xpce_arg(msg, Term, Origin, Src) :- 1787 compound(Term), 1788 ( arg(_, Term, Arg), 1789 process_xpce_arg(arg, Arg, Origin, Src), 1790 fail 1791 ; true 1792 ). 1793 1794process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1795process_new(Term, Origin, Src) :- 1796 assert_new(Src, Origin, Term), 1797 ( compound(Term), 1798 arg(_, Term, Arg), 1799 process_xpce_arg(arg, Arg, Origin, Src), 1800 fail 1801 ; true 1802 ). 1803 1804assert_new(_, _, Term) :- 1805 \+ callable(Term), 1806 !. 1807assert_new(Src, Origin, Control) :- 1808 functor_name(Control, Class), 1809 pce_control_class(Class), 1810 !, 1811 forall(arg(_, Control, Arg), 1812 assert_new(Src, Origin, Arg)). 1813assert_new(Src, Origin, Term) :- 1814 compound(Term), 1815 arg(1, Term, Prolog), 1816 Prolog == @(prolog), 1817 ( Term =.. [message, _, Selector | T], 1818 atom(Selector) 1819 -> Called =.. [Selector|T], 1820 process_body(Called, Origin, Src) 1821 ; Term =.. [?, _, Selector | T], 1822 atom(Selector) 1823 -> append(T, [_R], T2), 1824 Called =.. [Selector|T2], 1825 process_body(Called, Origin, Src) 1826 ), 1827 fail. 1828assert_new(_, _, @(_)) :- !. 1829assert_new(Src, _, Term) :- 1830 functor_name(Term, Name), 1831 assert_used_class(Src, Name). 1832 1833 1834pce_control_class(and). 1835pce_control_class(or). 1836pce_control_class(if). 1837pce_control_class(not). 1838 1839 1840 /******************************** 1841 * INCLUDED MODULES * 1842 ********************************/
1846process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1847process_use_module([], _, _) :- !. 1848process_use_module([H|T], Src, Reexport) :- 1849 !, 1850 process_use_module(H, Src, Reexport), 1851 process_use_module(T, Src, Reexport). 1852process_use_module(library(pce), Src, Reexport) :- % bit special 1853 !, 1854 xref_public_list(library(pce), Path, Exports, Src), 1855 forall(member(Import, Exports), 1856 process_pce_import(Import, Src, Path, Reexport)). 1857process_use_module(File, Src, Reexport) :- 1858 load_module_if_needed(File), 1859 ( xoption(Src, silent(Silent)) 1860 -> Extra = [silent(Silent)] 1861 ; Extra = [silent(true)] 1862 ), 1863 ( xref_public_list(File, Src, 1864 [ path(Path), 1865 module(M), 1866 exports(Exports), 1867 public(Public), 1868 meta(Meta) 1869 | Extra 1870 ]) 1871 -> assert(uses_file(File, Src, Path)), 1872 assert_import(Src, Exports, _, Path, Reexport), 1873 assert_xmodule_callable(Exports, M, Src, Path), 1874 assert_xmodule_callable(Public, M, Src, Path), 1875 maplist(process_meta_head(Src), Meta), 1876 ( File = library(chr) % hacky 1877 -> assert(mode(chr, Src)) 1878 ; true 1879 ) 1880 ; assert(uses_file(File, Src, '<not_found>')) 1881 ). 1882 1883process_pce_import(Name/Arity, Src, Path, Reexport) :- 1884 atom(Name), 1885 integer(Arity), 1886 !, 1887 functor(Term, Name, Arity), 1888 ( \+ system_predicate(Term), 1889 \+ Term = pce_error(_) % hack!? 1890 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1891 ; true 1892 ). 1893process_pce_import(op(P,T,N), Src, _, _) :- 1894 xref_push_op(Src, P, T, N).
1900process_use_module2(File, Import, Src, Reexport) :-
1901 load_module_if_needed(File),
1902 ( xref_source_file(File, Path, Src)
1903 -> assert(uses_file(File, Src, Path)),
1904 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1905 -> assert_import(Src, Import, Export, Path, Reexport),
1906 forall(( member(Head, Meta),
1907 imported(Head, _, Path)
1908 ),
1909 process_meta_head(Src, Head))
1910 ; true
1911 )
1912 ; assert(uses_file(File, Src, '<not_found>'))
1913 ).1922load_module_if_needed(File) :- 1923 prolog:no_autoload_module(File), 1924 !, 1925 use_module(File, []). 1926load_module_if_needed(_). 1927 1928prologno_autoload_module(library(apply_macros)). 1929prologno_autoload_module(library(arithmetic)). 1930prologno_autoload_module(library(record)). 1931prologno_autoload_module(library(persistency)). 1932prologno_autoload_module(library(pldoc)). 1933prologno_autoload_module(library(settings)). 1934prologno_autoload_module(library(debug)). 1935prologno_autoload_module(library(plunit)).
1940process_requires(Import, Src) :- 1941 is_list(Import), 1942 !, 1943 require_list(Import, Src). 1944process_requires(Var, _Src) :- 1945 var(Var), 1946 !. 1947process_requires((A,B), Src) :- 1948 !, 1949 process_requires(A, Src), 1950 process_requires(B, Src). 1951process_requires(PI, Src) :- 1952 requires(PI, Src). 1953 1954require_list([], _). 1955require_list([H|T], Src) :- 1956 requires(H, Src), 1957 require_list(T, Src). 1958 1959requires(PI, _Src) :- 1960 '$pi_head'(PI, Head), 1961 '$get_predicate_attribute'(system:Head, defined, 1), 1962 !. 1963requires(PI, Src) :- 1964 '$pi_head'(PI, Head), 1965 '$pi_head'(Name/Arity, Head), 1966 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1967 ( imported(Head, Src, Library) 1968 -> true 1969 ; assertz(imported(Head, Src, Library)) 1970 ).
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.
2001xref_public_list(File, Src, Options) :-
2002 option(path(Path), Options, _),
2003 option(module(Module), Options, _),
2004 option(exports(Exports), Options, _),
2005 option(public(Public), Options, _),
2006 option(meta(Meta), Options, _),
2007 xref_source_file(File, Path, Src, Options),
2008 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
2030xref_public_list(File, Path, Export, Src) :- 2031 xref_source_file(File, Path, Src), 2032 public_list(Path, _, _, Export, _, []). 2033xref_public_list(File, Path, Module, Export, Meta, Src) :- 2034 xref_source_file(File, Path, Src), 2035 public_list(Path, Module, Meta, Export, _, []). 2036xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 2037 xref_source_file(File, Path, Src), 2038 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2048:- dynamic public_list_cache/6. 2049:- volatile public_list_cache/6. 2050 2051public_list(Path, Module, Meta, Export, Public, _Options) :- 2052 public_list_cache(Path, Modified, 2053 Module0, Meta0, Export0, Public0), 2054 time_file(Path, ModifiedNow), 2055 ( abs(Modified-ModifiedNow) < 0.0001 2056 -> !, 2057 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2058 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2059 fail 2060 ). 2061public_list(Path, Module, Meta, Export, Public, Options) :- 2062 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2063 ( Error = error(_,_), 2064 catch(time_file(Path, Modified), Error, fail) 2065 -> asserta(public_list_cache(Path, Modified, 2066 Module0, Meta0, Export0, Public0)) 2067 ; true 2068 ), 2069 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2070 2071public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2072 in_temporary_module( 2073 TempModule, 2074 true, 2075 public_list_diff(TempModule, Path, Module, 2076 Meta, [], Export, [], Public, [], Options)). 2077 2078 2079public_list_diff(TempModule, 2080 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2081 setup_call_cleanup( 2082 public_list_setup(TempModule, Path, In, State), 2083 phrase(read_directives(In, Options, [true]), Directives), 2084 public_list_cleanup(In, State)), 2085 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2086 2087public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2088 prolog_open_source(Path, In), 2089 '$set_source_module'(OldM, TempModule), 2090 set_xref(OldXref). 2091 2092public_list_cleanup(In, state(OldM, OldXref)) :- 2093 '$set_source_module'(OldM), 2094 set_prolog_flag(xref, OldXref), 2095 prolog_close_source(In). 2096 2097 2098read_directives(In, Options, State) --> 2099 { repeat, 2100 catch(prolog_read_source_term(In, Term, Expanded, 2101 [ process_comment(true), 2102 syntax_errors(error) 2103 ]), 2104 E, report_syntax_error(E, -, Options)) 2105 -> nonvar(Term), 2106 Term = (:-_) 2107 }, 2108 !, 2109 terms(Expanded, State, State1), 2110 read_directives(In, Options, State1). 2111read_directives(_, _, _) --> []. 2112 2113terms(Var, State, State) --> { var(Var) }, !. 2114terms([H|T], State0, State) --> 2115 !, 2116 terms(H, State0, State1), 2117 terms(T, State1, State). 2118terms((:-if(Cond)), State0, [True|State0]) --> 2119 !, 2120 { eval_cond(Cond, True) }. 2121terms((:-elif(Cond)), [True0|State], [True|State]) --> 2122 !, 2123 { eval_cond(Cond, True1), 2124 elif(True0, True1, True) 2125 }. 2126terms((:-else), [True0|State], [True|State]) --> 2127 !, 2128 { negate(True0, True) }. 2129terms((:-endif), [_|State], State) --> !. 2130terms(H, State, State) --> 2131 ( {State = [true|_]} 2132 -> [H] 2133 ; [] 2134 ). 2135 2136eval_cond(Cond, true) :- 2137 catch(Cond, _, fail), 2138 !. 2139eval_cond(_, false). 2140 2141elif(true, _, else_false) :- !. 2142elif(false, true, true) :- !. 2143elif(True, _, True). 2144 2145negate(true, false). 2146negate(false, true). 2147negate(else_false, else_false). 2148 2149public_list([(:- module(Module, Export0))|Decls], Path, 2150 Module, Meta, MT, Export, Rest, Public, PT) :- 2151 !, 2152 ( is_list(Export0) 2153 -> append(Export0, Reexport, Export) 2154 ; Reexport = Export 2155 ), 2156 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2157public_list([(:- encoding(_))|Decls], Path, 2158 Module, Meta, MT, Export, Rest, Public, PT) :- 2159 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2160 2161public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2162public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2163 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2164 !, 2165 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2166public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2167 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2168 2169public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2170 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2171public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2172 public_from_import(Import, Spec, Path, Reexport, Rest). 2173public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2174 phrase(meta_decls(Decl), Meta, MT). 2175public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2176 phrase(public_decls(Decl), Public, PT).
2182reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2183reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2184 !, 2185 xref_source_file(H, Path, Src), 2186 public_list(Path, _Module, Meta0, Export0, Public0, []), 2187 append(Meta0, MT1, Meta), 2188 append(Export0, ET1, Export), 2189 append(Public0, PT1, Public), 2190 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2191reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2192 xref_source_file(Spec, Path, Src), 2193 public_list(Path, _Module, Meta0, Export0, Public0, []), 2194 append(Meta0, MT, Meta), 2195 append(Export0, ET, Export), 2196 append(Public0, PT, Public). 2197 2198public_from_import(except(Map), Path, Src, Export, Rest) :- 2199 !, 2200 xref_public_list(Path, _, AllExports, Src), 2201 except(Map, AllExports, NewExports), 2202 append(NewExports, Rest, Export). 2203public_from_import(Import, _, _, Export, Rest) :- 2204 import_name_map(Import, Export, Rest).
2209except([], Exports, Exports). 2210except([PI0 as NewName|Map], Exports0, Exports) :- 2211 !, 2212 canonical_pi(PI0, PI), 2213 map_as(Exports0, PI, NewName, Exports1), 2214 except(Map, Exports1, Exports). 2215except([PI0|Map], Exports0, Exports) :- 2216 canonical_pi(PI0, PI), 2217 select(PI2, Exports0, Exports1), 2218 same_pi(PI, PI2), 2219 !, 2220 except(Map, Exports1, Exports). 2221 2222 2223map_as([PI|T], Repl, As, [PI2|T]) :- 2224 same_pi(Repl, PI), 2225 !, 2226 pi_as(PI, As, PI2). 2227map_as([H|T0], Repl, As, [H|T]) :- 2228 map_as(T0, Repl, As, T). 2229 2230pi_as(_/Arity, Name, Name/Arity). 2231pi_as(_//Arity, Name, Name//Arity). 2232 2233import_name_map([], L, L). 2234import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2235 !, 2236 import_name_map(T0, T, Tail). 2237import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2238 !, 2239 import_name_map(T0, T, Tail). 2240import_name_map([H|T0], [H|T], Tail) :- 2241 import_name_map(T0, T, Tail). 2242 2243canonical_pi(Name//Arity0, PI) :- 2244 integer(Arity0), 2245 !, 2246 PI = Name/Arity, 2247 Arity is Arity0 + 2. 2248canonical_pi(PI, PI). 2249 2250same_pi(Canonical, PI2) :- 2251 canonical_pi(PI2, Canonical). 2252 2253meta_decls(Var) --> 2254 { var(Var) }, 2255 !. 2256meta_decls((A,B)) --> 2257 !, 2258 meta_decls(A), 2259 meta_decls(B). 2260meta_decls(A) --> 2261 [A]. 2262 2263public_decls(Var) --> 2264 { var(Var) }, 2265 !. 2266public_decls((A,B)) --> 2267 !, 2268 public_decls(A), 2269 public_decls(B). 2270public_decls(A) --> 2271 [A]. 2272 2273 /******************************* 2274 * INCLUDE * 2275 *******************************/ 2276 2277process_include([], _) :- !. 2278process_include([H|T], Src) :- 2279 !, 2280 process_include(H, Src), 2281 process_include(T, Src). 2282process_include(File, Src) :- 2283 callable(File), 2284 !, 2285 ( once(xref_input(ParentSrc, _)), 2286 xref_source_file(File, Path, ParentSrc) 2287 -> ( ( uses_file(_, Src, Path) 2288 ; Path == Src 2289 ) 2290 -> true 2291 ; assert(uses_file(File, Src, Path)), 2292 ( xoption(Src, process_include(true)) 2293 -> findall(O, xoption(Src, O), Options), 2294 setup_call_cleanup( 2295 open_include_file(Path, In, Refs), 2296 collect(Src, Path, In, Options), 2297 close_include(In, Refs)) 2298 ; true 2299 ) 2300 ) 2301 ; assert(uses_file(File, Src, '<not_found>')) 2302 ). 2303process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2311open_include_file(Path, In, [Ref]) :- 2312 once(xref_input(_, Parent)), 2313 stream_property(Parent, encoding(Enc)), 2314 '$push_input_context'(xref_include), 2315 catch(( prolog:xref_open_source(Path, In) 2316 -> catch(set_stream(In, encoding(Enc)), 2317 error(_,_), true) % deal with non-file input 2318 ; include_encoding(Enc, Options), 2319 open(Path, read, In, Options) 2320 ), E, 2321 ( '$pop_input_context', throw(E))), 2322 catch(( peek_char(In, #) % Deal with #! script 2323 -> skip(In, 10) 2324 ; true 2325 ), E, 2326 ( close_include(In, []), throw(E))), 2327 asserta(xref_input(Path, In), Ref). 2328 2329include_encoding(wchar_t, []) :- !. 2330include_encoding(Enc, [encoding(Enc)]). 2331 2332 2333close_include(In, Refs) :- 2334 maplist(erase, Refs), 2335 close(In, [force(true)]), 2336 '$pop_input_context'.
2342process_foreign(Spec, Src) :- 2343 ground(Spec), 2344 current_foreign_library(Spec, Defined), 2345 !, 2346 ( xmodule(Module, Src) 2347 -> true 2348 ; Module = user 2349 ), 2350 process_foreign_defined(Defined, Module, Src). 2351process_foreign(_, _). 2352 2353process_foreign_defined([], _, _). 2354process_foreign_defined([H|T], M, Src) :- 2355 ( H = M:Head 2356 -> assert_foreign(Src, Head) 2357 ; assert_foreign(Src, H) 2358 ), 2359 process_foreign_defined(T, M, Src). 2360 2361 2362 /******************************* 2363 * CHR SUPPORT * 2364 *******************************/ 2365 2366/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2367This part of the file supports CHR. Our choice is between making special 2368hooks to make CHR expansion work and then handle the (complex) expanded 2369code or process the CHR source directly. The latter looks simpler, 2370though I don't like the idea of adding support for libraries to this 2371module. A file is supposed to be a CHR file if it uses a 2372use_module(library(chr) or contains a :- constraint/1 directive. As an 2373extra bonus we get the source-locations right :-) 2374- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2375 2376process_chr(@(_Name, Rule), Src) :- 2377 mode(chr, Src), 2378 process_chr(Rule, Src). 2379process_chr(pragma(Rule, _Pragma), Src) :- 2380 mode(chr, Src), 2381 process_chr(Rule, Src). 2382process_chr(<=>(Head, Body), Src) :- 2383 mode(chr, Src), 2384 chr_head(Head, Src, H), 2385 chr_body(Body, H, Src). 2386process_chr(==>(Head, Body), Src) :- 2387 mode(chr, Src), 2388 chr_head(Head, H, Src), 2389 chr_body(Body, H, Src). 2390process_chr((:- chr_constraint(_)), Src) :- 2391 ( mode(chr, Src) 2392 -> true 2393 ; assert(mode(chr, Src)) 2394 ). 2395 2396chr_head(X, _, _) :- 2397 var(X), 2398 !. % Illegal. Warn? 2399chr_head(\(A,B), Src, H) :- 2400 chr_head(A, Src, H), 2401 process_body(B, H, Src). 2402chr_head((H0,B), Src, H) :- 2403 chr_defined(H0, Src, H), 2404 process_body(B, H, Src). 2405chr_head(H0, Src, H) :- 2406 chr_defined(H0, Src, H). 2407 2408chr_defined(X, _, _) :- 2409 var(X), 2410 !. 2411chr_defined(#(C,_Id), Src, C) :- 2412 !, 2413 assert_constraint(Src, C). 2414chr_defined(A, Src, A) :- 2415 assert_constraint(Src, A). 2416 2417chr_body(X, From, Src) :- 2418 var(X), 2419 !, 2420 process_body(X, From, Src). 2421chr_body('|'(Guard, Goals), H, Src) :- 2422 !, 2423 chr_body(Guard, H, Src), 2424 chr_body(Goals, H, Src). 2425chr_body(G, From, Src) :- 2426 process_body(G, From, Src). 2427 2428assert_constraint(_, Head) :- 2429 var(Head), 2430 !. 2431assert_constraint(Src, Head) :- 2432 constraint(Head, Src, _), 2433 !. 2434assert_constraint(Src, Head) :- 2435 generalise_term(Head, Term), 2436 current_source_line(Line), 2437 assert(constraint(Term, Src, Line)). 2438 2439 2440 /******************************** 2441 * PHASE 1 ASSERTIONS * 2442 ********************************/
2449assert_called(_, _, Var, _) :- 2450 var(Var), 2451 !. 2452assert_called(Src, From, Goal, Line) :- 2453 var(From), 2454 !, 2455 assert_called(Src, '<unknown>', Goal, Line). 2456assert_called(_, _, Goal, _) :- 2457 expand_hide_called(Goal), 2458 !. 2459assert_called(Src, Origin, M:G, Line) :- 2460 !, 2461 ( atom(M), 2462 callable(G) 2463 -> current_condition(Cond), 2464 ( xmodule(M, Src) % explicit call to own module 2465 -> assert_called(Src, Origin, G, Line) 2466 ; called(M:G, Src, Origin, Cond, Line) % already registered 2467 -> true 2468 ; hide_called(M:G, Src) % not interesting (now) 2469 -> true 2470 ; generalise(Origin, OTerm), 2471 generalise(G, GTerm) 2472 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2473 ; true 2474 ) 2475 ; true % call to variable module 2476 ). 2477assert_called(Src, _, Goal, _) :- 2478 ( xmodule(M, Src) 2479 -> M \== system 2480 ; M = user 2481 ), 2482 hide_called(M:Goal, Src), 2483 !. 2484assert_called(Src, Origin, Goal, Line) :- 2485 current_condition(Cond), 2486 ( called(Goal, Src, Origin, Cond, Line) 2487 -> true 2488 ; generalise(Origin, OTerm), 2489 generalise(Goal, Term) 2490 -> assert(called(Term, Src, OTerm, Cond, Line)) 2491 ; true 2492 ).
2500expand_hide_called(pce_principal:send_implementation(_, _, _)). 2501expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2502expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2503expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2504 2505assert_defined(Src, Goal) :- 2506 Goal = test(_Test), 2507 current_test_unit(Unit, Line), 2508 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2509 fail. 2510assert_defined(Src, Goal) :- 2511 Goal = test(_Test, _Options), 2512 current_test_unit(Unit, Line), 2513 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2514 fail. 2515assert_defined(Src, Goal) :- 2516 defined(Goal, Src, _), 2517 !. 2518assert_defined(Src, Goal) :- 2519 generalise(Goal, Term), 2520 current_source_line(Line), 2521 assert(defined(Term, Src, Line)). 2522 2523assert_foreign(Src, Goal) :- 2524 foreign(Goal, Src, _), 2525 !. 2526assert_foreign(Src, Goal) :- 2527 generalise(Goal, Term), 2528 current_source_line(Line), 2529 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2541assert_import(_, [], _, _, _) :- !. 2542assert_import(Src, [H|T], Export, From, Reexport) :- 2543 !, 2544 assert_import(Src, H, Export, From, Reexport), 2545 assert_import(Src, T, Export, From, Reexport). 2546assert_import(Src, except(Except), Export, From, Reexport) :- 2547 !, 2548 is_list(Export), 2549 !, 2550 except(Except, Export, Import), 2551 assert_import(Src, Import, _All, From, Reexport). 2552assert_import(Src, Import as Name, Export, From, Reexport) :- 2553 !, 2554 pi_to_head(Import, Term0), 2555 rename_goal(Term0, Name, Term), 2556 ( in_export_list(Term0, Export) 2557 -> assert(imported(Term, Src, From)), 2558 assert_reexport(Reexport, Src, Term) 2559 ; current_source_line(Line), 2560 assert_called(Src, '<directive>'(Line), Term0, Line) 2561 ). 2562assert_import(Src, Import, Export, From, Reexport) :- 2563 pi_to_head(Import, Term), 2564 !, 2565 ( in_export_list(Term, Export) 2566 -> assert(imported(Term, Src, From)), 2567 assert_reexport(Reexport, Src, Term) 2568 ; current_source_line(Line), 2569 assert_called(Src, '<directive>'(Line), Term, Line) 2570 ). 2571assert_import(Src, op(P,T,N), _, _, _) :- 2572 xref_push_op(Src, P,T,N). 2573 2574in_export_list(_Head, Export) :- 2575 var(Export), 2576 !. 2577in_export_list(Head, Export) :- 2578 member(PI, Export), 2579 pi_to_head(PI, Head). 2580 2581assert_reexport(false, _, _) :- !. 2582assert_reexport(true, Src, Term) :- 2583 assert(exported(Term, Src)).
2589process_import(M:PI, Src) :- 2590 pi_to_head(PI, Head), 2591 !, 2592 ( atom(M), 2593 current_module(M), 2594 module_property(M, file(From)) 2595 -> true 2596 ; From = '<unknown>' 2597 ), 2598 assert(imported(Head, Src, From)). 2599process_import(_, _).
2608assert_xmodule_callable([], _, _, _). 2609assert_xmodule_callable([PI|T], M, Src, From) :- 2610 ( pi_to_head(M:PI, Head) 2611 -> assert(imported(Head, Src, From)) 2612 ; true 2613 ), 2614 assert_xmodule_callable(T, M, Src, From).
2621assert_op(Src, op(P,T,M:N)) :-
2622 ( '$current_source_module'(M)
2623 -> Name = N
2624 ; Name = M:N
2625 ),
2626 ( xop(Src, op(P,T,Name))
2627 -> true
2628 ; assert(xop(Src, op(P,T,Name)))
2629 ).2636assert_module(Src, Module) :- 2637 xmodule(Module, Src), 2638 !. 2639assert_module(Src, Module) :- 2640 '$set_source_module'(Module), 2641 assert(xmodule(Module, Src)), 2642 ( module_property(Module, class(system)) 2643 -> retractall(xoption(Src, register_called(_))), 2644 assert(xoption(Src, register_called(all))) 2645 ; true 2646 ). 2647 2648assert_module_export(_, []) :- !. 2649assert_module_export(Src, [H|T]) :- 2650 !, 2651 assert_module_export(Src, H), 2652 assert_module_export(Src, T). 2653assert_module_export(Src, PI) :- 2654 pi_to_head(PI, Term), 2655 !, 2656 assert(exported(Term, Src)). 2657assert_module_export(Src, op(P, A, N)) :- 2658 xref_push_op(Src, P, A, N).
2664assert_module3([], _) :- !. 2665assert_module3([H|T], Src) :- 2666 !, 2667 assert_module3(H, Src), 2668 assert_module3(T, Src). 2669assert_module3(Option, Src) :- 2670 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2679process_predicates(Closure, Preds, Src) :- 2680 is_list(Preds), 2681 !, 2682 process_predicate_list(Preds, Closure, Src). 2683process_predicates(Closure, as(Preds, _Options), Src) :- 2684 !, 2685 process_predicates(Closure, Preds, Src). 2686process_predicates(Closure, Preds, Src) :- 2687 process_predicate_comma(Preds, Closure, Src). 2688 2689process_predicate_list([], _, _). 2690process_predicate_list([H|T], Closure, Src) :- 2691 ( nonvar(H) 2692 -> call(Closure, H, Src) 2693 ; true 2694 ), 2695 process_predicate_list(T, Closure, Src). 2696 2697process_predicate_comma(Var, _, _) :- 2698 var(Var), 2699 !. 2700process_predicate_comma(M:(A,B), Closure, Src) :- 2701 !, 2702 process_predicate_comma(M:A, Closure, Src), 2703 process_predicate_comma(M:B, Closure, Src). 2704process_predicate_comma((A,B), Closure, Src) :- 2705 !, 2706 process_predicate_comma(A, Closure, Src), 2707 process_predicate_comma(B, Closure, Src). 2708process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2709 !, 2710 process_predicate_comma(Spec, Closure, Src). 2711process_predicate_comma(A, Closure, Src) :- 2712 call(Closure, A, Src). 2713 2714 2715assert_dynamic(PI, Src) :- 2716 pi_to_head(PI, Term), 2717 ( thread_local(Term, Src, _) % dynamic after thread_local has 2718 -> true % no effect 2719 ; current_source_line(Line), 2720 assert(dynamic(Term, Src, Line)) 2721 ). 2722 2723assert_thread_local(PI, Src) :- 2724 pi_to_head(PI, Term), 2725 current_source_line(Line), 2726 assert(thread_local(Term, Src, Line)). 2727 2728assert_multifile(PI, Src) :- % :- multifile(Spec) 2729 pi_to_head(PI, Term), 2730 current_source_line(Line), 2731 assert(multifile(Term, Src, Line)). 2732 2733assert_public(PI, Src) :- % :- public(Spec) 2734 pi_to_head(PI, Term), 2735 current_source_line(Line), 2736 assert_called(Src, '<public>'(Line), Term, Line), 2737 assert(public(Term, Src, Line)). 2738 2739assert_export(PI, Src) :- % :- export(Spec) 2740 pi_to_head(PI, Term), 2741 !, 2742 assert(exported(Term, Src)).
2749pi_to_head(Var, _) :- 2750 var(Var), !, fail. 2751pi_to_head(M:PI, M:Term) :- 2752 !, 2753 pi_to_head(PI, Term). 2754pi_to_head(Name/Arity, Term) :- 2755 functor(Term, Name, Arity). 2756pi_to_head(Name//DCGArity, Term) :- 2757 Arity is DCGArity+2, 2758 functor(Term, Name, Arity). 2759 2760 2761assert_used_class(Src, Name) :- 2762 used_class(Name, Src), 2763 !. 2764assert_used_class(Src, Name) :- 2765 assert(used_class(Name, Src)). 2766 2767assert_defined_class(Src, Name, _Meta, _Super, _) :- 2768 defined_class(Name, _, _, Src, _), 2769 !. 2770assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2771assert_defined_class(Src, Name, Meta, Super, Summary) :- 2772 current_source_line(Line), 2773 ( Summary == @(default) 2774 -> Atom = '' 2775 ; is_list(Summary) 2776 -> atom_codes(Atom, Summary) 2777 ; string(Summary) 2778 -> atom_concat(Summary, '', Atom) 2779 ), 2780 assert(defined_class(Name, Super, Atom, Src, Line)), 2781 ( Meta = @(_) 2782 -> true 2783 ; assert_used_class(Src, Meta) 2784 ), 2785 assert_used_class(Src, Super). 2786 2787assert_defined_class(Src, Name, imported_from(_File)) :- 2788 defined_class(Name, _, _, Src, _), 2789 !. 2790assert_defined_class(Src, Name, imported_from(File)) :- 2791 assert(defined_class(Name, _, '', Src, file(File))). 2792 2793 2794 /******************************** 2795 * UTILITIES * 2796 ********************************/
2802generalise(Var, Var) :- 2803 var(Var), 2804 !. % error? 2805generalise(pce_principal:send_implementation(Id, _, _), 2806 pce_principal:send_implementation(Id, _, _)) :- 2807 atom(Id), 2808 !. 2809generalise(pce_principal:get_implementation(Id, _, _, _), 2810 pce_principal:get_implementation(Id, _, _, _)) :- 2811 atom(Id), 2812 !. 2813generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2814generalise(test(Test), test(Test)) :- 2815 current_test_unit(_,_), 2816 ground(Test), 2817 !. 2818generalise(test(Test, _), test(Test, _)) :- 2819 current_test_unit(_,_), 2820 ground(Test), 2821 !. 2822generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !. 2823generalise(Module:Goal0, Module:Goal) :- 2824 atom(Module), 2825 !, 2826 generalise(Goal0, Goal). 2827generalise(Term0, Term) :- 2828 callable(Term0), 2829 generalise_term(Term0, Term). 2830 2831 2832 /******************************* 2833 * SOURCE MANAGEMENT * 2834 *******************************/ 2835 2836/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2837This section of the file contains hookable predicates to reason about 2838sources. The built-in code here can only deal with files. The XPCE 2839library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2840can do cross-referencing on PceEmacs edit buffers. Other examples for 2841hooking can be databases, (HTTP) URIs, etc. 2842- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2843 2844:- multifile 2845 prolog:xref_source_directory/2, % +Source, -Dir 2846 prolog:xref_source_file/3. % +Spec, -Path, +Options
2854xref_source_file(Plain, File, Source) :- 2855 xref_source_file(Plain, File, Source, []). 2856 2857xref_source_file(QSpec, File, Source, Options) :- 2858 nonvar(QSpec), QSpec = _:Spec, 2859 !, 2860 must_be(acyclic, Spec), 2861 xref_source_file(Spec, File, Source, Options). 2862xref_source_file(Spec, File, Source, Options) :- 2863 nonvar(Spec), 2864 prolog:xref_source_file(Spec, File, 2865 [ relative_to(Source) 2866 | Options 2867 ]), 2868 !. 2869xref_source_file(Plain, File, Source, Options) :- 2870 atom(Plain), 2871 \+ is_absolute_file_name(Plain), 2872 ( prolog:xref_source_directory(Source, Dir) 2873 -> true 2874 ; atom(Source), 2875 file_directory_name(Source, Dir) 2876 ), 2877 atomic_list_concat([Dir, /, Plain], Spec0), 2878 absolute_file_name(Spec0, Spec), 2879 do_xref_source_file(Spec, File, Options), 2880 !. 2881xref_source_file(Spec, File, Source, Options) :- 2882 do_xref_source_file(Spec, File, 2883 [ relative_to(Source) 2884 | Options 2885 ]), 2886 !. 2887xref_source_file(_, _, _, Options) :- 2888 option(silent(true), Options), 2889 !, 2890 fail. 2891xref_source_file(Spec, _, Src, _Options) :- 2892 verbose(Src), 2893 print_message(warning, error(existence_error(file, Spec), _)), 2894 fail. 2895 2896do_xref_source_file(Spec, File, Options) :- 2897 nonvar(Spec), 2898 option(file_type(Type), Options, prolog), 2899 absolute_file_name(Spec, File, 2900 [ file_type(Type), 2901 access(read), 2902 file_errors(fail) 2903 ]), 2904 !.
2910canonical_source(Source, Src) :-
2911 ( ground(Source)
2912 -> prolog_canonical_source(Source, Src)
2913 ; Source = Src
2914 ).name()
goals.2921goal_name_arity(Goal, Name, Arity) :- 2922 ( compound(Goal) 2923 -> compound_name_arity(Goal, Name, Arity) 2924 ; atom(Goal) 2925 -> Name = Goal, Arity = 0 2926 ). 2927 2928generalise_term(Specific, General) :- 2929 ( compound(Specific) 2930 -> compound_name_arity(Specific, Name, Arity), 2931 compound_name_arity(General, Name, Arity) 2932 ; General = Specific 2933 ). 2934 2935functor_name(Term, Name) :- 2936 ( compound(Term) 2937 -> compound_name_arity(Term, Name, _) 2938 ; atom(Term) 2939 -> Name = Term 2940 ). 2941 2942rename_goal(Goal0, Name, Goal) :- 2943 ( compound(Goal0) 2944 -> compound_name_arity(Goal0, _, Arity), 2945 compound_name_arity(Goal, Name, Arity) 2946 ; Goal = Name 2947 )
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.