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-2025, 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 E = error(_,_), 787 catch(prolog_read_source_term( 788 In, Term, Expanded, 789 [ term_position(TermPos) 790 | CommentOptions 791 ]), 792 E, report_syntax_error(E, Src, [])), 793 update_condition(Term), 794 stream_position_data(line_count, TermPos, Line), 795 setup_call_cleanup( 796 asserta(source_line(SrcSpec), Ref), 797 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 798 E, print_message(error, E)), 799 erase(Ref)), 800 EOF == true, 801 !, 802 set_prolog_flag(xref_store_comments, OldStore). 803 804report_syntax_error(_, _, Options) :- 805 option(silent(true), Options), 806 !, 807 fail. 808report_syntax_error(E, Src, _Options) :- 809 ( verbose(Src) 810 -> print_message(error, E) 811 ; true 812 ), 813 fail.
819update_condition((:-Directive)) :- 820 !, 821 update_cond(Directive). 822update_condition(_). 823 824update_cond(if(Cond)) :- 825 !, 826 asserta(current_cond(Cond)). 827update_cond(else) :- 828 retract(current_cond(C0)), 829 !, 830 assert(current_cond(\+C0)). 831update_cond(elif(Cond)) :- 832 retract(current_cond(C0)), 833 !, 834 assert(current_cond((\+C0,Cond))). 835update_cond(endif) :- 836 retract(current_cond(_)), 837 !. 838update_cond(_).
845current_condition(Condition) :- 846 \+ current_cond(_), 847 !, 848 Condition = true. 849current_condition(Condition) :- 850 findall(C, current_cond(C), List), 851 list_to_conj(List, Condition). 852 853list_to_conj([], true). 854list_to_conj([C], C) :- !. 855list_to_conj([H|T], (H,C)) :- 856 list_to_conj(T, C). 857 858 859 /******************************* 860 * PROCESS * 861 *******************************/
873process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 874 is_list(Expanded), % term_expansion into list. 875 !, 876 ( member(Term, Expanded), 877 process(Term, Term0, Src), 878 Term == end_of_file 879 -> EOF = true 880 ; EOF = false 881 ), 882 xref_comments(Comments, TermPos, Src). 883process(end_of_file, _, _, _, _, true) :- 884 !. 885process(Term, Comments, Term0, TermPos, Src, false) :- 886 process(Term, Term0, Src), 887 xref_comments(Comments, TermPos, Src).
891process(_, Term0, _) :- 892 ignore_raw_term(Term0), 893 !. 894process(Head :- Body, Head0 --> _, Src) :- 895 pi_head(F/A, Head), 896 pi_head(F/A0, Head0), 897 A =:= A0 + 2, 898 !, 899 assert_grammar_rule(Src, Head), 900 process((Head :- Body), Src). 901process(Term, _Term0, Src) :- 902 process(Term, Src). 903 904ignore_raw_term((:- predicate_options(_,_,_))).
908process(Var, _) :- 909 var(Var), 910 !. % Warn? 911process(end_of_file, _) :- !. 912process((:- Directive), Src) :- 913 !, 914 process_directive(Directive, Src), 915 !. 916process((?- Directive), Src) :- 917 !, 918 process_directive(Directive, Src), 919 !. 920process((Head :- Body), Src) :- 921 !, 922 assert_defined(Src, Head), 923 process_body(Body, Head, Src). 924process((Left => Body), Src) :- 925 !, 926 ( nonvar(Left), 927 Left = (Head, Guard) 928 -> assert_defined(Src, Head), 929 process_body(Guard, Head, Src), 930 process_body(Body, Head, Src) 931 ; assert_defined(Src, Left), 932 process_body(Body, Left, Src) 933 ). 934process(?=>(Head, Body), Src) :- 935 !, 936 assert_defined(Src, Head), 937 process_body(Body, Head, Src). 938process('$source_location'(_File, _Line):Clause, Src) :- 939 !, 940 process(Clause, Src). 941process(Term, Src) :- 942 process_chr(Term, Src), 943 !. 944process(M:(Head :- Body), Src) :- 945 !, 946 process((M:Head :- M:Body), Src). 947process(Head, Src) :- 948 assert_defined(Src, Head). 949 950 951 /******************************* 952 * COMMENTS * 953 *******************************/
957xref_comments([], _Pos, _Src). 958:- if(current_predicate(parse_comment/3)). 959xref_comments([Pos-Comment|T], TermPos, Src) :- 960 ( Pos @> TermPos % comments inside term 961 -> true 962 ; stream_position_data(line_count, Pos, Line), 963 FilePos = Src:Line, 964 ( parse_comment(Comment, FilePos, Parsed) 965 -> assert_comments(Parsed, Src) 966 ; true 967 ), 968 xref_comments(T, TermPos, Src) 969 ). 970 971assert_comments([], _). 972assert_comments([H|T], Src) :- 973 assert_comment(H, Src), 974 assert_comments(T, Src). 975 976assert_comment(section(_Id, Title, Comment), Src) :- 977 assertz(module_comment(Src, Title, Comment)). 978assert_comment(predicate(PI, Summary, Comment), Src) :- 979 pi_to_head(PI, Src, Head), 980 assertz(pred_comment(Head, Src, Summary, Comment)). 981assert_comment(link(PI, PITo), Src) :- 982 pi_to_head(PI, Src, Head), 983 pi_to_head(PITo, Src, HeadTo), 984 assertz(pred_comment_link(Head, Src, HeadTo)). 985assert_comment(mode(Head, Det), Src) :- 986 assertz(pred_mode(Head, Src, Det)). 987 988pi_to_head(PI, Src, Head) :- 989 pi_to_head(PI, Head0), 990 ( Head0 = _:_ 991 -> strip_module(Head0, M, Plain), 992 ( xmodule(M, Src) 993 -> Head = Plain 994 ; Head = M:Plain 995 ) 996 ; Head = Head0 997 ). 998:- endif.
1004xref_comment(Source, Title, Comment) :-
1005 canonical_source(Source, Src),
1006 module_comment(Src, Title, Comment).
1012xref_comment(Source, Head, Summary, Comment) :-
1013 canonical_source(Source, Src),
1014 ( pred_comment(Head, Src, Summary, Comment)
1015 ; pred_comment_link(Head, Src, HeadTo),
1016 pred_comment(HeadTo, Src, Summary, Comment)
1017 ).
1024xref_mode(Source, Mode, Det) :-
1025 canonical_source(Source, Src),
1026 pred_mode(Mode, Src, Det).1033xref_option(Source, Option) :- 1034 canonical_source(Source, Src), 1035 xoption(Src, Option). 1036 1037 1038 /******************************** 1039 * DIRECTIVES * 1040 ********************************/ 1041 1042process_directive(Var, _) :- 1043 var(Var), 1044 !. % error, but that isn't our business 1045process_directive(Dir, _Src) :- 1046 debug(xref(directive), 'Processing :- ~q', [Dir]), 1047 fail. 1048process_directive((A,B), Src) :- % TBD: what about other control 1049 !, 1050 process_directive(A, Src), % structures? 1051 process_directive(B, Src). 1052process_directive(List, Src) :- 1053 is_list(List), 1054 !, 1055 process_directive(consult(List), Src). 1056process_directive(use_module(File, Import), Src) :- 1057 process_use_module2(File, Import, Src, false). 1058process_directive(autoload(File, Import), Src) :- 1059 process_use_module2(File, Import, Src, false). 1060process_directive(require(Import), Src) :- 1061 process_requires(Import, Src). 1062process_directive(expects_dialect(Dialect), Src) :- 1063 process_directive(use_module(library(dialect/Dialect)), Src), 1064 expects_dialect(Dialect). 1065process_directive(reexport(File, Import), Src) :- 1066 process_use_module2(File, Import, Src, true). 1067process_directive(reexport(Modules), Src) :- 1068 process_use_module(Modules, Src, true). 1069process_directive(autoload(Modules), Src) :- 1070 process_use_module(Modules, Src, false). 1071process_directive(use_module(Modules), Src) :- 1072 process_use_module(Modules, Src, false). 1073process_directive(consult(Modules), Src) :- 1074 process_use_module(Modules, Src, false). 1075process_directive(ensure_loaded(Modules), Src) :- 1076 process_use_module(Modules, Src, false). 1077process_directive(load_files(Files, _Options), Src) :- 1078 process_use_module(Files, Src, false). 1079process_directive(include(Files), Src) :- 1080 process_include(Files, Src). 1081process_directive(dynamic(Dynamic), Src) :- 1082 process_predicates(assert_dynamic, Dynamic, Src). 1083process_directive(dynamic(Dynamic, _Options), Src) :- 1084 process_predicates(assert_dynamic, Dynamic, Src). 1085process_directive(thread_local(Dynamic), Src) :- 1086 process_predicates(assert_thread_local, Dynamic, Src). 1087process_directive(multifile(Dynamic), Src) :- 1088 process_predicates(assert_multifile, Dynamic, Src). 1089process_directive(public(Public), Src) :- 1090 process_predicates(assert_public, Public, Src). 1091process_directive(export(Export), Src) :- 1092 process_predicates(assert_export, Export, Src). 1093process_directive(import(Import), Src) :- 1094 process_import(Import, Src). 1095process_directive(module(Module, Export), Src) :- 1096 assert_module(Src, Module), 1097 assert_module_export(Src, Export). 1098process_directive(module(Module, Export, Import), Src) :- 1099 assert_module(Src, Module), 1100 assert_module_export(Src, Export), 1101 assert_module3(Import, Src). 1102process_directive(begin_tests(Unit, _Options), Src) :- 1103 enter_test_unit(Unit, Src). 1104process_directive(begin_tests(Unit), Src) :- 1105 enter_test_unit(Unit, Src). 1106process_directive(end_tests(Unit), Src) :- 1107 leave_test_unit(Unit, Src). 1108process_directive('$set_source_module'(system), Src) :- 1109 assert_module(Src, system). % hack for handling boot/init.pl 1110process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1111 assert_defined_class(Src, Name, Meta, Super, Doc). 1112process_directive(pce_autoload(Name, From), Src) :- 1113 assert_defined_class(Src, Name, imported_from(From)). 1114 1115process_directive(op(P, A, N), Src) :- 1116 xref_push_op(Src, P, A, N). 1117process_directive(set_prolog_flag(Flag, Value), Src) :- 1118 ( Flag == character_escapes 1119 -> set_prolog_flag(character_escapes, Value) 1120 ; true 1121 ), 1122 current_source_line(Line), 1123 xref_set_prolog_flag(Flag, Value, Src, Line). 1124process_directive(style_check(X), _) :- 1125 style_check(X). 1126process_directive(encoding(Enc), _) :- 1127 ( xref_input_stream(Stream) 1128 -> catch(set_stream(Stream, encoding(Enc)), error(_,_), true) 1129 ; true % can this happen? 1130 ). 1131process_directive(pce_expansion:push_compile_operators, _) :- 1132 '$current_source_module'(SM), 1133 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1134process_directive(pce_expansion:pop_compile_operators, _) :- 1135 call(pce_expansion:pop_compile_operators). 1136process_directive(meta_predicate(Meta), Src) :- 1137 process_meta_predicate(Meta, Src). 1138process_directive(arithmetic_function(FSpec), Src) :- 1139 arith_callable(FSpec, Goal), 1140 !, 1141 current_source_line(Line), 1142 assert_called(Src, '<directive>'(Line), Goal, Line). 1143process_directive(format_predicate(_, Goal), Src) :- 1144 !, 1145 current_source_line(Line), 1146 assert_called(Src, '<directive>'(Line), Goal, Line). 1147process_directive(if(Cond), Src) :- 1148 !, 1149 current_source_line(Line), 1150 assert_called(Src, '<directive>'(Line), Cond, Line). 1151process_directive(elif(Cond), Src) :- 1152 !, 1153 current_source_line(Line), 1154 assert_called(Src, '<directive>'(Line), Cond, Line). 1155process_directive(else, _) :- !. 1156process_directive(endif, _) :- !. 1157process_directive(Goal, Src) :- 1158 current_source_line(Line), 1159 process_body(Goal, '<directive>'(Line), Src).
1165process_meta_predicate((A,B), Src) :- 1166 !, 1167 process_meta_predicate(A, Src), 1168 process_meta_predicate(B, Src). 1169process_meta_predicate(Decl, Src) :- 1170 process_meta_head(Src, Decl). 1171 1172process_meta_head(Src, Decl) :- % swapped arguments for maplist 1173 compound(Decl), 1174 compound_name_arity(Decl, Name, Arity), 1175 compound_name_arity(Head, Name, Arity), 1176 meta_args(1, Arity, Decl, Head, Meta), 1177 ( ( prolog:meta_goal(Head, _) 1178 ; prolog:called_by(Head, _, _, _) 1179 ; prolog:called_by(Head, _) 1180 ; meta_goal(Head, _) 1181 ) 1182 -> true 1183 ; assert(meta_goal(Head, Meta, Src)) 1184 ). 1185 1186meta_args(I, Arity, _, _, []) :- 1187 I > Arity, 1188 !. 1189meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1190 arg(I, Decl, 0), 1191 !, 1192 arg(I, Head, H), 1193 I2 is I + 1, 1194 meta_args(I2, Arity, Decl, Head, T). 1195meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1196 arg(I, Decl, ^), 1197 !, 1198 arg(I, Head, EH), 1199 setof_goal(EH, H), 1200 I2 is I + 1, 1201 meta_args(I2, Arity, Decl, Head, T). 1202meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1203 arg(I, Decl, //), 1204 !, 1205 arg(I, Head, H), 1206 I2 is I + 1, 1207 meta_args(I2, Arity, Decl, Head, T). 1208meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1209 arg(I, Decl, A), 1210 integer(A), A > 0, 1211 !, 1212 arg(I, Head, H), 1213 I2 is I + 1, 1214 meta_args(I2, Arity, Decl, Head, T). 1215meta_args(I, Arity, Decl, Head, Meta) :- 1216 I2 is I + 1, 1217 meta_args(I2, Arity, Decl, Head, Meta). 1218 1219 1220 /******************************** 1221 * BODY * 1222 ********************************/
1231xref_meta(Source, Head, Called) :-
1232 canonical_source(Source, Src),
1233 xref_meta_src(Head, Called, Src).1248xref_meta_src(Head, Called, Src) :- 1249 meta_goal(Head, Called, Src), 1250 !. 1251xref_meta_src(Head, Called, _) :- 1252 xref_meta(Head, Called), 1253 !. 1254xref_meta_src(Head, Called, _) :- 1255 compound(Head), 1256 compound_name_arity(Head, Name, Arity), 1257 apply_pred(Name), 1258 Arity > 5, 1259 !, 1260 Extra is Arity - 1, 1261 arg(1, Head, G), 1262 Called = [G+Extra]. 1263xref_meta_src(Head, Called, _) :- 1264 with_xref(predicate_property('$xref_tmp':Head, meta_predicate(Meta))), 1265 !, 1266 Meta =.. [_|Args], 1267 meta_args(Args, 1, Head, Called). 1268 1269meta_args([], _, _, []). 1270meta_args([H0|T0], I, Head, [H|T]) :- 1271 xargs(H0, N), 1272 !, 1273 arg(I, Head, A), 1274 ( N == 0 1275 -> H = A 1276 ; H = (A+N) 1277 ), 1278 I2 is I+1, 1279 meta_args(T0, I2, Head, T). 1280meta_args([_|T0], I, Head, T) :- 1281 I2 is I+1, 1282 meta_args(T0, I2, Head, T). 1283 1284xargs(N, N) :- integer(N), !. 1285xargs(//, 2). 1286xargs(^, 0). 1287 1288apply_pred(call). % built-in 1289apply_pred(maplist). % library(apply_macros) 1290 1291xref_meta((A, B), [A, B]). 1292xref_meta((A; B), [A, B]). 1293xref_meta((A| B), [A, B]). 1294xref_meta((A -> B), [A, B]). 1295xref_meta((A *-> B), [A, B]). 1296xref_meta(findall(_V,G,_L), [G]). 1297xref_meta(findall(_V,G,_L,_T), [G]). 1298xref_meta(findnsols(_N,_V,G,_L), [G]). 1299xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1300xref_meta(setof(_V, EG, _L), [G]) :- 1301 setof_goal(EG, G). 1302xref_meta(bagof(_V, EG, _L), [G]) :- 1303 setof_goal(EG, G). 1304xref_meta(forall(A, B), [A, B]). 1305xref_meta(maplist(G,_), [G+1]). 1306xref_meta(maplist(G,_,_), [G+2]). 1307xref_meta(maplist(G,_,_,_), [G+3]). 1308xref_meta(maplist(G,_,_,_,_), [G+4]). 1309xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1310xref_meta(map_assoc(G, _), [G+1]). 1311xref_meta(map_assoc(G, _, _), [G+2]). 1312xref_meta(checklist(G, _L), [G+1]). 1313xref_meta(sublist(G, _, _), [G+1]). 1314xref_meta(include(G, _, _), [G+1]). 1315xref_meta(exclude(G, _, _), [G+1]). 1316xref_meta(partition(G, _, _, _, _), [G+2]). 1317xref_meta(partition(G, _, _, _),[G+1]). 1318xref_meta(call(G), [G]). 1319xref_meta(call(G, _), [G+1]). 1320xref_meta(call(G, _, _), [G+2]). 1321xref_meta(call(G, _, _, _), [G+3]). 1322xref_meta(call(G, _, _, _, _), [G+4]). 1323xref_meta(not(G), [G]). 1324xref_meta(notrace(G), [G]). 1325xref_meta('$notrace'(G), [G]). 1326xref_meta(\+(G), [G]). 1327xref_meta(ignore(G), [G]). 1328xref_meta(once(G), [G]). 1329xref_meta(initialization(G), [G]). 1330xref_meta(initialization(G,_), [G]). 1331xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1332xref_meta(clause(G, _), [G]). 1333xref_meta(clause(G, _, _), [G]). 1334xref_meta(phrase(G, _A), [//(G)]). 1335xref_meta(phrase(G, _A, _R), [//(G)]). 1336xref_meta(call_dcg(G, _A, _R), [//(G)]). 1337xref_meta(phrase_from_file(G,_),[//(G)]). 1338xref_meta(catch(A, _, B), [A, B]). 1339xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1340xref_meta(thread_create(A,_,_), [A]). 1341xref_meta(thread_create(A,_), [A]). 1342xref_meta(thread_signal(_,A), [A]). 1343xref_meta(thread_idle(A,_), [A]). 1344xref_meta(thread_at_exit(A), [A]). 1345xref_meta(thread_initialization(A), [A]). 1346xref_meta(engine_create(_,A,_), [A]). 1347xref_meta(engine_create(_,A,_,_), [A]). 1348xref_meta(transaction(A), [A]). 1349xref_meta(transaction(A,B,_), [A,B]). 1350xref_meta(snapshot(A), [A]). 1351xref_meta(predsort(A,_,_), [A+3]). 1352xref_meta(call_cleanup(A, B), [A, B]). 1353xref_meta(call_cleanup(A, _, B),[A, B]). 1354xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1355xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1356xref_meta(call_residue_vars(A,_), [A]). 1357xref_meta(with_mutex(_,A), [A]). 1358xref_meta(assume(G), [G]). % library(debug) 1359xref_meta(assertion(G), [G]). % library(debug) 1360xref_meta(freeze(_, G), [G]). 1361xref_meta(when(C, A), [C, A]). 1362xref_meta(time(G), [G]). % development system 1363xref_meta(call_time(G, _), [G]). % development system 1364xref_meta(call_time(G, _, _), [G]). % development system 1365xref_meta(profile(G), [G]). 1366xref_meta(at_halt(G), [G]). 1367xref_meta(call_with_time_limit(_, G), [G]). 1368xref_meta(call_with_depth_limit(G, _, _), [G]). 1369xref_meta(call_with_inference_limit(G, _, _), [G]). 1370xref_meta(alarm(_, G, _), [G]). 1371xref_meta(alarm(_, G, _, _), [G]). 1372xref_meta('$add_directive_wic'(G), [G]). 1373xref_meta(with_output_to(_, G), [G]). 1374xref_meta(if(G), [G]). 1375xref_meta(elif(G), [G]). 1376xref_meta(meta_options(G,_,_), [G+1]). 1377xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1378xref_meta(distinct(G), [G]). % library(solution_sequences) 1379xref_meta(distinct(_, G), [G]). 1380xref_meta(order_by(_, G), [G]). 1381xref_meta(limit(_, G), [G]). 1382xref_meta(offset(_, G), [G]). 1383xref_meta(reset(G,_,_), [G]). 1384xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1385xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1386xref_meta(tnot(G), [G]). 1387xref_meta(not_exists(G), [G]). 1388xref_meta(with_tty_raw(G), [G]). 1389xref_meta(residual_goals(G), [G+2]). 1390 1391 % XPCE meta-predicates 1392xref_meta(pce_global(_, new(_)), _) :- !, fail. 1393xref_meta(pce_global(_, B), [B+1]). 1394xref_meta(ifmaintainer(G), [G]). % used in manual 1395xref_meta(listen(_, G), [G]). % library(broadcast) 1396xref_meta(listen(_, _, G), [G]). 1397xref_meta(in_pce_thread(G), [G]). 1398 1399xref_meta(G, Meta) :- % call user extensions 1400 prolog:meta_goal(G, Meta). 1401xref_meta(G, Meta) :- % Generated from :- meta_predicate 1402 meta_goal(G, Meta). 1403 1404setof_goal(EG, G) :- 1405 var(EG), !, G = EG. 1406setof_goal(_^EG, G) :- 1407 !, 1408 setof_goal(EG, G). 1409setof_goal(G, G). 1410 1411event_xargs(abort, 0). 1412event_xargs(erase, 1). 1413event_xargs(break, 3). 1414event_xargs(frame_finished, 1). 1415event_xargs(thread_exit, 1). 1416event_xargs(this_thread_exit, 0). 1417event_xargs(PI, 2) :- pi_to_head(PI, _).
1423head_of(Var, _) :- 1424 var(Var), !, fail. 1425head_of((Head :- _), Head). 1426head_of(Head, Head).
1434xref_hook(Hook) :- 1435 prolog:hook(Hook). 1436xref_hook(Hook) :- 1437 hook(Hook). 1438 1439 1440hook(attr_portray_hook(_,_)). 1441hook(attr_unify_hook(_,_)). 1442hook(attribute_goals(_,_,_)). 1443hook(goal_expansion(_,_)). 1444hook(term_expansion(_,_)). 1445hook(resource(_,_,_)). 1446hook('$pred_option'(_,_,_,_)). 1447 1448hook(emacs_prolog_colours:goal_classification(_,_)). 1449hook(emacs_prolog_colours:goal_colours(_,_)). 1450hook(emacs_prolog_colours:identify(_,_)). 1451hook(emacs_prolog_colours:style(_,_)). 1452hook(emacs_prolog_colours:term_colours(_,_)). 1453hook(pce_principal:get_implementation(_,_,_,_)). 1454hook(pce_principal:pce_class(_,_,_,_,_,_)). 1455hook(pce_principal:pce_lazy_get_method(_,_,_)). 1456hook(pce_principal:pce_lazy_send_method(_,_,_)). 1457hook(pce_principal:pce_uses_template(_,_)). 1458hook(pce_principal:send_implementation(_,_,_)). 1459hook(predicate_options:option_decl(_,_,_)). 1460hook(prolog:debug_control_hook(_)). 1461hook(prolog:error_message(_,_,_)). 1462hook(prolog:expand_answer(_,_,_)). 1463hook(prolog:general_exception(_,_)). 1464hook(prolog:help_hook(_)). 1465hook(prolog:locate_clauses(_,_)). 1466hook(prolog:message(_,_,_)). 1467hook(prolog:message_context(_,_,_)). 1468hook(prolog:message_line_element(_,_)). 1469hook(prolog:message_location(_,_,_)). 1470hook(prolog:predicate_summary(_,_)). 1471hook(prolog:prolog_exception_hook(_,_,_,_,_)). 1472hook(prolog:residual_goals(_,_)). 1473hook(prolog:show_profile_hook(_,_)). 1474hook(prolog_edit:load). 1475hook(prolog_edit:locate(_,_,_)). 1476hook(sandbox:safe_directive(_)). 1477hook(sandbox:safe_global_variable(_)). 1478hook(sandbox:safe_meta(_,_)). 1479hook(sandbox:safe_meta_predicate(_)). 1480hook(sandbox:safe_primitive(_)). 1481hook(sandbox:safe_prolog_flag(_,_)). 1482hook(shlib:unload_all_foreign_libraries). 1483hook(system:'$foreign_registered'(_, _)). 1484hook(user:exception(_,_,_)). 1485hook(user:expand_answer(_,_)). 1486hook(user:expand_query(_,_,_,_)). 1487hook(user:file_search_path(_,_)). 1488hook(user:library_directory(_)). 1489hook(user:message_hook(_,_,_)). 1490hook(user:portray(_)). 1491hook(user:prolog_clause_name(_,_)). 1492hook(user:prolog_list_goal(_)). 1493hook(user:prolog_predicate_name(_,_)). 1494hook(user:prolog_trace_interception(_,_,_,_)).
1500arith_callable(Var, _) :- 1501 var(Var), !, fail. 1502arith_callable(Module:Spec, Module:Goal) :- 1503 !, 1504 arith_callable(Spec, Goal). 1505arith_callable(Name/Arity, Goal) :- 1506 PredArity is Arity + 1, 1507 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1518process_body(Body, Origin, Src) :-
1519 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1520 true).true if there was a
partial evalation inside Goal that has bound variables.1527process_goal(Var, _, _, _) :- 1528 var(Var), 1529 !. 1530process_goal(_:Goal, _, _, _) :- 1531 var(Goal), 1532 !. 1533process_goal(Goal, Origin, Src, P) :- 1534 Goal = (_,_), % problems 1535 !, 1536 phrase(conjunction(Goal), Goals), 1537 process_conjunction(Goals, Origin, Src, P). 1538process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1539 Goal = (_;_), % problems 1540 !, 1541 phrase(disjunction(Goal), Goals), 1542 forall(member(G, Goals), 1543 process_body(G, Origin, Src)). 1544process_goal(Goal, Origin, Src, P) :- 1545 ( ( xmodule(M, Src) 1546 -> true 1547 ; M = user 1548 ), 1549 pi_head(PI, M:Goal), 1550 ( current_predicate(PI), 1551 predicate_property(M:Goal, imported_from(IM)) 1552 -> true 1553 ; PI = M:Name/Arity, 1554 '$find_library'(M, Name, Arity, IM, _Library) 1555 -> true 1556 ; IM = M 1557 ), 1558 prolog:called_by(Goal, IM, M, Called) 1559 ; prolog:called_by(Goal, Called) 1560 ), 1561 !, 1562 must_be(list, Called), 1563 current_source_line(Here), 1564 assert_called(Src, Origin, Goal, Here), 1565 process_called_list(Called, Origin, Src, P). 1566process_goal(Goal, Origin, Src, _) :- 1567 process_xpce_goal(Goal, Origin, Src), 1568 !. 1569process_goal(load_foreign_library(File), _Origin, Src, _) :- 1570 process_foreign(File, Src). 1571process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1572 process_foreign(File, Src). 1573process_goal(use_foreign_library(File), _Origin, Src, _) :- 1574 process_foreign(File, Src). 1575process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1576 process_foreign(File, Src). 1577process_goal(Goal, Origin, Src, P) :- 1578 xref_meta_src(Goal, Metas, Src), 1579 !, 1580 current_source_line(Here), 1581 assert_called(Src, Origin, Goal, Here), 1582 process_called_list(Metas, Origin, Src, P). 1583process_goal(Goal, Origin, Src, _) :- 1584 asserting_goal(Goal, Rule), 1585 !, 1586 current_source_line(Here), 1587 assert_called(Src, Origin, Goal, Here), 1588 process_assert(Rule, Origin, Src). 1589process_goal(Goal, Origin, Src, P) :- 1590 partial_evaluate(Goal, P), 1591 current_source_line(Here), 1592 assert_called(Src, Origin, Goal, Here). 1593 1594disjunction(Var) --> {var(Var), !}, [Var]. 1595disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1596disjunction(G) --> [G]. 1597 1598conjunction(Var) --> {var(Var), !}, [Var]. 1599conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1600conjunction(G) --> [G]. 1601 (RVars, T) :- 1603 term_variables(T, TVars0), 1604 sort(TVars0, TVars), 1605 ord_intersect(RVars, TVars). 1606 1607process_conjunction([], _, _, _). 1608process_conjunction([Disj|Rest], Origin, Src, P) :- 1609 nonvar(Disj), 1610 Disj = (_;_), 1611 Rest \== [], 1612 !, 1613 phrase(disjunction(Disj), Goals), 1614 term_variables(Rest, RVars0), 1615 sort(RVars0, RVars), 1616 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1617 forall(member(G, NonSHaring), 1618 process_body(G, Origin, Src)), 1619 ( Sharing == [] 1620 -> true 1621 ; maplist(term_variables, Sharing, GVars0), 1622 append(GVars0, GVars1), 1623 sort(GVars1, GVars), 1624 ord_intersection(GVars, RVars, SVars), 1625 VT =.. [v|SVars], 1626 findall(VT, 1627 ( member(G, Sharing), 1628 process_goal(G, Origin, Src, PS), 1629 PS == true 1630 ), 1631 Alts0), 1632 ( Alts0 == [] 1633 -> true 1634 ; ( true 1635 ; P = true, 1636 sort(Alts0, Alts1), 1637 variants(Alts1, 10, Alts), 1638 member(VT, Alts) 1639 ) 1640 ) 1641 ), 1642 process_conjunction(Rest, Origin, Src, P). 1643process_conjunction([H|T], Origin, Src, P) :- 1644 process_goal(H, Origin, Src, P), 1645 process_conjunction(T, Origin, Src, P). 1646 1647 1648process_called_list([], _, _, _). 1649process_called_list([H|T], Origin, Src, P) :- 1650 process_meta(H, Origin, Src, P), 1651 process_called_list(T, Origin, Src, P). 1652 1653process_meta(A+N, Origin, Src, P) :- 1654 !, 1655 ( extend(A, N, AX) 1656 -> process_goal(AX, Origin, Src, P) 1657 ; true 1658 ). 1659process_meta(//(A), Origin, Src, P) :- 1660 !, 1661 process_dcg_goal(A, Origin, Src, P). 1662process_meta(G, Origin, Src, P) :- 1663 process_goal(G, Origin, Src, P).
1670process_dcg_goal(Var, _, _, _) :- 1671 var(Var), 1672 !. 1673process_dcg_goal((A,B), Origin, Src, P) :- 1674 !, 1675 process_dcg_goal(A, Origin, Src, P), 1676 process_dcg_goal(B, Origin, Src, P). 1677process_dcg_goal((A;B), Origin, Src, P) :- 1678 !, 1679 process_dcg_goal(A, Origin, Src, P), 1680 process_dcg_goal(B, Origin, Src, P). 1681process_dcg_goal((A|B), Origin, Src, P) :- 1682 !, 1683 process_dcg_goal(A, Origin, Src, P), 1684 process_dcg_goal(B, Origin, Src, P). 1685process_dcg_goal((A->B), Origin, Src, P) :- 1686 !, 1687 process_dcg_goal(A, Origin, Src, P), 1688 process_dcg_goal(B, Origin, Src, P). 1689process_dcg_goal((A*->B), Origin, Src, P) :- 1690 !, 1691 process_dcg_goal(A, Origin, Src, P), 1692 process_dcg_goal(B, Origin, Src, P). 1693process_dcg_goal({Goal}, Origin, Src, P) :- 1694 !, 1695 process_goal(Goal, Origin, Src, P). 1696process_dcg_goal(List, _Origin, _Src, _) :- 1697 is_list(List), 1698 !. % terminal 1699process_dcg_goal(List, _Origin, _Src, _) :- 1700 string(List), 1701 !. % terminal 1702process_dcg_goal(Callable, Origin, Src, P) :- 1703 extend(Callable, 2, Goal), 1704 !, 1705 process_goal(Goal, Origin, Src, P). 1706process_dcg_goal(_, _, _, _). 1707 1708 1709extend(Var, _, _) :- 1710 var(Var), !, fail. 1711extend(M:G, N, M:GX) :- 1712 !, 1713 callable(G), 1714 extend(G, N, GX). 1715extend(G, N, GX) :- 1716 ( compound(G) 1717 -> compound_name_arguments(G, Name, Args), 1718 length(Rest, N), 1719 append(Args, Rest, NArgs), 1720 compound_name_arguments(GX, Name, NArgs) 1721 ; atom(G) 1722 -> length(NArgs, N), 1723 compound_name_arguments(GX, G, NArgs) 1724 ). 1725 1726asserting_goal(assert(Rule), Rule). 1727asserting_goal(asserta(Rule), Rule). 1728asserting_goal(assertz(Rule), Rule). 1729asserting_goal(assert(Rule,_), Rule). 1730asserting_goal(asserta(Rule,_), Rule). 1731asserting_goal(assertz(Rule,_), Rule). 1732 1733process_assert(0, _, _) :- !. % catch variables 1734process_assert((_:-Body), Origin, Src) :- 1735 !, 1736 process_body(Body, Origin, Src). 1737process_assert(_, _, _).
1741variants([], _, []). 1742variants([H|T], Max, List) :- 1743 variants(T, H, Max, List). 1744 1745variants([], H, _, [H]). 1746variants(_, _, 0, []) :- !. 1747variants([H|T], V, Max, List) :- 1748 ( H =@= V 1749 -> variants(T, V, Max, List) 1750 ; List = [V|List2], 1751 Max1 is Max-1, 1752 variants(T, H, Max1, List2) 1753 ).
T = hello(X),
findall(T, T, List),
1767partial_evaluate(Goal, P) :- 1768 eval(Goal), 1769 !, 1770 P = true. 1771partial_evaluate(_, _). 1772 1773eval(X = Y) :- 1774 unify_with_occurs_check(X, Y). 1775 1776 /******************************* 1777 * PLUNIT SUPPORT * 1778 *******************************/ 1779 1780enter_test_unit(Unit, _Src) :- 1781 current_source_line(Line), 1782 asserta(current_test_unit(Unit, Line)). 1783 1784leave_test_unit(Unit, _Src) :- 1785 retractall(current_test_unit(Unit, _)). 1786 1787 1788 /******************************* 1789 * XPCE STUFF * 1790 *******************************/ 1791 1792pce_goal(new(_,_), new(-, new)). 1793pce_goal(send(_,_), send(arg, msg)). 1794pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1795pce_goal(get(_,_,_), get(arg, msg, -)). 1796pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1797pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1798pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1799 1800process_xpce_goal(G, Origin, Src) :- 1801 pce_goal(G, Process), 1802 !, 1803 current_source_line(Here), 1804 assert_called(Src, Origin, G, Here), 1805 ( arg(I, Process, How), 1806 arg(I, G, Term), 1807 process_xpce_arg(How, Term, Origin, Src), 1808 fail 1809 ; true 1810 ). 1811 1812process_xpce_arg(new, Term, Origin, Src) :- 1813 callable(Term), 1814 process_new(Term, Origin, Src). 1815process_xpce_arg(arg, Term, Origin, Src) :- 1816 compound(Term), 1817 process_new(Term, Origin, Src). 1818process_xpce_arg(msg, Term, Origin, Src) :- 1819 compound(Term), 1820 ( arg(_, Term, Arg), 1821 process_xpce_arg(arg, Arg, Origin, Src), 1822 fail 1823 ; true 1824 ). 1825 1826process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1827process_new(Term, Origin, Src) :- 1828 assert_new(Src, Origin, Term), 1829 ( compound(Term), 1830 arg(_, Term, Arg), 1831 process_xpce_arg(arg, Arg, Origin, Src), 1832 fail 1833 ; true 1834 ). 1835 1836assert_new(_, _, Term) :- 1837 \+ callable(Term), 1838 !. 1839assert_new(Src, Origin, Control) :- 1840 functor_name(Control, Class), 1841 pce_control_class(Class), 1842 !, 1843 forall(arg(_, Control, Arg), 1844 assert_new(Src, Origin, Arg)). 1845assert_new(Src, Origin, Term) :- 1846 compound(Term), 1847 arg(1, Term, Prolog), 1848 Prolog == @(prolog), 1849 ( Term =.. [message, _, Selector | T], 1850 atom(Selector) 1851 -> Called =.. [Selector|T], 1852 process_body(Called, Origin, Src) 1853 ; Term =.. [?, _, Selector | T], 1854 atom(Selector) 1855 -> append(T, [_R], T2), 1856 Called =.. [Selector|T2], 1857 process_body(Called, Origin, Src) 1858 ), 1859 fail. 1860assert_new(_, _, @(_)) :- !. 1861assert_new(Src, _, Term) :- 1862 functor_name(Term, Name), 1863 assert_used_class(Src, Name). 1864 1865 1866pce_control_class(and). 1867pce_control_class(or). 1868pce_control_class(if). 1869pce_control_class(not). 1870 1871 1872 /******************************** 1873 * INCLUDED MODULES * 1874 ********************************/
1878process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1879process_use_module([], _, _) :- !. 1880process_use_module([H|T], Src, Reexport) :- 1881 !, 1882 process_use_module(H, Src, Reexport), 1883 process_use_module(T, Src, Reexport). 1884process_use_module(library(pce), Src, Reexport) :- % bit special 1885 !, 1886 xref_public_list(library(pce), Path, Exports, Src), 1887 forall(member(Import, Exports), 1888 process_pce_import(Import, Src, Path, Reexport)). 1889process_use_module(File, Src, Reexport) :- 1890 load_module_if_needed(File), 1891 ( xoption(Src, silent(Silent)) 1892 -> Extra = [silent(Silent)] 1893 ; Extra = [silent(true)] 1894 ), 1895 ( xref_public_list(File, Src, 1896 [ path(Path), 1897 module(M), 1898 exports(Exports), 1899 public(Public), 1900 meta(Meta) 1901 | Extra 1902 ]) 1903 -> assert(uses_file(File, Src, Path)), 1904 assert_import(Src, Exports, _, Path, Reexport), 1905 assert_xmodule_callable(Exports, M, Src, Path), 1906 assert_xmodule_callable(Public, M, Src, Path), 1907 maplist(process_meta_head(Src), Meta), 1908 ( File = library(chr) % hacky 1909 -> assert(mode(chr, Src)) 1910 ; true 1911 ) 1912 ; assert(uses_file(File, Src, '<not_found>')) 1913 ). 1914 1915process_pce_import(Name/Arity, Src, Path, Reexport) :- 1916 atom(Name), 1917 integer(Arity), 1918 !, 1919 functor(Term, Name, Arity), 1920 ( \+ system_predicate(Term), 1921 \+ Term = pce_error(_) % hack!? 1922 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1923 ; true 1924 ). 1925process_pce_import(op(P,T,N), Src, _, _) :- 1926 xref_push_op(Src, P, T, N).
1932process_use_module2(File, Import, Src, Reexport) :-
1933 load_module_if_needed(File),
1934 ( xref_source_file(File, Path, Src)
1935 -> assert(uses_file(File, Src, Path)),
1936 ( catch(public_list(Path, _Source, _Module, Meta, Export, _Public, []),
1937 error(_,_), fail)
1938 -> assert_import(Src, Import, Export, Path, Reexport),
1939 forall(( member(Head, Meta),
1940 imported(Head, _, Path)
1941 ),
1942 process_meta_head(Src, Head))
1943 ; true
1944 )
1945 ; assert(uses_file(File, Src, '<not_found>'))
1946 ).1955load_module_if_needed(File) :- 1956 prolog:no_autoload_module(File), 1957 !, 1958 use_module(File, []). 1959load_module_if_needed(_). 1960 1961prologno_autoload_module(library(apply_macros)). 1962prologno_autoload_module(library(arithmetic)). 1963prologno_autoload_module(library(record)). 1964prologno_autoload_module(library(persistency)). 1965prologno_autoload_module(library(pldoc)). 1966prologno_autoload_module(library(settings)). 1967prologno_autoload_module(library(debug)). 1968prologno_autoload_module(library(plunit)). 1969prologno_autoload_module(library(macros)). 1970prologno_autoload_module(library(yall)).
1975process_requires(Import, Src) :- 1976 is_list(Import), 1977 !, 1978 require_list(Import, Src). 1979process_requires(Var, _Src) :- 1980 var(Var), 1981 !. 1982process_requires((A,B), Src) :- 1983 !, 1984 process_requires(A, Src), 1985 process_requires(B, Src). 1986process_requires(PI, Src) :- 1987 requires(PI, Src). 1988 1989require_list([], _). 1990require_list([H|T], Src) :- 1991 requires(H, Src), 1992 require_list(T, Src). 1993 1994requires(PI, _Src) :- 1995 '$pi_head'(PI, Head), 1996 '$get_predicate_attribute'(system:Head, defined, 1), 1997 !. 1998requires(PI, Src) :- 1999 '$pi_head'(PI, Head), 2000 '$pi_head'(Name/Arity, Head), 2001 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 2002 ( imported(Head, Src, Library) 2003 -> true 2004 ; assertz(imported(Head, Src, Library)) 2005 ).
[] for
.qlf files.[] for .qlf files.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.
2041xref_public_list(File, Src, Options) :-
2042 option(path(Source), Options, _),
2043 option(module(Module), Options, _),
2044 option(exports(Exports), Options, _),
2045 option(public(Public), Options, _),
2046 option(meta(Meta), Options, _),
2047 xref_source_file(File, Path, Src, Options),
2048 public_list(Path, Source, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
2070xref_public_list(File, Source, Export, Src) :- 2071 xref_source_file(File, Path, Src), 2072 public_list(Path, Source, _, _, Export, _, []). 2073xref_public_list(File, Source, Module, Export, Meta, Src) :- 2074 xref_source_file(File, Path, Src), 2075 public_list(Path, Source, Module, Meta, Export, _, []). 2076xref_public_list(File, Source, Module, Export, Public, Meta, Src) :- 2077 xref_source_file(File, Path, Src), 2078 public_list(Path, Source, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2089:- dynamic public_list_cache/7. 2090:- volatile public_list_cache/7. 2091 2092public_list(Path, Source, Module, Meta, Export, Public, _Options) :- 2093 public_list_cache(Path, Source, Modified, 2094 Module0, Meta0, Export0, Public0), 2095 time_file(Path, ModifiedNow), 2096 ( abs(Modified-ModifiedNow) < 0.0001 2097 -> !, 2098 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2099 ; retractall(public_list_cache(Path, _, _, _, _, _, _)), 2100 fail 2101 ). 2102public_list(Path, Source, Module, Meta, Export, Public, Options) :- 2103 public_list_nc(Path, Source, Module0, Meta0, Export0, Public0, Options), 2104 ( Error = error(_,_), 2105 catch(time_file(Path, Modified), Error, fail) 2106 -> asserta(public_list_cache(Path, Source, Modified, 2107 Module0, Meta0, Export0, Public0)) 2108 ; true 2109 ), 2110 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2111 2112public_list_nc(Path, Source, Module, [], Export, [], _Options) :- 2113 file_name_extension(_, qlf, Path), 2114 !, 2115 '$qlf_module'(Path, Info), 2116 _{module:Module, exports:Export, file:Source} :< Info. 2117public_list_nc(Path, Path, Module, Meta, Export, Public, Options) :- 2118 in_temporary_module( 2119 TempModule, 2120 true, 2121 public_list_diff(TempModule, Path, Module, 2122 Meta, [], Export, [], Public, [], Options)). 2123 2124 2125public_list_diff(TempModule, 2126 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2127 setup_call_cleanup( 2128 public_list_setup(TempModule, Path, In, State), 2129 phrase(read_directives(In, Options, [true]), Directives), 2130 public_list_cleanup(In, State)), 2131 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2132 2133public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2134 prolog_open_source(Path, In), 2135 '$set_source_module'(OldM, TempModule), 2136 set_xref(OldXref). 2137 2138public_list_cleanup(In, state(OldM, OldXref)) :- 2139 '$set_source_module'(OldM), 2140 set_prolog_flag(xref, OldXref), 2141 prolog_close_source(In). 2142 2143 2144read_directives(In, Options, State) --> 2145 { E = error(_,_), 2146 repeat, 2147 catch(prolog_read_source_term(In, Term, Expanded, 2148 [ process_comment(true), 2149 syntax_errors(error) 2150 ]), 2151 E, report_syntax_error(E, -, Options)) 2152 -> nonvar(Term), 2153 Term = (:-_) 2154 }, 2155 !, 2156 terms(Expanded, State, State1), 2157 read_directives(In, Options, State1). 2158read_directives(_, _, _) --> []. 2159 2160terms(Var, State, State) --> { var(Var) }, !. 2161terms([H|T], State0, State) --> 2162 !, 2163 terms(H, State0, State1), 2164 terms(T, State1, State). 2165terms((:-if(Cond)), State0, [True|State0]) --> 2166 !, 2167 { eval_cond(Cond, True) }. 2168terms((:-elif(Cond)), [True0|State], [True|State]) --> 2169 !, 2170 { eval_cond(Cond, True1), 2171 elif(True0, True1, True) 2172 }. 2173terms((:-else), [True0|State], [True|State]) --> 2174 !, 2175 { negate(True0, True) }. 2176terms((:-endif), [_|State], State) --> !. 2177terms(H, State, State) --> 2178 ( {State = [true|_]} 2179 -> [H] 2180 ; [] 2181 ). 2182 2183eval_cond(Cond, true) :- 2184 catch(Cond, error(_,_), fail), 2185 !. 2186eval_cond(_, false). 2187 2188elif(true, _, else_false) :- !. 2189elif(false, true, true) :- !. 2190elif(True, _, True). 2191 2192negate(true, false). 2193negate(false, true). 2194negate(else_false, else_false). 2195 2196public_list([(:- module(Module, Export0))|Decls], Path, 2197 Module, Meta, MT, Export, Rest, Public, PT) :- 2198 !, 2199 ( is_list(Export0) 2200 -> append(Export0, Reexport, Export) 2201 ; Reexport = Export 2202 ), 2203 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2204public_list([(:- encoding(_))|Decls], Path, 2205 Module, Meta, MT, Export, Rest, Public, PT) :- 2206 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2207 2208public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2209public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2210 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2211 !, 2212 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2213public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2214 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2215 2216public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2217 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2218public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2219 public_from_import(Import, Spec, Path, Reexport, Rest). 2220public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2221 phrase(meta_decls(Decl), Meta, MT). 2222public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2223 phrase(public_decls(Decl), Public, PT).
2229reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2230reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2231 !, 2232 xref_source_file(H, Path, Src), 2233 public_list(Path, _Source, _Module, Meta0, Export0, Public0, []), 2234 append(Meta0, MT1, Meta), 2235 append(Export0, ET1, Export), 2236 append(Public0, PT1, Public), 2237 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2238reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2239 xref_source_file(Spec, Path, Src), 2240 public_list(Path, _Source, _Module, Meta0, Export0, Public0, []), 2241 append(Meta0, MT, Meta), 2242 append(Export0, ET, Export), 2243 append(Public0, PT, Public). 2244 2245public_from_import(except(Map), Path, Src, Export, Rest) :- 2246 !, 2247 xref_public_list(Path, _, AllExports, Src), 2248 except(Map, AllExports, NewExports), 2249 append(NewExports, Rest, Export). 2250public_from_import(Import, _, _, Export, Rest) :- 2251 import_name_map(Import, Export, Rest).
2256except([], Exports, Exports). 2257except([PI0 as NewName|Map], Exports0, Exports) :- 2258 !, 2259 canonical_pi(PI0, PI), 2260 map_as(Exports0, PI, NewName, Exports1), 2261 except(Map, Exports1, Exports). 2262except([PI0|Map], Exports0, Exports) :- 2263 canonical_pi(PI0, PI), 2264 select(PI2, Exports0, Exports1), 2265 same_pi(PI, PI2), 2266 !, 2267 except(Map, Exports1, Exports). 2268 2269 2270map_as([PI|T], Repl, As, [PI2|T]) :- 2271 same_pi(Repl, PI), 2272 !, 2273 pi_as(PI, As, PI2). 2274map_as([H|T0], Repl, As, [H|T]) :- 2275 map_as(T0, Repl, As, T). 2276 2277pi_as(_/Arity, Name, Name/Arity). 2278pi_as(_//Arity, Name, Name//Arity). 2279 2280import_name_map([], L, L). 2281import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2282 !, 2283 import_name_map(T0, T, Tail). 2284import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2285 !, 2286 import_name_map(T0, T, Tail). 2287import_name_map([H|T0], [H|T], Tail) :- 2288 import_name_map(T0, T, Tail). 2289 2290canonical_pi(Name//Arity0, PI) :- 2291 integer(Arity0), 2292 !, 2293 PI = Name/Arity, 2294 Arity is Arity0 + 2. 2295canonical_pi(PI, PI). 2296 2297same_pi(Canonical, PI2) :- 2298 canonical_pi(PI2, Canonical). 2299 2300meta_decls(Var) --> 2301 { var(Var) }, 2302 !. 2303meta_decls((A,B)) --> 2304 !, 2305 meta_decls(A), 2306 meta_decls(B). 2307meta_decls(A) --> 2308 [A]. 2309 2310public_decls(Var) --> 2311 { var(Var) }, 2312 !. 2313public_decls((A,B)) --> 2314 !, 2315 public_decls(A), 2316 public_decls(B). 2317public_decls(A) --> 2318 [A]. 2319 2320 /******************************* 2321 * INCLUDE * 2322 *******************************/ 2323 2324process_include([], _) :- !. 2325process_include([H|T], Src) :- 2326 !, 2327 process_include(H, Src), 2328 process_include(T, Src). 2329process_include(File, Src) :- 2330 callable(File), 2331 !, 2332 ( once(xref_input(ParentSrc, _)), 2333 xref_source_file(File, Path, ParentSrc) 2334 -> ( ( uses_file(_, Src, Path) 2335 ; Path == Src 2336 ) 2337 -> true 2338 ; assert(uses_file(File, Src, Path)), 2339 ( xoption(Src, process_include(true)) 2340 -> findall(O, xoption(Src, O), Options), 2341 setup_call_cleanup( 2342 open_include_file(Path, In, Refs), 2343 collect(Src, Path, In, Options), 2344 close_include(In, Refs)) 2345 ; true 2346 ) 2347 ) 2348 ; assert(uses_file(File, Src, '<not_found>')) 2349 ). 2350process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2358open_include_file(Path, In, [Ref]) :- 2359 once(xref_input(_, Parent)), 2360 stream_property(Parent, encoding(Enc)), 2361 '$push_input_context'(xref_include), 2362 catch(( prolog:xref_open_source(Path, In) 2363 -> catch(set_stream(In, encoding(Enc)), 2364 error(_,_), true) % deal with non-file input 2365 ; include_encoding(Enc, Options), 2366 open(Path, read, In, Options) 2367 ), E, 2368 ( '$pop_input_context', throw(E))), 2369 catch(( peek_char(In, #) % Deal with #! script 2370 -> skip(In, 10) 2371 ; true 2372 ), E, 2373 ( close_include(In, []), throw(E))), 2374 asserta(xref_input(Path, In), Ref). 2375 2376include_encoding(wchar_t, []) :- !. 2377include_encoding(Enc, [encoding(Enc)]). 2378 2379 2380close_include(In, Refs) :- 2381 maplist(erase, Refs), 2382 close(In, [force(true)]), 2383 '$pop_input_context'.
2389process_foreign(Spec, Src) :- 2390 ground(Spec), 2391 current_foreign_library(Spec, Defined), 2392 !, 2393 ( xmodule(Module, Src) 2394 -> true 2395 ; Module = user 2396 ), 2397 process_foreign_defined(Defined, Module, Src). 2398process_foreign(_, _). 2399 2400process_foreign_defined([], _, _). 2401process_foreign_defined([H|T], M, Src) :- 2402 ( H = M:Head 2403 -> assert_foreign(Src, Head) 2404 ; assert_foreign(Src, H) 2405 ), 2406 process_foreign_defined(T, M, Src). 2407 2408 2409 /******************************* 2410 * CHR SUPPORT * 2411 *******************************/ 2412 2413/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2414This part of the file supports CHR. Our choice is between making special 2415hooks to make CHR expansion work and then handle the (complex) expanded 2416code or process the CHR source directly. The latter looks simpler, 2417though I don't like the idea of adding support for libraries to this 2418module. A file is supposed to be a CHR file if it uses a 2419use_module(library(chr) or contains a :- constraint/1 directive. As an 2420extra bonus we get the source-locations right :-) 2421- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2422 2423process_chr(@(_Name, Rule), Src) :- 2424 mode(chr, Src), 2425 process_chr(Rule, Src). 2426process_chr(pragma(Rule, _Pragma), Src) :- 2427 mode(chr, Src), 2428 process_chr(Rule, Src). 2429process_chr(<=>(Head, Body), Src) :- 2430 mode(chr, Src), 2431 chr_head(Head, Src, H), 2432 chr_body(Body, H, Src). 2433process_chr(==>(Head, Body), Src) :- 2434 mode(chr, Src), 2435 chr_head(Head, H, Src), 2436 chr_body(Body, H, Src). 2437process_chr((:- chr_constraint(Decls)), Src) :- 2438 ( mode(chr, Src) 2439 -> true 2440 ; assert(mode(chr, Src)) 2441 ), 2442 chr_decls(Decls, Src). 2443 2444chr_decls((A,B), Src) => 2445 chr_decls(A, Src), 2446 chr_decls(B, Src). 2447chr_decls(Head, Src) => 2448 generalise_term(Head, Gen), 2449 ( declared(Gen, chr_constraint, Src, _) 2450 -> true 2451 ; current_source_line(Line), 2452 assertz(declared(Gen, chr_constraint, Src, Line)) 2453 ). 2454 2455chr_head(X, _, _) :- 2456 var(X), 2457 !. % Illegal. Warn? 2458chr_head(\(A,B), Src, H) :- 2459 chr_head(A, Src, H), 2460 process_body(B, H, Src). 2461chr_head((H0,B), Src, H) :- 2462 chr_defined(H0, Src, H), 2463 process_body(B, H, Src). 2464chr_head(H0, Src, H) :- 2465 chr_defined(H0, Src, H). 2466 2467chr_defined(X, _, _) :- 2468 var(X), 2469 !. 2470chr_defined(#(C,_Id), Src, C) :- 2471 !, 2472 assert_constraint(Src, C). 2473chr_defined(A, Src, A) :- 2474 assert_constraint(Src, A). 2475 2476chr_body(X, From, Src) :- 2477 var(X), 2478 !, 2479 process_body(X, From, Src). 2480chr_body('|'(Guard, Goals), H, Src) :- 2481 !, 2482 chr_body(Guard, H, Src), 2483 chr_body(Goals, H, Src). 2484chr_body(G, From, Src) :- 2485 process_body(G, From, Src). 2486 2487assert_constraint(_, Head) :- 2488 var(Head), 2489 !. 2490assert_constraint(Src, Head) :- 2491 constraint(Head, Src, _), 2492 !. 2493assert_constraint(Src, Head) :- 2494 generalise_term(Head, Term), 2495 current_source_line(Line), 2496 assert(constraint(Term, Src, Line)). 2497 2498 2499 /******************************** 2500 * PHASE 1 ASSERTIONS * 2501 ********************************/
2508assert_called(_, _, Var, _) :- 2509 var(Var), 2510 !. 2511assert_called(Src, From, Goal, Line) :- 2512 var(From), 2513 !, 2514 assert_called(Src, '<unknown>', Goal, Line). 2515assert_called(_, _, Goal, _) :- 2516 expand_hide_called(Goal), 2517 !. 2518assert_called(Src, Origin, M:G, Line) :- 2519 !, 2520 ( atom(M), 2521 callable(G) 2522 -> current_condition(Cond), 2523 ( xmodule(M, Src) % explicit call to own module 2524 -> assert_called(Src, Origin, G, Line) 2525 ; called(M:G, Src, Origin, Cond, Line) % already registered 2526 -> true 2527 ; hide_called(M:G, Src) % not interesting (now) 2528 -> true 2529 ; generalise(Origin, OTerm), 2530 generalise(G, GTerm) 2531 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2532 ; true 2533 ) 2534 ; true % call to variable module 2535 ). 2536assert_called(Src, _, Goal, _) :- 2537 ( xmodule(M, Src) 2538 -> M \== system 2539 ; M = user 2540 ), 2541 hide_called(M:Goal, Src), 2542 !. 2543assert_called(Src, Origin, Goal, Line) :- 2544 current_condition(Cond), 2545 ( called(Goal, Src, Origin, Cond, Line) 2546 -> true 2547 ; generalise(Origin, OTerm), 2548 generalise(Goal, Term) 2549 -> assert(called(Term, Src, OTerm, Cond, Line)) 2550 ; true 2551 ).
2559expand_hide_called(pce_principal:send_implementation(_, _, _)). 2560expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2561expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2562expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2563 2564assert_defined(Src, Goal) :- 2565 Goal = test(_Test), 2566 current_test_unit(Unit, Line), 2567 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2568 fail. 2569assert_defined(Src, Goal) :- 2570 Goal = test(_Test, _Options), 2571 current_test_unit(Unit, Line), 2572 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2573 fail. 2574assert_defined(Src, Goal) :- 2575 defined(Goal, Src, _), 2576 !. 2577assert_defined(Src, Goal) :- 2578 generalise(Goal, Term), 2579 current_source_line(Line), 2580 assert(defined(Term, Src, Line)). 2581 2582assert_foreign(Src, Goal) :- 2583 foreign(Goal, Src, _), 2584 !. 2585assert_foreign(Src, Goal) :- 2586 generalise(Goal, Term), 2587 current_source_line(Line), 2588 assert(foreign(Term, Src, Line)). 2589 2590assert_grammar_rule(Src, Goal) :- 2591 grammar_rule(Goal, Src), 2592 !. 2593assert_grammar_rule(Src, Goal) :- 2594 generalise(Goal, Term), 2595 assert(grammar_rule(Term, Src)).
true, re-export the
imported predicates.
2608assert_import(_, [], _, _, _) :- !. 2609assert_import(Src, [H|T], Export, From, Reexport) :- 2610 !, 2611 assert_import(Src, H, Export, From, Reexport), 2612 assert_import(Src, T, Export, From, Reexport). 2613assert_import(Src, except(Except), Export, From, Reexport) :- 2614 !, 2615 is_list(Export), 2616 !, 2617 except(Except, Export, Import), 2618 assert_import(Src, Import, _All, From, Reexport). 2619assert_import(Src, Import as Name, Export, From, Reexport) :- 2620 !, 2621 pi_to_head(Import, Term0), 2622 rename_goal(Term0, Name, Term), 2623 ( in_export_list(Term0, Export) 2624 -> assert(imported(Term, Src, From)), 2625 assert_reexport(Reexport, Src, Term) 2626 ; current_source_line(Line), 2627 assert_called(Src, '<directive>'(Line), Term0, Line) 2628 ). 2629assert_import(Src, Import, Export, From, Reexport) :- 2630 pi_to_head(Import, Term), 2631 !, 2632 ( in_export_list(Term, Export) 2633 -> assert(imported(Term, Src, From)), 2634 assert_reexport(Reexport, Src, Term) 2635 ; current_source_line(Line), 2636 assert_called(Src, '<directive>'(Line), Term, Line) 2637 ). 2638assert_import(Src, op(P,T,N), _, _, _) :- 2639 xref_push_op(Src, P,T,N). 2640 2641in_export_list(_Head, Export) :- 2642 var(Export), 2643 !. 2644in_export_list(Head, Export) :- 2645 member(PI, Export), 2646 pi_to_head(PI, Head). 2647 2648assert_reexport(false, _, _) :- !. 2649assert_reexport(true, Src, Term) :- 2650 assert(exported(Term, Src)).
2656process_import(M:PI, Src) :- 2657 pi_to_head(PI, Head), 2658 !, 2659 ( atom(M), 2660 current_module(M), 2661 module_property(M, file(From)) 2662 -> true 2663 ; From = '<unknown>' 2664 ), 2665 assert(imported(Head, Src, From)). 2666process_import(_, _).
2675assert_xmodule_callable([], _, _, _). 2676assert_xmodule_callable([PI|T], M, Src, From) :- 2677 ( pi_to_head(M:PI, Head) 2678 -> assert(imported(Head, Src, From)) 2679 ; true 2680 ), 2681 assert_xmodule_callable(T, M, Src, From).
2688assert_op(Src, op(P,T,M:N)) :-
2689 ( '$current_source_module'(M)
2690 -> Name = N
2691 ; Name = M:N
2692 ),
2693 ( xop(Src, op(P,T,Name))
2694 -> true
2695 ; assert(xop(Src, op(P,T,Name)))
2696 ).2703assert_module(Src, Module) :- 2704 xmodule(Module, Src), 2705 !. 2706assert_module(Src, Module) :- 2707 '$set_source_module'(Module), 2708 assert(xmodule(Module, Src)), 2709 ( module_property(Module, class(system)) 2710 -> retractall(xoption(Src, register_called(_))), 2711 assert(xoption(Src, register_called(all))) 2712 ; true 2713 ). 2714 2715assert_module_export(_, []) :- !. 2716assert_module_export(Src, [H|T]) :- 2717 !, 2718 assert_module_export(Src, H), 2719 assert_module_export(Src, T). 2720assert_module_export(Src, PI) :- 2721 pi_to_head(PI, Term), 2722 !, 2723 assert(exported(Term, Src)). 2724assert_module_export(Src, op(P, A, N)) :- 2725 xref_push_op(Src, P, A, N).
2731assert_module3([], _) :- !. 2732assert_module3([H|T], Src) :- 2733 !, 2734 assert_module3(H, Src), 2735 assert_module3(T, Src). 2736assert_module3(Option, Src) :- 2737 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2746process_predicates(Closure, Preds, Src) :- 2747 is_list(Preds), 2748 !, 2749 process_predicate_list(Preds, Closure, Src). 2750process_predicates(Closure, as(Preds, _Options), Src) :- 2751 !, 2752 process_predicates(Closure, Preds, Src). 2753process_predicates(Closure, Preds, Src) :- 2754 process_predicate_comma(Preds, Closure, Src). 2755 2756process_predicate_list([], _, _). 2757process_predicate_list([H|T], Closure, Src) :- 2758 ( nonvar(H) 2759 -> call(Closure, H, Src) 2760 ; true 2761 ), 2762 process_predicate_list(T, Closure, Src). 2763 2764process_predicate_comma(Var, _, _) :- 2765 var(Var), 2766 !. 2767process_predicate_comma(M:(A,B), Closure, Src) :- 2768 !, 2769 process_predicate_comma(M:A, Closure, Src), 2770 process_predicate_comma(M:B, Closure, Src). 2771process_predicate_comma((A,B), Closure, Src) :- 2772 !, 2773 process_predicate_comma(A, Closure, Src), 2774 process_predicate_comma(B, Closure, Src). 2775process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2776 !, 2777 process_predicate_comma(Spec, Closure, Src). 2778process_predicate_comma(A, Closure, Src) :- 2779 call(Closure, A, Src). 2780 2781 2782assert_dynamic(PI, Src) :- 2783 pi_to_head(PI, Term), 2784 ( thread_local(Term, Src, _) % dynamic after thread_local has 2785 -> true % no effect 2786 ; current_source_line(Line), 2787 assert(dynamic(Term, Src, Line)) 2788 ). 2789 2790assert_thread_local(PI, Src) :- 2791 pi_to_head(PI, Term), 2792 current_source_line(Line), 2793 assert(thread_local(Term, Src, Line)). 2794 2795assert_multifile(PI, Src) :- % :- multifile(Spec) 2796 pi_to_head(PI, Term), 2797 current_source_line(Line), 2798 assert(multifile(Term, Src, Line)). 2799 2800assert_public(PI, Src) :- % :- public(Spec) 2801 pi_to_head(PI, Term), 2802 current_source_line(Line), 2803 assert_called(Src, '<public>'(Line), Term, Line), 2804 assert(public(Term, Src, Line)). 2805 2806assert_export(PI, Src) :- % :- export(Spec) 2807 pi_to_head(PI, Term), 2808 !, 2809 assert(exported(Term, Src)).
2816pi_to_head(Var, _) :- 2817 var(Var), !, fail. 2818pi_to_head(M:PI, M:Term) :- 2819 !, 2820 pi_to_head(PI, Term). 2821pi_to_head(Name/Arity, Term) :- 2822 functor(Term, Name, Arity). 2823pi_to_head(Name//DCGArity, Term) :- 2824 Arity is DCGArity+2, 2825 functor(Term, Name, Arity). 2826 2827 2828assert_used_class(Src, Name) :- 2829 used_class(Name, Src), 2830 !. 2831assert_used_class(Src, Name) :- 2832 assert(used_class(Name, Src)). 2833 2834assert_defined_class(Src, Name, _Meta, _Super, _) :- 2835 defined_class(Name, _, _, Src, _), 2836 !. 2837assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2838assert_defined_class(Src, Name, Meta, Super, Summary) :- 2839 current_source_line(Line), 2840 ( Summary == @(default) 2841 -> Atom = '' 2842 ; is_list(Summary) 2843 -> atom_codes(Atom, Summary) 2844 ; string(Summary) 2845 -> atom_concat(Summary, '', Atom) 2846 ), 2847 assert(defined_class(Name, Super, Atom, Src, Line)), 2848 ( Meta = @(_) 2849 -> true 2850 ; assert_used_class(Src, Meta) 2851 ), 2852 assert_used_class(Src, Super). 2853 2854assert_defined_class(Src, Name, imported_from(_File)) :- 2855 defined_class(Name, _, _, Src, _), 2856 !. 2857assert_defined_class(Src, Name, imported_from(File)) :- 2858 assert(defined_class(Name, _, '', Src, file(File))). 2859 2860 2861 /******************************** 2862 * UTILITIES * 2863 ********************************/
2869generalise(Var, Var) :- 2870 var(Var), 2871 !. % error? 2872generalise(pce_principal:send_implementation(Id, _, _), 2873 pce_principal:send_implementation(Id, _, _)) :- 2874 atom(Id), 2875 !. 2876generalise(pce_principal:get_implementation(Id, _, _, _), 2877 pce_principal:get_implementation(Id, _, _, _)) :- 2878 atom(Id), 2879 !. 2880generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2881generalise(test(Test), test(Test)) :- 2882 current_test_unit(_,_), 2883 ground(Test), 2884 !. 2885generalise(test(Test, _), test(Test, _)) :- 2886 current_test_unit(_,_), 2887 ground(Test), 2888 !. 2889generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !. 2890generalise(Module:Goal0, Module:Goal) :- 2891 atom(Module), 2892 !, 2893 generalise(Goal0, Goal). 2894generalise(Term0, Term) :- 2895 callable(Term0), 2896 generalise_term(Term0, Term). 2897 2898 2899 /******************************* 2900 * SOURCE MANAGEMENT * 2901 *******************************/ 2902 2903/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2904This section of the file contains hookable predicates to reason about 2905sources. The built-in code here can only deal with files. The XPCE 2906library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2907can do cross-referencing on PceEmacs edit buffers. Other examples for 2908hooking can be databases, (HTTP) URIs, etc. 2909- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2910 2911:- multifile 2912 prolog:xref_source_directory/2, % +Source, -Dir 2913 prolog:xref_source_file/3. % +Spec, -Path, +Options
2921xref_source_file(Plain, File, Source) :- 2922 xref_source_file(Plain, File, Source, []). 2923 2924xref_source_file(QSpec, File, Source, Options) :- 2925 nonvar(QSpec), QSpec = _:Spec, 2926 !, 2927 must_be(acyclic, Spec), 2928 xref_source_file(Spec, File, Source, Options). 2929xref_source_file(Spec, File, Source, Options) :- 2930 nonvar(Spec), 2931 prolog:xref_source_file(Spec, File, 2932 [ relative_to(Source) 2933 | Options 2934 ]), 2935 !. 2936xref_source_file(Plain, File, Source, Options) :- 2937 atom(Plain), 2938 \+ is_absolute_file_name(Plain), 2939 ( prolog:xref_source_directory(Source, Dir) 2940 -> true 2941 ; atom(Source), 2942 file_directory_name(Source, Dir) 2943 ), 2944 atomic_list_concat([Dir, /, Plain], Spec0), 2945 absolute_file_name(Spec0, Spec), 2946 do_xref_source_file(Spec, File, Options), 2947 !. 2948xref_source_file(Spec, File, Source, Options) :- 2949 do_xref_source_file(Spec, File, 2950 [ relative_to(Source) 2951 | Options 2952 ]), 2953 !. 2954xref_source_file(_, _, _, Options) :- 2955 option(silent(true), Options), 2956 !, 2957 fail. 2958xref_source_file(Spec, _, Src, _Options) :- 2959 verbose(Src), 2960 print_message(warning, error(existence_error(file, Spec), _)), 2961 fail. 2962 2963do_xref_source_file(Spec, File, Options) :- 2964 nonvar(Spec), 2965 option(file_type(Type), Options, prolog), 2966 absolute_file_name(Spec, File, 2967 [ file_type(Type), 2968 access(read), 2969 file_errors(fail) 2970 ]), 2971 !.
2977canonical_source(Source, Src) :-
2978 ( ground(Source)
2979 -> prolog_canonical_source(Source, Src)
2980 ; Source = Src
2981 ).name()
goals.2988goal_name_arity(Goal, Name, Arity) :- 2989 ( compound(Goal) 2990 -> compound_name_arity(Goal, Name, Arity) 2991 ; atom(Goal) 2992 -> Name = Goal, Arity = 0 2993 ). 2994 2995generalise_term(Specific, General) :- 2996 ( compound(Specific) 2997 -> compound_name_arity(Specific, Name, Arity), 2998 compound_name_arity(General, Name, Arity) 2999 ; General = Specific 3000 ). 3001 3002functor_name(Term, Name) :- 3003 ( compound(Term) 3004 -> compound_name_arity(Term, Name, _) 3005 ; atom(Term) 3006 -> Name = Term 3007 ). 3008 3009rename_goal(Goal0, Name, Goal) :- 3010 ( compound(Goal0) 3011 -> compound_name_arity(Goal0, _, Arity), 3012 compound_name_arity(Goal, Name, Arity) 3013 ; Goal = Name 3014 )
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.