1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org/projects/xpce/ 6 Copyright (c) 2006-2023, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module(prolog_xref, 39 [ xref_source/1, % +Source 40 xref_source/2, % +Source, +Options 41 xref_called/3, % ?Source, ?Callable, ?By 42 xref_called/4, % ?Source, ?Callable, ?By, ?Cond 43 xref_called/5, % ?Source, ?Callable, ?By, ?Cond, ?Line 44 xref_defined/3, % ?Source. ?Callable, -How 45 xref_definition_line/2, % +How, -Line 46 xref_exported/2, % ?Source, ?Callable 47 xref_module/2, % ?Source, ?Module 48 xref_uses_file/3, % ?Source, ?Spec, ?Path 49 xref_op/2, % ?Source, ?Op 50 xref_prolog_flag/4, % ?Source, ?Flag, ?Value, ?Line 51 xref_comment/3, % ?Source, ?Title, ?Comment 52 xref_comment/4, % ?Source, ?Head, ?Summary, ?Comment 53 xref_mode/3, % ?Source, ?Mode, ?Det 54 xref_option/2, % ?Source, ?Option 55 xref_clean/1, % +Source 56 xref_current_source/1, % ?Source 57 xref_done/2, % +Source, -When 58 xref_built_in/1, % ?Callable 59 xref_source_file/3, % +Spec, -Path, +Source 60 xref_source_file/4, % +Spec, -Path, +Source, +Options 61 xref_public_list/3, % +File, +Src, +Options 62 xref_public_list/4, % +File, -Path, -Export, +Src 63 xref_public_list/6, % +File, -Path, -Module, -Export, -Meta, +Src 64 xref_public_list/7, % +File, -Path, -Module, -Export, -Public, -Meta, +Src 65 xref_meta/3, % +Source, +Goal, -Called 66 xref_meta/2, % +Goal, -Called 67 xref_hook/1, % ?Callable 68 % XPCE class references 69 xref_used_class/2, % ?Source, ?ClassName 70 xref_defined_class/3 % ?Source, ?ClassName, -How 71 ]). 72:- autoload(library(apply),[maplist/2,partition/4,maplist/3]). 73:- use_module(library(debug),[debug/3]). 74:- autoload(library(dialect),[expects_dialect/1]). 75:- autoload(library(error),[must_be/2,instantiation_error/1]). 76:- autoload(library(lists),[member/2,append/2,append/3,select/3]). 77:- autoload(library(modules),[in_temporary_module/3]). 78:- autoload(library(operators),[push_op/3]). 79:- autoload(library(option),[option/2,option/3]). 80:- autoload(library(ordsets),[ord_intersect/2,ord_intersection/3]). 81:- autoload(library(prolog_code), [pi_head/2]). 82:- autoload(library(prolog_source), 83 [ prolog_canonical_source/2, 84 prolog_open_source/2, 85 prolog_close_source/1, 86 prolog_read_source_term/4 87 ]). 88 89:- if(exists_source(library(shlib))). 90:- autoload(library(shlib),[current_foreign_library/2]). 91:- endif. 92:- autoload(library(solution_sequences),[distinct/2,limit/2]). 93 94:- if(exists_source(library(pldoc))). 95:- use_module(library(pldoc), []). % Must be loaded before doc_process 96:- use_module(library(pldoc/doc_process)). 97 98:- endif. 99 100:- predicate_options(xref_source/2, 2, 101 [ silent(boolean), 102 module(atom), 103 register_called(oneof([all,non_iso,non_built_in])), 104 comments(oneof([store,collect,ignore])), 105 process_include(boolean) 106 ]). 107 108 109:- dynamic 110 called/5, % Head, Src, From, Cond, Line 111 (dynamic)/3, % Head, Src, Line 112 (thread_local)/3, % Head, Src, Line 113 (multifile)/3, % Head, Src, Line 114 (public)/3, % Head, Src, Line 115 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 grammar_rule/2, % Head, Src 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). 427 428:- meta_predicate 429 with_xref(). 430 431with_xref(Goal) :- 432 current_prolog_flag(xref, Xref), 433 ( Xref == true 434 -> call(Goal) 435 ; setup_call_cleanup( 436 set_prolog_flag(xref, true), 437 Goal, 438 set_prolog_flag(xref, Xref)) 439 ).
449set_initial_mode(_Stream, Options) :- 450 option(module(Module), Options), 451 !, 452 '$set_source_module'(Module). 453set_initial_mode(Stream, _) :- 454 stream_property(Stream, file_name(Path)), 455 source_file_property(Path, load_context(M, _, Opts)), 456 !, 457 '$set_source_module'(M), 458 ( option(dialect(Dialect), Opts) 459 -> expects_dialect(Dialect) 460 ; true 461 ). 462set_initial_mode(_, _) :- 463 '$set_source_module'(user).
469xref_input_stream(Stream) :-
470 xref_input(_, Var),
471 !,
472 Stream = Var.479xref_push_op(Src, P, T, N0) :- 480 '$current_source_module'(M0), 481 strip_module(M0:N0, M, N), 482 ( is_list(N), 483 N \== [] 484 -> maplist(push_op(Src, P, T, M), N) 485 ; push_op(Src, P, T, M, N) 486 ). 487 488push_op(Src, P, T, M0, N0) :- 489 strip_module(M0:N0, M, N), 490 Name = M:N, 491 valid_op(op(P,T,Name)), 492 push_op(P, T, Name), 493 assert_op(Src, op(P,T,Name)), 494 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 495 496valid_op(op(P,T,M:N)) :- 497 atom(M), 498 valid_op_name(N), 499 integer(P), 500 between(0, 1200, P), 501 atom(T), 502 op_type(T). 503 504valid_op_name(N) :- 505 atom(N), 506 !. 507valid_op_name(N) :- 508 N == []. 509 510op_type(xf). 511op_type(yf). 512op_type(fx). 513op_type(fy). 514op_type(xfx). 515op_type(xfy). 516op_type(yfx).
522xref_set_prolog_flag(Flag, Value, Src, Line) :- 523 atom(Flag), 524 !, 525 assertz(xflag(Flag, Value, Src, Line)). 526xref_set_prolog_flag(_, _, _, _).
532xref_clean(Source) :- 533 prolog_canonical_source(Source, Src), 534 retractall(called(_, Src, _Origin, _Cond, _Line)), 535 retractall(dynamic(_, Src, Line)), 536 retractall(multifile(_, Src, Line)), 537 retractall(public(_, Src, Line)), 538 retractall(defined(_, Src, Line)), 539 retractall(meta_goal(_, _, Src)), 540 retractall(foreign(_, Src, Line)), 541 retractall(constraint(_, Src, Line)), 542 retractall(imported(_, Src, _From)), 543 retractall(exported(_, Src)), 544 retractall(uses_file(_, Src, _)), 545 retractall(xmodule(_, Src)), 546 retractall(xop(Src, _)), 547 retractall(grammar_rule(_, Src)), 548 retractall(xoption(Src, _)), 549 retractall(xflag(_Name, _Value, Src, Line)), 550 retractall(source(Src, _)), 551 retractall(used_class(_, Src)), 552 retractall(defined_class(_, _, _, Src, _)), 553 retractall(mode(_, Src)), 554 retractall(module_comment(Src, _, _)), 555 retractall(pred_comment(_, Src, _, _)), 556 retractall(pred_comment_link(_, Src, _)), 557 retractall(pred_mode(_, Src, _)). 558 559 560 /******************************* 561 * READ RESULTS * 562 *******************************/
568xref_current_source(Source) :-
569 source(Source, _Time).
576xref_done(Source, Time) :-
577 prolog_canonical_source(Source, Src),
578 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.
600xref_called(Source, Called, By) :- 601 xref_called(Source, Called, By, _). 602 603xref_called(Source, Called, By, Cond) :- 604 canonical_source(Source, Src), 605 distinct(Called-By, called(Called, Src, By, Cond, _)). 606 607xref_called(Source, Called, By, Cond, Line) :- 608 canonical_source(Source, Src), 609 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)631xref_defined(Source, Called, How) :- 632 nonvar(Source), 633 !, 634 canonical_source(Source, Src), 635 xref_defined2(How, Src, Called). 636xref_defined(Source, Called, How) :- 637 xref_defined2(How, Src, Called), 638 canonical_source(Source, Src). 639 640xref_defined2(dynamic(Line), Src, Called) :- 641 dynamic(Called, Src, Line). 642xref_defined2(thread_local(Line), Src, Called) :- 643 thread_local(Called, Src, Line). 644xref_defined2(multifile(Line), Src, Called) :- 645 multifile(Called, Src, Line). 646xref_defined2(public(Line), Src, Called) :- 647 public(Called, Src, Line). 648xref_defined2(local(Line), Src, Called) :- 649 defined(Called, Src, Line). 650xref_defined2(foreign(Line), Src, Called) :- 651 foreign(Called, Src, Line). 652xref_defined2(constraint(Line), Src, Called) :- 653 constraint(Called, Src, Line). 654xref_defined2(imported(From), Src, Called) :- 655 imported(Called, Src, From). 656xref_defined2(dcg, Src, Called) :- 657 grammar_rule(Called, Src).
665xref_definition_line(local(Line), Line). 666xref_definition_line(dynamic(Line), Line). 667xref_definition_line(thread_local(Line), Line). 668xref_definition_line(multifile(Line), Line). 669xref_definition_line(public(Line), Line). 670xref_definition_line(constraint(Line), Line). 671xref_definition_line(foreign(Line), Line).
678xref_exported(Source, Called) :-
679 prolog_canonical_source(Source, Src),
680 exported(Called, Src).686xref_module(Source, Module) :- 687 nonvar(Source), 688 !, 689 prolog_canonical_source(Source, Src), 690 xmodule(Module, Src). 691xref_module(Source, Module) :- 692 xmodule(Module, Src), 693 prolog_canonical_source(Source, Src).
703xref_uses_file(Source, Spec, Path) :-
704 prolog_canonical_source(Source, Src),
705 uses_file(Spec, Src, Path).
715xref_op(Source, Op) :-
716 prolog_canonical_source(Source, Src),
717 xop(Src, Op).725xref_prolog_flag(Source, Flag, Value, Line) :- 726 prolog_canonical_source(Source, Src), 727 xflag(Flag, Value, Src, Line). 728 729xref_built_in(Head) :- 730 system_predicate(Head). 731 732xref_used_class(Source, Class) :- 733 prolog_canonical_source(Source, Src), 734 used_class(Class, Src). 735 736xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 737 prolog_canonical_source(Source, Src), 738 defined_class(Class, Super, Summary, Src, Line), 739 integer(Line), 740 !. 741xref_defined_class(Source, Class, file(File)) :- 742 prolog_canonical_source(Source, Src), 743 defined_class(Class, _, _, Src, file(File)). 744 745:- thread_local 746 current_cond/1, 747 source_line/1, 748 current_test_unit/2. 749 750current_source_line(Line) :- 751 source_line(Var), 752 !, 753 Line = Var.
761collect(Src, File, In, Options) :- 762 ( Src == File 763 -> SrcSpec = Line 764 ; SrcSpec = (File:Line) 765 ), 766 option(comments(CommentHandling), Options, collect), 767 ( CommentHandling == ignore 768 -> CommentOptions = [], 769 Comments = [] 770 ; CommentHandling == store 771 -> CommentOptions = [ process_comment(true) ], 772 Comments = [], 773 set_prolog_flag(xref_store_comments, true) 774 ; CommentOptions = [ comments(Comments) ] 775 ), 776 repeat, 777 catch(prolog_read_source_term( 778 In, Term, Expanded, 779 [ term_position(TermPos) 780 | CommentOptions 781 ]), 782 E, report_syntax_error(E, Src, [])), 783 update_condition(Term), 784 stream_position_data(line_count, TermPos, Line), 785 setup_call_cleanup( 786 asserta(source_line(SrcSpec), Ref), 787 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 788 E, print_message(error, E)), 789 erase(Ref)), 790 EOF == true, 791 !, 792 set_prolog_flag(xref_store_comments, false). 793 794report_syntax_error(E, _, _) :- 795 fatal_error(E), 796 throw(E). 797report_syntax_error(_, _, Options) :- 798 option(silent(true), Options), 799 !, 800 fail. 801report_syntax_error(E, Src, _Options) :- 802 ( verbose(Src) 803 -> print_message(error, E) 804 ; true 805 ), 806 fail. 807 808fatal_error(time_limit_exceeded). 809fatal_error(error(resource_error(_),_)).
815update_condition((:-Directive)) :- 816 !, 817 update_cond(Directive). 818update_condition(_). 819 820update_cond(if(Cond)) :- 821 !, 822 asserta(current_cond(Cond)). 823update_cond(else) :- 824 retract(current_cond(C0)), 825 !, 826 assert(current_cond(\+C0)). 827update_cond(elif(Cond)) :- 828 retract(current_cond(C0)), 829 !, 830 assert(current_cond((\+C0,Cond))). 831update_cond(endif) :- 832 retract(current_cond(_)), 833 !. 834update_cond(_).
841current_condition(Condition) :- 842 \+ current_cond(_), 843 !, 844 Condition = true. 845current_condition(Condition) :- 846 findall(C, current_cond(C), List), 847 list_to_conj(List, Condition). 848 849list_to_conj([], true). 850list_to_conj([C], C) :- !. 851list_to_conj([H|T], (H,C)) :- 852 list_to_conj(T, C). 853 854 855 /******************************* 856 * PROCESS * 857 *******************************/
869process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 870 is_list(Expanded), % term_expansion into list. 871 !, 872 ( member(Term, Expanded), 873 process(Term, Term0, Src), 874 Term == end_of_file 875 -> EOF = true 876 ; EOF = false 877 ), 878 xref_comments(Comments, TermPos, Src). 879process(end_of_file, _, _, _, _, true) :- 880 !. 881process(Term, Comments, Term0, TermPos, Src, false) :- 882 process(Term, Term0, Src), 883 xref_comments(Comments, TermPos, Src).
887process(_, Term0, _) :- 888 ignore_raw_term(Term0), 889 !. 890process(Head :- Body, Head0 --> _, Src) :- 891 pi_head(F/A, Head), 892 pi_head(F/A0, Head0), 893 A =:= A0 + 2, 894 !, 895 assert_grammar_rule(Src, Head), 896 process((Head :- Body), Src). 897process(Term, _Term0, Src) :- 898 process(Term, Src). 899 900ignore_raw_term((:- predicate_options(_,_,_))).
904process(Var, _) :- 905 var(Var), 906 !. % Warn? 907process(end_of_file, _) :- !. 908process((:- Directive), Src) :- 909 !, 910 process_directive(Directive, Src), 911 !. 912process((?- Directive), Src) :- 913 !, 914 process_directive(Directive, Src), 915 !. 916process((Head :- Body), Src) :- 917 !, 918 assert_defined(Src, Head), 919 process_body(Body, Head, Src). 920process((Left => Body), Src) :- 921 !, 922 ( nonvar(Left), 923 Left = (Head, Guard) 924 -> assert_defined(Src, Head), 925 process_body(Guard, Head, Src), 926 process_body(Body, Head, Src) 927 ; assert_defined(Src, Left), 928 process_body(Body, Left, Src) 929 ). 930process(?=>(Head, Body), Src) :- 931 !, 932 assert_defined(Src, Head), 933 process_body(Body, Head, Src). 934process('$source_location'(_File, _Line):Clause, Src) :- 935 !, 936 process(Clause, Src). 937process(Term, Src) :- 938 process_chr(Term, Src), 939 !. 940process(M:(Head :- Body), Src) :- 941 !, 942 process((M:Head :- M:Body), Src). 943process(Head, Src) :- 944 assert_defined(Src, Head). 945 946 947 /******************************* 948 * COMMENTS * 949 *******************************/
953xref_comments([], _Pos, _Src). 954:- if(current_predicate(parse_comment/3)). 955xref_comments([Pos-Comment|T], TermPos, Src) :- 956 ( Pos @> TermPos % comments inside term 957 -> true 958 ; stream_position_data(line_count, Pos, Line), 959 FilePos = Src:Line, 960 ( parse_comment(Comment, FilePos, Parsed) 961 -> assert_comments(Parsed, Src) 962 ; true 963 ), 964 xref_comments(T, TermPos, Src) 965 ). 966 967assert_comments([], _). 968assert_comments([H|T], Src) :- 969 assert_comment(H, Src), 970 assert_comments(T, Src). 971 972assert_comment(section(_Id, Title, Comment), Src) :- 973 assertz(module_comment(Src, Title, Comment)). 974assert_comment(predicate(PI, Summary, Comment), Src) :- 975 pi_to_head(PI, Src, Head), 976 assertz(pred_comment(Head, Src, Summary, Comment)). 977assert_comment(link(PI, PITo), Src) :- 978 pi_to_head(PI, Src, Head), 979 pi_to_head(PITo, Src, HeadTo), 980 assertz(pred_comment_link(Head, Src, HeadTo)). 981assert_comment(mode(Head, Det), Src) :- 982 assertz(pred_mode(Head, Src, Det)). 983 984pi_to_head(PI, Src, Head) :- 985 pi_to_head(PI, Head0), 986 ( Head0 = _:_ 987 -> strip_module(Head0, M, Plain), 988 ( xmodule(M, Src) 989 -> Head = Plain 990 ; Head = M:Plain 991 ) 992 ; Head = Head0 993 ). 994:- endif.
1000xref_comment(Source, Title, Comment) :-
1001 canonical_source(Source, Src),
1002 module_comment(Src, Title, Comment).
1008xref_comment(Source, Head, Summary, Comment) :-
1009 canonical_source(Source, Src),
1010 ( pred_comment(Head, Src, Summary, Comment)
1011 ; pred_comment_link(Head, Src, HeadTo),
1012 pred_comment(HeadTo, Src, Summary, Comment)
1013 ).
1020xref_mode(Source, Mode, Det) :-
1021 canonical_source(Source, Src),
1022 pred_mode(Mode, Src, Det).1029xref_option(Source, Option) :- 1030 canonical_source(Source, Src), 1031 xoption(Src, Option). 1032 1033 1034 /******************************** 1035 * DIRECTIVES * 1036 ********************************/ 1037 1038process_directive(Var, _) :- 1039 var(Var), 1040 !. % error, but that isn't our business 1041process_directive(Dir, _Src) :- 1042 debug(xref(directive), 'Processing :- ~q', [Dir]), 1043 fail. 1044process_directive((A,B), Src) :- % TBD: what about other control 1045 !, 1046 process_directive(A, Src), % structures? 1047 process_directive(B, Src). 1048process_directive(List, Src) :- 1049 is_list(List), 1050 !, 1051 process_directive(consult(List), Src). 1052process_directive(use_module(File, Import), Src) :- 1053 process_use_module2(File, Import, Src, false). 1054process_directive(autoload(File, Import), Src) :- 1055 process_use_module2(File, Import, Src, false). 1056process_directive(require(Import), Src) :- 1057 process_requires(Import, Src). 1058process_directive(expects_dialect(Dialect), Src) :- 1059 process_directive(use_module(library(dialect/Dialect)), Src), 1060 expects_dialect(Dialect). 1061process_directive(reexport(File, Import), Src) :- 1062 process_use_module2(File, Import, Src, true). 1063process_directive(reexport(Modules), Src) :- 1064 process_use_module(Modules, Src, true). 1065process_directive(autoload(Modules), Src) :- 1066 process_use_module(Modules, Src, false). 1067process_directive(use_module(Modules), Src) :- 1068 process_use_module(Modules, Src, false). 1069process_directive(consult(Modules), Src) :- 1070 process_use_module(Modules, Src, false). 1071process_directive(ensure_loaded(Modules), Src) :- 1072 process_use_module(Modules, Src, false). 1073process_directive(load_files(Files, _Options), Src) :- 1074 process_use_module(Files, Src, false). 1075process_directive(include(Files), Src) :- 1076 process_include(Files, Src). 1077process_directive(dynamic(Dynamic), Src) :- 1078 process_predicates(assert_dynamic, Dynamic, Src). 1079process_directive(dynamic(Dynamic, _Options), Src) :- 1080 process_predicates(assert_dynamic, Dynamic, Src). 1081process_directive(thread_local(Dynamic), Src) :- 1082 process_predicates(assert_thread_local, Dynamic, Src). 1083process_directive(multifile(Dynamic), Src) :- 1084 process_predicates(assert_multifile, Dynamic, Src). 1085process_directive(public(Public), Src) :- 1086 process_predicates(assert_public, Public, Src). 1087process_directive(export(Export), Src) :- 1088 process_predicates(assert_export, Export, Src). 1089process_directive(import(Import), Src) :- 1090 process_import(Import, Src). 1091process_directive(module(Module, Export), Src) :- 1092 assert_module(Src, Module), 1093 assert_module_export(Src, Export). 1094process_directive(module(Module, Export, Import), Src) :- 1095 assert_module(Src, Module), 1096 assert_module_export(Src, Export), 1097 assert_module3(Import, Src). 1098process_directive(begin_tests(Unit, _Options), Src) :- 1099 enter_test_unit(Unit, Src). 1100process_directive(begin_tests(Unit), Src) :- 1101 enter_test_unit(Unit, Src). 1102process_directive(end_tests(Unit), Src) :- 1103 leave_test_unit(Unit, Src). 1104process_directive('$set_source_module'(system), Src) :- 1105 assert_module(Src, system). % hack for handling boot/init.pl 1106process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1107 assert_defined_class(Src, Name, Meta, Super, Doc). 1108process_directive(pce_autoload(Name, From), Src) :- 1109 assert_defined_class(Src, Name, imported_from(From)). 1110 1111process_directive(op(P, A, N), Src) :- 1112 xref_push_op(Src, P, A, N). 1113process_directive(set_prolog_flag(Flag, Value), Src) :- 1114 ( Flag == character_escapes 1115 -> set_prolog_flag(character_escapes, Value) 1116 ; true 1117 ), 1118 current_source_line(Line), 1119 xref_set_prolog_flag(Flag, Value, Src, Line). 1120process_directive(style_check(X), _) :- 1121 style_check(X). 1122process_directive(encoding(Enc), _) :- 1123 ( xref_input_stream(Stream) 1124 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1125 ; true % can this happen? 1126 ). 1127process_directive(pce_expansion:push_compile_operators, _) :- 1128 '$current_source_module'(SM), 1129 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1130process_directive(pce_expansion:pop_compile_operators, _) :- 1131 call(pce_expansion:pop_compile_operators). 1132process_directive(meta_predicate(Meta), Src) :- 1133 process_meta_predicate(Meta, Src). 1134process_directive(arithmetic_function(FSpec), Src) :- 1135 arith_callable(FSpec, Goal), 1136 !, 1137 current_source_line(Line), 1138 assert_called(Src, '<directive>'(Line), Goal, Line). 1139process_directive(format_predicate(_, Goal), Src) :- 1140 !, 1141 current_source_line(Line), 1142 assert_called(Src, '<directive>'(Line), Goal, Line). 1143process_directive(if(Cond), Src) :- 1144 !, 1145 current_source_line(Line), 1146 assert_called(Src, '<directive>'(Line), Cond, Line). 1147process_directive(elif(Cond), Src) :- 1148 !, 1149 current_source_line(Line), 1150 assert_called(Src, '<directive>'(Line), Cond, Line). 1151process_directive(else, _) :- !. 1152process_directive(endif, _) :- !. 1153process_directive(Goal, Src) :- 1154 current_source_line(Line), 1155 process_body(Goal, '<directive>'(Line), Src).
1161process_meta_predicate((A,B), Src) :- 1162 !, 1163 process_meta_predicate(A, Src), 1164 process_meta_predicate(B, Src). 1165process_meta_predicate(Decl, Src) :- 1166 process_meta_head(Src, Decl). 1167 1168process_meta_head(Src, Decl) :- % swapped arguments for maplist 1169 compound(Decl), 1170 compound_name_arity(Decl, Name, Arity), 1171 compound_name_arity(Head, Name, Arity), 1172 meta_args(1, Arity, Decl, Head, Meta), 1173 ( ( prolog:meta_goal(Head, _) 1174 ; prolog:called_by(Head, _, _, _) 1175 ; prolog:called_by(Head, _) 1176 ; meta_goal(Head, _) 1177 ) 1178 -> true 1179 ; assert(meta_goal(Head, Meta, Src)) 1180 ). 1181 1182meta_args(I, Arity, _, _, []) :- 1183 I > Arity, 1184 !. 1185meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1186 arg(I, Decl, 0), 1187 !, 1188 arg(I, Head, H), 1189 I2 is I + 1, 1190 meta_args(I2, Arity, Decl, Head, T). 1191meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1192 arg(I, Decl, ^), 1193 !, 1194 arg(I, Head, EH), 1195 setof_goal(EH, H), 1196 I2 is I + 1, 1197 meta_args(I2, Arity, Decl, Head, T). 1198meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1199 arg(I, Decl, //), 1200 !, 1201 arg(I, Head, H), 1202 I2 is I + 1, 1203 meta_args(I2, Arity, Decl, Head, T). 1204meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1205 arg(I, Decl, A), 1206 integer(A), A > 0, 1207 !, 1208 arg(I, Head, H), 1209 I2 is I + 1, 1210 meta_args(I2, Arity, Decl, Head, T). 1211meta_args(I, Arity, Decl, Head, Meta) :- 1212 I2 is I + 1, 1213 meta_args(I2, Arity, Decl, Head, Meta). 1214 1215 1216 /******************************** 1217 * BODY * 1218 ********************************/
1227xref_meta(Source, Head, Called) :-
1228 canonical_source(Source, Src),
1229 xref_meta_src(Head, Called, Src).1244xref_meta_src(Head, Called, Src) :- 1245 meta_goal(Head, Called, Src), 1246 !. 1247xref_meta_src(Head, Called, _) :- 1248 xref_meta(Head, Called), 1249 !. 1250xref_meta_src(Head, Called, _) :- 1251 compound(Head), 1252 compound_name_arity(Head, Name, Arity), 1253 apply_pred(Name), 1254 Arity > 5, 1255 !, 1256 Extra is Arity - 1, 1257 arg(1, Head, G), 1258 Called = [G+Extra]. 1259xref_meta_src(Head, Called, _) :- 1260 with_xref(predicate_property('$xref_tmp':Head, meta_predicate(Meta))), 1261 !, 1262 Meta =.. [_|Args], 1263 meta_args(Args, 1, Head, Called). 1264 1265meta_args([], _, _, []). 1266meta_args([H0|T0], I, Head, [H|T]) :- 1267 xargs(H0, N), 1268 !, 1269 arg(I, Head, A), 1270 ( N == 0 1271 -> H = A 1272 ; H = (A+N) 1273 ), 1274 I2 is I+1, 1275 meta_args(T0, I2, Head, T). 1276meta_args([_|T0], I, Head, T) :- 1277 I2 is I+1, 1278 meta_args(T0, I2, Head, T). 1279 1280xargs(N, N) :- integer(N), !. 1281xargs(//, 2). 1282xargs(^, 0). 1283 1284apply_pred(call). % built-in 1285apply_pred(maplist). % library(apply_macros) 1286 1287xref_meta((A, B), [A, B]). 1288xref_meta((A; B), [A, B]). 1289xref_meta((A| B), [A, B]). 1290xref_meta((A -> B), [A, B]). 1291xref_meta((A *-> B), [A, B]). 1292xref_meta(findall(_V,G,_L), [G]). 1293xref_meta(findall(_V,G,_L,_T), [G]). 1294xref_meta(findnsols(_N,_V,G,_L), [G]). 1295xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1296xref_meta(setof(_V, EG, _L), [G]) :- 1297 setof_goal(EG, G). 1298xref_meta(bagof(_V, EG, _L), [G]) :- 1299 setof_goal(EG, G). 1300xref_meta(forall(A, B), [A, B]). 1301xref_meta(maplist(G,_), [G+1]). 1302xref_meta(maplist(G,_,_), [G+2]). 1303xref_meta(maplist(G,_,_,_), [G+3]). 1304xref_meta(maplist(G,_,_,_,_), [G+4]). 1305xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1306xref_meta(map_assoc(G, _), [G+1]). 1307xref_meta(map_assoc(G, _, _), [G+2]). 1308xref_meta(checklist(G, _L), [G+1]). 1309xref_meta(sublist(G, _, _), [G+1]). 1310xref_meta(include(G, _, _), [G+1]). 1311xref_meta(exclude(G, _, _), [G+1]). 1312xref_meta(partition(G, _, _, _, _), [G+2]). 1313xref_meta(partition(G, _, _, _),[G+1]). 1314xref_meta(call(G), [G]). 1315xref_meta(call(G, _), [G+1]). 1316xref_meta(call(G, _, _), [G+2]). 1317xref_meta(call(G, _, _, _), [G+3]). 1318xref_meta(call(G, _, _, _, _), [G+4]). 1319xref_meta(not(G), [G]). 1320xref_meta(notrace(G), [G]). 1321xref_meta('$notrace'(G), [G]). 1322xref_meta(\+(G), [G]). 1323xref_meta(ignore(G), [G]). 1324xref_meta(once(G), [G]). 1325xref_meta(initialization(G), [G]). 1326xref_meta(initialization(G,_), [G]). 1327xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1328xref_meta(clause(G, _), [G]). 1329xref_meta(clause(G, _, _), [G]). 1330xref_meta(phrase(G, _A), [//(G)]). 1331xref_meta(phrase(G, _A, _R), [//(G)]). 1332xref_meta(call_dcg(G, _A, _R), [//(G)]). 1333xref_meta(phrase_from_file(G,_),[//(G)]). 1334xref_meta(catch(A, _, B), [A, B]). 1335xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1336xref_meta(thread_create(A,_,_), [A]). 1337xref_meta(thread_create(A,_), [A]). 1338xref_meta(thread_signal(_,A), [A]). 1339xref_meta(thread_idle(A,_), [A]). 1340xref_meta(thread_at_exit(A), [A]). 1341xref_meta(thread_initialization(A), [A]). 1342xref_meta(engine_create(_,A,_), [A]). 1343xref_meta(engine_create(_,A,_,_), [A]). 1344xref_meta(transaction(A), [A]). 1345xref_meta(transaction(A,B,_), [A,B]). 1346xref_meta(snapshot(A), [A]). 1347xref_meta(predsort(A,_,_), [A+3]). 1348xref_meta(call_cleanup(A, B), [A, B]). 1349xref_meta(call_cleanup(A, _, B),[A, B]). 1350xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1351xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1352xref_meta(call_residue_vars(A,_), [A]). 1353xref_meta(with_mutex(_,A), [A]). 1354xref_meta(assume(G), [G]). % library(debug) 1355xref_meta(assertion(G), [G]). % library(debug) 1356xref_meta(freeze(_, G), [G]). 1357xref_meta(when(C, A), [C, A]). 1358xref_meta(time(G), [G]). % development system 1359xref_meta(call_time(G, _), [G]). % development system 1360xref_meta(call_time(G, _, _), [G]). % development system 1361xref_meta(profile(G), [G]). 1362xref_meta(at_halt(G), [G]). 1363xref_meta(call_with_time_limit(_, G), [G]). 1364xref_meta(call_with_depth_limit(G, _, _), [G]). 1365xref_meta(call_with_inference_limit(G, _, _), [G]). 1366xref_meta(alarm(_, G, _), [G]). 1367xref_meta(alarm(_, G, _, _), [G]). 1368xref_meta('$add_directive_wic'(G), [G]). 1369xref_meta(with_output_to(_, G), [G]). 1370xref_meta(if(G), [G]). 1371xref_meta(elif(G), [G]). 1372xref_meta(meta_options(G,_,_), [G+1]). 1373xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1374xref_meta(distinct(G), [G]). % library(solution_sequences) 1375xref_meta(distinct(_, G), [G]). 1376xref_meta(order_by(_, G), [G]). 1377xref_meta(limit(_, G), [G]). 1378xref_meta(offset(_, G), [G]). 1379xref_meta(reset(G,_,_), [G]). 1380xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1381xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1382xref_meta(tnot(G), [G]). 1383xref_meta(not_exists(G), [G]). 1384xref_meta(with_tty_raw(G), [G]). 1385xref_meta(residual_goals(G), [G+2]). 1386 1387 % XPCE meta-predicates 1388xref_meta(pce_global(_, new(_)), _) :- !, fail. 1389xref_meta(pce_global(_, B), [B+1]). 1390xref_meta(ifmaintainer(G), [G]). % used in manual 1391xref_meta(listen(_, G), [G]). % library(broadcast) 1392xref_meta(listen(_, _, G), [G]). 1393xref_meta(in_pce_thread(G), [G]). 1394 1395xref_meta(G, Meta) :- % call user extensions 1396 prolog:meta_goal(G, Meta). 1397xref_meta(G, Meta) :- % Generated from :- meta_predicate 1398 meta_goal(G, Meta). 1399 1400setof_goal(EG, G) :- 1401 var(EG), !, G = EG. 1402setof_goal(_^EG, G) :- 1403 !, 1404 setof_goal(EG, G). 1405setof_goal(G, G). 1406 1407event_xargs(abort, 0). 1408event_xargs(erase, 1). 1409event_xargs(break, 3). 1410event_xargs(frame_finished, 1). 1411event_xargs(thread_exit, 1). 1412event_xargs(this_thread_exit, 0). 1413event_xargs(PI, 2) :- pi_to_head(PI, _).
1419head_of(Var, _) :- 1420 var(Var), !, fail. 1421head_of((Head :- _), Head). 1422head_of(Head, Head).
1430xref_hook(Hook) :- 1431 prolog:hook(Hook). 1432xref_hook(Hook) :- 1433 hook(Hook). 1434 1435 1436hook(attr_portray_hook(_,_)). 1437hook(attr_unify_hook(_,_)). 1438hook(attribute_goals(_,_,_)). 1439hook(goal_expansion(_,_)). 1440hook(term_expansion(_,_)). 1441hook(resource(_,_,_)). 1442hook('$pred_option'(_,_,_,_)). 1443 1444hook(emacs_prolog_colours:goal_classification(_,_)). 1445hook(emacs_prolog_colours:goal_colours(_,_)). 1446hook(emacs_prolog_colours:identify(_,_)). 1447hook(emacs_prolog_colours:style(_,_)). 1448hook(emacs_prolog_colours:term_colours(_,_)). 1449hook(pce_principal:get_implementation(_,_,_,_)). 1450hook(pce_principal:pce_class(_,_,_,_,_,_)). 1451hook(pce_principal:pce_lazy_get_method(_,_,_)). 1452hook(pce_principal:pce_lazy_send_method(_,_,_)). 1453hook(pce_principal:pce_uses_template(_,_)). 1454hook(pce_principal:send_implementation(_,_,_)). 1455hook(predicate_options:option_decl(_,_,_)). 1456hook(prolog:debug_control_hook(_)). 1457hook(prolog:error_message(_,_,_)). 1458hook(prolog:expand_answer(_,_,_)). 1459hook(prolog:general_exception(_,_)). 1460hook(prolog:help_hook(_)). 1461hook(prolog:locate_clauses(_,_)). 1462hook(prolog:message(_,_,_)). 1463hook(prolog:message_context(_,_,_)). 1464hook(prolog:message_line_element(_,_)). 1465hook(prolog:message_location(_,_,_)). 1466hook(prolog:predicate_summary(_,_)). 1467hook(prolog:prolog_exception_hook(_,_,_,_,_)). 1468hook(prolog:residual_goals(_,_)). 1469hook(prolog:show_profile_hook(_,_)). 1470hook(prolog_edit:load). 1471hook(prolog_edit:locate(_,_,_)). 1472hook(sandbox:safe_directive(_)). 1473hook(sandbox:safe_global_variable(_)). 1474hook(sandbox:safe_meta(_,_)). 1475hook(sandbox:safe_meta_predicate(_)). 1476hook(sandbox:safe_primitive(_)). 1477hook(sandbox:safe_prolog_flag(_,_)). 1478hook(shlib:unload_all_foreign_libraries). 1479hook(system:'$foreign_registered'(_, _)). 1480hook(user:exception(_,_,_)). 1481hook(user:expand_answer(_,_)). 1482hook(user:expand_query(_,_,_,_)). 1483hook(user:file_search_path(_,_)). 1484hook(user:library_directory(_)). 1485hook(user:message_hook(_,_,_)). 1486hook(user:portray(_)). 1487hook(user:prolog_clause_name(_,_)). 1488hook(user:prolog_list_goal(_)). 1489hook(user:prolog_predicate_name(_,_)). 1490hook(user:prolog_trace_interception(_,_,_,_)).
1496arith_callable(Var, _) :- 1497 var(Var), !, fail. 1498arith_callable(Module:Spec, Module:Goal) :- 1499 !, 1500 arith_callable(Spec, Goal). 1501arith_callable(Name/Arity, Goal) :- 1502 PredArity is Arity + 1, 1503 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1514process_body(Body, Origin, Src) :-
1515 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1516 true).true if there was a
partial evalation inside Goal that has bound variables.1523process_goal(Var, _, _, _) :- 1524 var(Var), 1525 !. 1526process_goal(_:Goal, _, _, _) :- 1527 var(Goal), 1528 !. 1529process_goal(Goal, Origin, Src, P) :- 1530 Goal = (_,_), % problems 1531 !, 1532 phrase(conjunction(Goal), Goals), 1533 process_conjunction(Goals, Origin, Src, P). 1534process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1535 Goal = (_;_), % problems 1536 !, 1537 phrase(disjunction(Goal), Goals), 1538 forall(member(G, Goals), 1539 process_body(G, Origin, Src)). 1540process_goal(Goal, Origin, Src, P) :- 1541 ( ( xmodule(M, Src) 1542 -> true 1543 ; M = user 1544 ), 1545 pi_head(PI, M:Goal), 1546 ( current_predicate(PI), 1547 predicate_property(M:Goal, imported_from(IM)) 1548 -> true 1549 ; PI = M:Name/Arity, 1550 '$find_library'(M, Name, Arity, IM, _Library) 1551 -> true 1552 ; IM = M 1553 ), 1554 prolog:called_by(Goal, IM, M, Called) 1555 ; prolog:called_by(Goal, Called) 1556 ), 1557 !, 1558 must_be(list, Called), 1559 current_source_line(Here), 1560 assert_called(Src, Origin, Goal, Here), 1561 process_called_list(Called, Origin, Src, P). 1562process_goal(Goal, Origin, Src, _) :- 1563 process_xpce_goal(Goal, Origin, Src), 1564 !. 1565process_goal(load_foreign_library(File), _Origin, Src, _) :- 1566 process_foreign(File, Src). 1567process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1568 process_foreign(File, Src). 1569process_goal(use_foreign_library(File), _Origin, Src, _) :- 1570 process_foreign(File, Src). 1571process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1572 process_foreign(File, Src). 1573process_goal(Goal, Origin, Src, P) :- 1574 xref_meta_src(Goal, Metas, Src), 1575 !, 1576 current_source_line(Here), 1577 assert_called(Src, Origin, Goal, Here), 1578 process_called_list(Metas, Origin, Src, P). 1579process_goal(Goal, Origin, Src, _) :- 1580 asserting_goal(Goal, Rule), 1581 !, 1582 current_source_line(Here), 1583 assert_called(Src, Origin, Goal, Here), 1584 process_assert(Rule, Origin, Src). 1585process_goal(Goal, Origin, Src, P) :- 1586 partial_evaluate(Goal, P), 1587 current_source_line(Here), 1588 assert_called(Src, Origin, Goal, Here). 1589 1590disjunction(Var) --> {var(Var), !}, [Var]. 1591disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1592disjunction(G) --> [G]. 1593 1594conjunction(Var) --> {var(Var), !}, [Var]. 1595conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1596conjunction(G) --> [G]. 1597 (RVars, T) :- 1599 term_variables(T, TVars0), 1600 sort(TVars0, TVars), 1601 ord_intersect(RVars, TVars). 1602 1603process_conjunction([], _, _, _). 1604process_conjunction([Disj|Rest], Origin, Src, P) :- 1605 nonvar(Disj), 1606 Disj = (_;_), 1607 Rest \== [], 1608 !, 1609 phrase(disjunction(Disj), Goals), 1610 term_variables(Rest, RVars0), 1611 sort(RVars0, RVars), 1612 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1613 forall(member(G, NonSHaring), 1614 process_body(G, Origin, Src)), 1615 ( Sharing == [] 1616 -> true 1617 ; maplist(term_variables, Sharing, GVars0), 1618 append(GVars0, GVars1), 1619 sort(GVars1, GVars), 1620 ord_intersection(GVars, RVars, SVars), 1621 VT =.. [v|SVars], 1622 findall(VT, 1623 ( member(G, Sharing), 1624 process_goal(G, Origin, Src, PS), 1625 PS == true 1626 ), 1627 Alts0), 1628 ( Alts0 == [] 1629 -> true 1630 ; ( true 1631 ; P = true, 1632 sort(Alts0, Alts1), 1633 variants(Alts1, 10, Alts), 1634 member(VT, Alts) 1635 ) 1636 ) 1637 ), 1638 process_conjunction(Rest, Origin, Src, P). 1639process_conjunction([H|T], Origin, Src, P) :- 1640 process_goal(H, Origin, Src, P), 1641 process_conjunction(T, Origin, Src, P). 1642 1643 1644process_called_list([], _, _, _). 1645process_called_list([H|T], Origin, Src, P) :- 1646 process_meta(H, Origin, Src, P), 1647 process_called_list(T, Origin, Src, P). 1648 1649process_meta(A+N, Origin, Src, P) :- 1650 !, 1651 ( extend(A, N, AX) 1652 -> process_goal(AX, Origin, Src, P) 1653 ; true 1654 ). 1655process_meta(//(A), Origin, Src, P) :- 1656 !, 1657 process_dcg_goal(A, Origin, Src, P). 1658process_meta(G, Origin, Src, P) :- 1659 process_goal(G, Origin, Src, P).
1666process_dcg_goal(Var, _, _, _) :- 1667 var(Var), 1668 !. 1669process_dcg_goal((A,B), Origin, Src, P) :- 1670 !, 1671 process_dcg_goal(A, Origin, Src, P), 1672 process_dcg_goal(B, Origin, Src, P). 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({Goal}, Origin, Src, P) :- 1690 !, 1691 process_goal(Goal, Origin, Src, P). 1692process_dcg_goal(List, _Origin, _Src, _) :- 1693 is_list(List), 1694 !. % terminal 1695process_dcg_goal(List, _Origin, _Src, _) :- 1696 string(List), 1697 !. % terminal 1698process_dcg_goal(Callable, Origin, Src, P) :- 1699 extend(Callable, 2, Goal), 1700 !, 1701 process_goal(Goal, Origin, Src, P). 1702process_dcg_goal(_, _, _, _). 1703 1704 1705extend(Var, _, _) :- 1706 var(Var), !, fail. 1707extend(M:G, N, M:GX) :- 1708 !, 1709 callable(G), 1710 extend(G, N, GX). 1711extend(G, N, GX) :- 1712 ( compound(G) 1713 -> compound_name_arguments(G, Name, Args), 1714 length(Rest, N), 1715 append(Args, Rest, NArgs), 1716 compound_name_arguments(GX, Name, NArgs) 1717 ; atom(G) 1718 -> length(NArgs, N), 1719 compound_name_arguments(GX, G, NArgs) 1720 ). 1721 1722asserting_goal(assert(Rule), Rule). 1723asserting_goal(asserta(Rule), Rule). 1724asserting_goal(assertz(Rule), Rule). 1725asserting_goal(assert(Rule,_), Rule). 1726asserting_goal(asserta(Rule,_), Rule). 1727asserting_goal(assertz(Rule,_), Rule). 1728 1729process_assert(0, _, _) :- !. % catch variables 1730process_assert((_:-Body), Origin, Src) :- 1731 !, 1732 process_body(Body, Origin, Src). 1733process_assert(_, _, _).
1737variants([], _, []). 1738variants([H|T], Max, List) :- 1739 variants(T, H, Max, List). 1740 1741variants([], H, _, [H]). 1742variants(_, _, 0, []) :- !. 1743variants([H|T], V, Max, List) :- 1744 ( H =@= V 1745 -> variants(T, V, Max, List) 1746 ; List = [V|List2], 1747 Max1 is Max-1, 1748 variants(T, H, Max1, List2) 1749 ).
T = hello(X),
findall(T, T, List),
1763partial_evaluate(Goal, P) :- 1764 eval(Goal), 1765 !, 1766 P = true. 1767partial_evaluate(_, _). 1768 1769eval(X = Y) :- 1770 unify_with_occurs_check(X, Y). 1771 1772 /******************************* 1773 * PLUNIT SUPPORT * 1774 *******************************/ 1775 1776enter_test_unit(Unit, _Src) :- 1777 current_source_line(Line), 1778 asserta(current_test_unit(Unit, Line)). 1779 1780leave_test_unit(Unit, _Src) :- 1781 retractall(current_test_unit(Unit, _)). 1782 1783 1784 /******************************* 1785 * XPCE STUFF * 1786 *******************************/ 1787 1788pce_goal(new(_,_), new(-, new)). 1789pce_goal(send(_,_), send(arg, msg)). 1790pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1791pce_goal(get(_,_,_), get(arg, msg, -)). 1792pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1793pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1794pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1795 1796process_xpce_goal(G, Origin, Src) :- 1797 pce_goal(G, Process), 1798 !, 1799 current_source_line(Here), 1800 assert_called(Src, Origin, G, Here), 1801 ( arg(I, Process, How), 1802 arg(I, G, Term), 1803 process_xpce_arg(How, Term, Origin, Src), 1804 fail 1805 ; true 1806 ). 1807 1808process_xpce_arg(new, Term, Origin, Src) :- 1809 callable(Term), 1810 process_new(Term, Origin, Src). 1811process_xpce_arg(arg, Term, Origin, Src) :- 1812 compound(Term), 1813 process_new(Term, Origin, Src). 1814process_xpce_arg(msg, Term, Origin, Src) :- 1815 compound(Term), 1816 ( arg(_, Term, Arg), 1817 process_xpce_arg(arg, Arg, Origin, Src), 1818 fail 1819 ; true 1820 ). 1821 1822process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1823process_new(Term, Origin, Src) :- 1824 assert_new(Src, Origin, Term), 1825 ( compound(Term), 1826 arg(_, Term, Arg), 1827 process_xpce_arg(arg, Arg, Origin, Src), 1828 fail 1829 ; true 1830 ). 1831 1832assert_new(_, _, Term) :- 1833 \+ callable(Term), 1834 !. 1835assert_new(Src, Origin, Control) :- 1836 functor_name(Control, Class), 1837 pce_control_class(Class), 1838 !, 1839 forall(arg(_, Control, Arg), 1840 assert_new(Src, Origin, Arg)). 1841assert_new(Src, Origin, Term) :- 1842 compound(Term), 1843 arg(1, Term, Prolog), 1844 Prolog == @(prolog), 1845 ( Term =.. [message, _, Selector | T], 1846 atom(Selector) 1847 -> Called =.. [Selector|T], 1848 process_body(Called, Origin, Src) 1849 ; Term =.. [?, _, Selector | T], 1850 atom(Selector) 1851 -> append(T, [_R], T2), 1852 Called =.. [Selector|T2], 1853 process_body(Called, Origin, Src) 1854 ), 1855 fail. 1856assert_new(_, _, @(_)) :- !. 1857assert_new(Src, _, Term) :- 1858 functor_name(Term, Name), 1859 assert_used_class(Src, Name). 1860 1861 1862pce_control_class(and). 1863pce_control_class(or). 1864pce_control_class(if). 1865pce_control_class(not). 1866 1867 1868 /******************************** 1869 * INCLUDED MODULES * 1870 ********************************/
1874process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1875process_use_module([], _, _) :- !. 1876process_use_module([H|T], Src, Reexport) :- 1877 !, 1878 process_use_module(H, Src, Reexport), 1879 process_use_module(T, Src, Reexport). 1880process_use_module(library(pce), Src, Reexport) :- % bit special 1881 !, 1882 xref_public_list(library(pce), Path, Exports, Src), 1883 forall(member(Import, Exports), 1884 process_pce_import(Import, Src, Path, Reexport)). 1885process_use_module(File, Src, Reexport) :- 1886 load_module_if_needed(File), 1887 ( xoption(Src, silent(Silent)) 1888 -> Extra = [silent(Silent)] 1889 ; Extra = [silent(true)] 1890 ), 1891 ( xref_public_list(File, Src, 1892 [ path(Path), 1893 module(M), 1894 exports(Exports), 1895 public(Public), 1896 meta(Meta) 1897 | Extra 1898 ]) 1899 -> assert(uses_file(File, Src, Path)), 1900 assert_import(Src, Exports, _, Path, Reexport), 1901 assert_xmodule_callable(Exports, M, Src, Path), 1902 assert_xmodule_callable(Public, M, Src, Path), 1903 maplist(process_meta_head(Src), Meta), 1904 ( File = library(chr) % hacky 1905 -> assert(mode(chr, Src)) 1906 ; true 1907 ) 1908 ; assert(uses_file(File, Src, '<not_found>')) 1909 ). 1910 1911process_pce_import(Name/Arity, Src, Path, Reexport) :- 1912 atom(Name), 1913 integer(Arity), 1914 !, 1915 functor(Term, Name, Arity), 1916 ( \+ system_predicate(Term), 1917 \+ Term = pce_error(_) % hack!? 1918 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1919 ; true 1920 ). 1921process_pce_import(op(P,T,N), Src, _, _) :- 1922 xref_push_op(Src, P, T, N).
1928process_use_module2(File, Import, Src, Reexport) :-
1929 load_module_if_needed(File),
1930 ( xref_source_file(File, Path, Src)
1931 -> assert(uses_file(File, Src, Path)),
1932 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1933 -> assert_import(Src, Import, Export, Path, Reexport),
1934 forall(( member(Head, Meta),
1935 imported(Head, _, Path)
1936 ),
1937 process_meta_head(Src, Head))
1938 ; true
1939 )
1940 ; assert(uses_file(File, Src, '<not_found>'))
1941 ).1950load_module_if_needed(File) :- 1951 prolog:no_autoload_module(File), 1952 !, 1953 use_module(File, []). 1954load_module_if_needed(_). 1955 1956prologno_autoload_module(library(apply_macros)). 1957prologno_autoload_module(library(arithmetic)). 1958prologno_autoload_module(library(record)). 1959prologno_autoload_module(library(persistency)). 1960prologno_autoload_module(library(pldoc)). 1961prologno_autoload_module(library(settings)). 1962prologno_autoload_module(library(debug)). 1963prologno_autoload_module(library(plunit)). 1964prologno_autoload_module(library(macros)). 1965prologno_autoload_module(library(yall)).
1970process_requires(Import, Src) :- 1971 is_list(Import), 1972 !, 1973 require_list(Import, Src). 1974process_requires(Var, _Src) :- 1975 var(Var), 1976 !. 1977process_requires((A,B), Src) :- 1978 !, 1979 process_requires(A, Src), 1980 process_requires(B, Src). 1981process_requires(PI, Src) :- 1982 requires(PI, Src). 1983 1984require_list([], _). 1985require_list([H|T], Src) :- 1986 requires(H, Src), 1987 require_list(T, Src). 1988 1989requires(PI, _Src) :- 1990 '$pi_head'(PI, Head), 1991 '$get_predicate_attribute'(system:Head, defined, 1), 1992 !. 1993requires(PI, Src) :- 1994 '$pi_head'(PI, Head), 1995 '$pi_head'(Name/Arity, Head), 1996 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1997 ( imported(Head, Src, Library) 1998 -> true 1999 ; assertz(imported(Head, Src, Library)) 2000 ).
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.
2031xref_public_list(File, Src, Options) :-
2032 option(path(Path), Options, _),
2033 option(module(Module), Options, _),
2034 option(exports(Exports), Options, _),
2035 option(public(Public), Options, _),
2036 option(meta(Meta), Options, _),
2037 xref_source_file(File, Path, Src, Options),
2038 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
2060xref_public_list(File, Path, Export, Src) :- 2061 xref_source_file(File, Path, Src), 2062 public_list(Path, _, _, Export, _, []). 2063xref_public_list(File, Path, Module, Export, Meta, Src) :- 2064 xref_source_file(File, Path, Src), 2065 public_list(Path, Module, Meta, Export, _, []). 2066xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 2067 xref_source_file(File, Path, Src), 2068 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2078:- dynamic public_list_cache/6. 2079:- volatile public_list_cache/6. 2080 2081public_list(Path, Module, Meta, Export, Public, _Options) :- 2082 public_list_cache(Path, Modified, 2083 Module0, Meta0, Export0, Public0), 2084 time_file(Path, ModifiedNow), 2085 ( abs(Modified-ModifiedNow) < 0.0001 2086 -> !, 2087 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2088 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2089 fail 2090 ). 2091public_list(Path, Module, Meta, Export, Public, Options) :- 2092 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2093 ( Error = error(_,_), 2094 catch(time_file(Path, Modified), Error, fail) 2095 -> asserta(public_list_cache(Path, Modified, 2096 Module0, Meta0, Export0, Public0)) 2097 ; true 2098 ), 2099 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2100 2101public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2102 in_temporary_module( 2103 TempModule, 2104 true, 2105 public_list_diff(TempModule, Path, Module, 2106 Meta, [], Export, [], Public, [], Options)). 2107 2108 2109public_list_diff(TempModule, 2110 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2111 setup_call_cleanup( 2112 public_list_setup(TempModule, Path, In, State), 2113 phrase(read_directives(In, Options, [true]), Directives), 2114 public_list_cleanup(In, State)), 2115 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2116 2117public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2118 prolog_open_source(Path, In), 2119 '$set_source_module'(OldM, TempModule), 2120 set_xref(OldXref). 2121 2122public_list_cleanup(In, state(OldM, OldXref)) :- 2123 '$set_source_module'(OldM), 2124 set_prolog_flag(xref, OldXref), 2125 prolog_close_source(In). 2126 2127 2128read_directives(In, Options, State) --> 2129 { repeat, 2130 catch(prolog_read_source_term(In, Term, Expanded, 2131 [ process_comment(true), 2132 syntax_errors(error) 2133 ]), 2134 E, report_syntax_error(E, -, Options)) 2135 -> nonvar(Term), 2136 Term = (:-_) 2137 }, 2138 !, 2139 terms(Expanded, State, State1), 2140 read_directives(In, Options, State1). 2141read_directives(_, _, _) --> []. 2142 2143terms(Var, State, State) --> { var(Var) }, !. 2144terms([H|T], State0, State) --> 2145 !, 2146 terms(H, State0, State1), 2147 terms(T, State1, State). 2148terms((:-if(Cond)), State0, [True|State0]) --> 2149 !, 2150 { eval_cond(Cond, True) }. 2151terms((:-elif(Cond)), [True0|State], [True|State]) --> 2152 !, 2153 { eval_cond(Cond, True1), 2154 elif(True0, True1, True) 2155 }. 2156terms((:-else), [True0|State], [True|State]) --> 2157 !, 2158 { negate(True0, True) }. 2159terms((:-endif), [_|State], State) --> !. 2160terms(H, State, State) --> 2161 ( {State = [true|_]} 2162 -> [H] 2163 ; [] 2164 ). 2165 2166eval_cond(Cond, true) :- 2167 catch(Cond, _, fail), 2168 !. 2169eval_cond(_, false). 2170 2171elif(true, _, else_false) :- !. 2172elif(false, true, true) :- !. 2173elif(True, _, True). 2174 2175negate(true, false). 2176negate(false, true). 2177negate(else_false, else_false). 2178 2179public_list([(:- module(Module, Export0))|Decls], Path, 2180 Module, Meta, MT, Export, Rest, Public, PT) :- 2181 !, 2182 ( is_list(Export0) 2183 -> append(Export0, Reexport, Export) 2184 ; Reexport = Export 2185 ), 2186 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2187public_list([(:- encoding(_))|Decls], Path, 2188 Module, Meta, MT, Export, Rest, Public, PT) :- 2189 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2190 2191public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2192public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2193 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2194 !, 2195 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2196public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2197 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2198 2199public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2200 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2201public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2202 public_from_import(Import, Spec, Path, Reexport, Rest). 2203public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2204 phrase(meta_decls(Decl), Meta, MT). 2205public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2206 phrase(public_decls(Decl), Public, PT).
2212reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2213reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2214 !, 2215 xref_source_file(H, Path, Src), 2216 public_list(Path, _Module, Meta0, Export0, Public0, []), 2217 append(Meta0, MT1, Meta), 2218 append(Export0, ET1, Export), 2219 append(Public0, PT1, Public), 2220 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2221reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2222 xref_source_file(Spec, Path, Src), 2223 public_list(Path, _Module, Meta0, Export0, Public0, []), 2224 append(Meta0, MT, Meta), 2225 append(Export0, ET, Export), 2226 append(Public0, PT, Public). 2227 2228public_from_import(except(Map), Path, Src, Export, Rest) :- 2229 !, 2230 xref_public_list(Path, _, AllExports, Src), 2231 except(Map, AllExports, NewExports), 2232 append(NewExports, Rest, Export). 2233public_from_import(Import, _, _, Export, Rest) :- 2234 import_name_map(Import, Export, Rest).
2239except([], Exports, Exports). 2240except([PI0 as NewName|Map], Exports0, Exports) :- 2241 !, 2242 canonical_pi(PI0, PI), 2243 map_as(Exports0, PI, NewName, Exports1), 2244 except(Map, Exports1, Exports). 2245except([PI0|Map], Exports0, Exports) :- 2246 canonical_pi(PI0, PI), 2247 select(PI2, Exports0, Exports1), 2248 same_pi(PI, PI2), 2249 !, 2250 except(Map, Exports1, Exports). 2251 2252 2253map_as([PI|T], Repl, As, [PI2|T]) :- 2254 same_pi(Repl, PI), 2255 !, 2256 pi_as(PI, As, PI2). 2257map_as([H|T0], Repl, As, [H|T]) :- 2258 map_as(T0, Repl, As, T). 2259 2260pi_as(_/Arity, Name, Name/Arity). 2261pi_as(_//Arity, Name, Name//Arity). 2262 2263import_name_map([], L, L). 2264import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2265 !, 2266 import_name_map(T0, T, Tail). 2267import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2268 !, 2269 import_name_map(T0, T, Tail). 2270import_name_map([H|T0], [H|T], Tail) :- 2271 import_name_map(T0, T, Tail). 2272 2273canonical_pi(Name//Arity0, PI) :- 2274 integer(Arity0), 2275 !, 2276 PI = Name/Arity, 2277 Arity is Arity0 + 2. 2278canonical_pi(PI, PI). 2279 2280same_pi(Canonical, PI2) :- 2281 canonical_pi(PI2, Canonical). 2282 2283meta_decls(Var) --> 2284 { var(Var) }, 2285 !. 2286meta_decls((A,B)) --> 2287 !, 2288 meta_decls(A), 2289 meta_decls(B). 2290meta_decls(A) --> 2291 [A]. 2292 2293public_decls(Var) --> 2294 { var(Var) }, 2295 !. 2296public_decls((A,B)) --> 2297 !, 2298 public_decls(A), 2299 public_decls(B). 2300public_decls(A) --> 2301 [A]. 2302 2303 /******************************* 2304 * INCLUDE * 2305 *******************************/ 2306 2307process_include([], _) :- !. 2308process_include([H|T], Src) :- 2309 !, 2310 process_include(H, Src), 2311 process_include(T, Src). 2312process_include(File, Src) :- 2313 callable(File), 2314 !, 2315 ( once(xref_input(ParentSrc, _)), 2316 xref_source_file(File, Path, ParentSrc) 2317 -> ( ( uses_file(_, Src, Path) 2318 ; Path == Src 2319 ) 2320 -> true 2321 ; assert(uses_file(File, Src, Path)), 2322 ( xoption(Src, process_include(true)) 2323 -> findall(O, xoption(Src, O), Options), 2324 setup_call_cleanup( 2325 open_include_file(Path, In, Refs), 2326 collect(Src, Path, In, Options), 2327 close_include(In, Refs)) 2328 ; true 2329 ) 2330 ) 2331 ; assert(uses_file(File, Src, '<not_found>')) 2332 ). 2333process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2341open_include_file(Path, In, [Ref]) :- 2342 once(xref_input(_, Parent)), 2343 stream_property(Parent, encoding(Enc)), 2344 '$push_input_context'(xref_include), 2345 catch(( prolog:xref_open_source(Path, In) 2346 -> catch(set_stream(In, encoding(Enc)), 2347 error(_,_), true) % deal with non-file input 2348 ; include_encoding(Enc, Options), 2349 open(Path, read, In, Options) 2350 ), E, 2351 ( '$pop_input_context', throw(E))), 2352 catch(( peek_char(In, #) % Deal with #! script 2353 -> skip(In, 10) 2354 ; true 2355 ), E, 2356 ( close_include(In, []), throw(E))), 2357 asserta(xref_input(Path, In), Ref). 2358 2359include_encoding(wchar_t, []) :- !. 2360include_encoding(Enc, [encoding(Enc)]). 2361 2362 2363close_include(In, Refs) :- 2364 maplist(erase, Refs), 2365 close(In, [force(true)]), 2366 '$pop_input_context'.
2372process_foreign(Spec, Src) :- 2373 ground(Spec), 2374 current_foreign_library(Spec, Defined), 2375 !, 2376 ( xmodule(Module, Src) 2377 -> true 2378 ; Module = user 2379 ), 2380 process_foreign_defined(Defined, Module, Src). 2381process_foreign(_, _). 2382 2383process_foreign_defined([], _, _). 2384process_foreign_defined([H|T], M, Src) :- 2385 ( H = M:Head 2386 -> assert_foreign(Src, Head) 2387 ; assert_foreign(Src, H) 2388 ), 2389 process_foreign_defined(T, M, Src). 2390 2391 2392 /******************************* 2393 * CHR SUPPORT * 2394 *******************************/ 2395 2396/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2397This part of the file supports CHR. Our choice is between making special 2398hooks to make CHR expansion work and then handle the (complex) expanded 2399code or process the CHR source directly. The latter looks simpler, 2400though I don't like the idea of adding support for libraries to this 2401module. A file is supposed to be a CHR file if it uses a 2402use_module(library(chr) or contains a :- constraint/1 directive. As an 2403extra bonus we get the source-locations right :-) 2404- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2405 2406process_chr(@(_Name, Rule), Src) :- 2407 mode(chr, Src), 2408 process_chr(Rule, Src). 2409process_chr(pragma(Rule, _Pragma), Src) :- 2410 mode(chr, Src), 2411 process_chr(Rule, Src). 2412process_chr(<=>(Head, Body), Src) :- 2413 mode(chr, Src), 2414 chr_head(Head, Src, H), 2415 chr_body(Body, H, Src). 2416process_chr(==>(Head, Body), Src) :- 2417 mode(chr, Src), 2418 chr_head(Head, H, Src), 2419 chr_body(Body, H, Src). 2420process_chr((:- chr_constraint(_)), Src) :- 2421 ( mode(chr, Src) 2422 -> true 2423 ; assert(mode(chr, Src)) 2424 ). 2425 2426chr_head(X, _, _) :- 2427 var(X), 2428 !. % Illegal. Warn? 2429chr_head(\(A,B), Src, H) :- 2430 chr_head(A, Src, H), 2431 process_body(B, H, Src). 2432chr_head((H0,B), Src, H) :- 2433 chr_defined(H0, Src, H), 2434 process_body(B, H, Src). 2435chr_head(H0, Src, H) :- 2436 chr_defined(H0, Src, H). 2437 2438chr_defined(X, _, _) :- 2439 var(X), 2440 !. 2441chr_defined(#(C,_Id), Src, C) :- 2442 !, 2443 assert_constraint(Src, C). 2444chr_defined(A, Src, A) :- 2445 assert_constraint(Src, A). 2446 2447chr_body(X, From, Src) :- 2448 var(X), 2449 !, 2450 process_body(X, From, Src). 2451chr_body('|'(Guard, Goals), H, Src) :- 2452 !, 2453 chr_body(Guard, H, Src), 2454 chr_body(Goals, H, Src). 2455chr_body(G, From, Src) :- 2456 process_body(G, From, Src). 2457 2458assert_constraint(_, Head) :- 2459 var(Head), 2460 !. 2461assert_constraint(Src, Head) :- 2462 constraint(Head, Src, _), 2463 !. 2464assert_constraint(Src, Head) :- 2465 generalise_term(Head, Term), 2466 current_source_line(Line), 2467 assert(constraint(Term, Src, Line)). 2468 2469 2470 /******************************** 2471 * PHASE 1 ASSERTIONS * 2472 ********************************/
2479assert_called(_, _, Var, _) :- 2480 var(Var), 2481 !. 2482assert_called(Src, From, Goal, Line) :- 2483 var(From), 2484 !, 2485 assert_called(Src, '<unknown>', Goal, Line). 2486assert_called(_, _, Goal, _) :- 2487 expand_hide_called(Goal), 2488 !. 2489assert_called(Src, Origin, M:G, Line) :- 2490 !, 2491 ( atom(M), 2492 callable(G) 2493 -> current_condition(Cond), 2494 ( xmodule(M, Src) % explicit call to own module 2495 -> assert_called(Src, Origin, G, Line) 2496 ; called(M:G, Src, Origin, Cond, Line) % already registered 2497 -> true 2498 ; hide_called(M:G, Src) % not interesting (now) 2499 -> true 2500 ; generalise(Origin, OTerm), 2501 generalise(G, GTerm) 2502 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2503 ; true 2504 ) 2505 ; true % call to variable module 2506 ). 2507assert_called(Src, _, Goal, _) :- 2508 ( xmodule(M, Src) 2509 -> M \== system 2510 ; M = user 2511 ), 2512 hide_called(M:Goal, Src), 2513 !. 2514assert_called(Src, Origin, Goal, Line) :- 2515 current_condition(Cond), 2516 ( called(Goal, Src, Origin, Cond, Line) 2517 -> true 2518 ; generalise(Origin, OTerm), 2519 generalise(Goal, Term) 2520 -> assert(called(Term, Src, OTerm, Cond, Line)) 2521 ; true 2522 ).
2530expand_hide_called(pce_principal:send_implementation(_, _, _)). 2531expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2532expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2533expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2534 2535assert_defined(Src, Goal) :- 2536 Goal = test(_Test), 2537 current_test_unit(Unit, Line), 2538 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2539 fail. 2540assert_defined(Src, Goal) :- 2541 Goal = test(_Test, _Options), 2542 current_test_unit(Unit, Line), 2543 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2544 fail. 2545assert_defined(Src, Goal) :- 2546 defined(Goal, Src, _), 2547 !. 2548assert_defined(Src, Goal) :- 2549 generalise(Goal, Term), 2550 current_source_line(Line), 2551 assert(defined(Term, Src, Line)). 2552 2553assert_foreign(Src, Goal) :- 2554 foreign(Goal, Src, _), 2555 !. 2556assert_foreign(Src, Goal) :- 2557 generalise(Goal, Term), 2558 current_source_line(Line), 2559 assert(foreign(Term, Src, Line)). 2560 2561assert_grammar_rule(Src, Goal) :- 2562 grammar_rule(Goal, Src), 2563 !. 2564assert_grammar_rule(Src, Goal) :- 2565 generalise(Goal, Term), 2566 assert(grammar_rule(Term, Src)).
true, re-export the
imported predicates.
2579assert_import(_, [], _, _, _) :- !. 2580assert_import(Src, [H|T], Export, From, Reexport) :- 2581 !, 2582 assert_import(Src, H, Export, From, Reexport), 2583 assert_import(Src, T, Export, From, Reexport). 2584assert_import(Src, except(Except), Export, From, Reexport) :- 2585 !, 2586 is_list(Export), 2587 !, 2588 except(Except, Export, Import), 2589 assert_import(Src, Import, _All, From, Reexport). 2590assert_import(Src, Import as Name, Export, From, Reexport) :- 2591 !, 2592 pi_to_head(Import, Term0), 2593 rename_goal(Term0, Name, Term), 2594 ( in_export_list(Term0, Export) 2595 -> assert(imported(Term, Src, From)), 2596 assert_reexport(Reexport, Src, Term) 2597 ; current_source_line(Line), 2598 assert_called(Src, '<directive>'(Line), Term0, Line) 2599 ). 2600assert_import(Src, Import, Export, From, Reexport) :- 2601 pi_to_head(Import, Term), 2602 !, 2603 ( in_export_list(Term, Export) 2604 -> assert(imported(Term, Src, From)), 2605 assert_reexport(Reexport, Src, Term) 2606 ; current_source_line(Line), 2607 assert_called(Src, '<directive>'(Line), Term, Line) 2608 ). 2609assert_import(Src, op(P,T,N), _, _, _) :- 2610 xref_push_op(Src, P,T,N). 2611 2612in_export_list(_Head, Export) :- 2613 var(Export), 2614 !. 2615in_export_list(Head, Export) :- 2616 member(PI, Export), 2617 pi_to_head(PI, Head). 2618 2619assert_reexport(false, _, _) :- !. 2620assert_reexport(true, Src, Term) :- 2621 assert(exported(Term, Src)).
2627process_import(M:PI, Src) :- 2628 pi_to_head(PI, Head), 2629 !, 2630 ( atom(M), 2631 current_module(M), 2632 module_property(M, file(From)) 2633 -> true 2634 ; From = '<unknown>' 2635 ), 2636 assert(imported(Head, Src, From)). 2637process_import(_, _).
2646assert_xmodule_callable([], _, _, _). 2647assert_xmodule_callable([PI|T], M, Src, From) :- 2648 ( pi_to_head(M:PI, Head) 2649 -> assert(imported(Head, Src, From)) 2650 ; true 2651 ), 2652 assert_xmodule_callable(T, M, Src, From).
2659assert_op(Src, op(P,T,M:N)) :-
2660 ( '$current_source_module'(M)
2661 -> Name = N
2662 ; Name = M:N
2663 ),
2664 ( xop(Src, op(P,T,Name))
2665 -> true
2666 ; assert(xop(Src, op(P,T,Name)))
2667 ).2674assert_module(Src, Module) :- 2675 xmodule(Module, Src), 2676 !. 2677assert_module(Src, Module) :- 2678 '$set_source_module'(Module), 2679 assert(xmodule(Module, Src)), 2680 ( module_property(Module, class(system)) 2681 -> retractall(xoption(Src, register_called(_))), 2682 assert(xoption(Src, register_called(all))) 2683 ; true 2684 ). 2685 2686assert_module_export(_, []) :- !. 2687assert_module_export(Src, [H|T]) :- 2688 !, 2689 assert_module_export(Src, H), 2690 assert_module_export(Src, T). 2691assert_module_export(Src, PI) :- 2692 pi_to_head(PI, Term), 2693 !, 2694 assert(exported(Term, Src)). 2695assert_module_export(Src, op(P, A, N)) :- 2696 xref_push_op(Src, P, A, N).
2702assert_module3([], _) :- !. 2703assert_module3([H|T], Src) :- 2704 !, 2705 assert_module3(H, Src), 2706 assert_module3(T, Src). 2707assert_module3(Option, Src) :- 2708 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2717process_predicates(Closure, Preds, Src) :- 2718 is_list(Preds), 2719 !, 2720 process_predicate_list(Preds, Closure, Src). 2721process_predicates(Closure, as(Preds, _Options), Src) :- 2722 !, 2723 process_predicates(Closure, Preds, Src). 2724process_predicates(Closure, Preds, Src) :- 2725 process_predicate_comma(Preds, Closure, Src). 2726 2727process_predicate_list([], _, _). 2728process_predicate_list([H|T], Closure, Src) :- 2729 ( nonvar(H) 2730 -> call(Closure, H, Src) 2731 ; true 2732 ), 2733 process_predicate_list(T, Closure, Src). 2734 2735process_predicate_comma(Var, _, _) :- 2736 var(Var), 2737 !. 2738process_predicate_comma(M:(A,B), Closure, Src) :- 2739 !, 2740 process_predicate_comma(M:A, Closure, Src), 2741 process_predicate_comma(M:B, Closure, Src). 2742process_predicate_comma((A,B), Closure, Src) :- 2743 !, 2744 process_predicate_comma(A, Closure, Src), 2745 process_predicate_comma(B, Closure, Src). 2746process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2747 !, 2748 process_predicate_comma(Spec, Closure, Src). 2749process_predicate_comma(A, Closure, Src) :- 2750 call(Closure, A, Src). 2751 2752 2753assert_dynamic(PI, Src) :- 2754 pi_to_head(PI, Term), 2755 ( thread_local(Term, Src, _) % dynamic after thread_local has 2756 -> true % no effect 2757 ; current_source_line(Line), 2758 assert(dynamic(Term, Src, Line)) 2759 ). 2760 2761assert_thread_local(PI, Src) :- 2762 pi_to_head(PI, Term), 2763 current_source_line(Line), 2764 assert(thread_local(Term, Src, Line)). 2765 2766assert_multifile(PI, Src) :- % :- multifile(Spec) 2767 pi_to_head(PI, Term), 2768 current_source_line(Line), 2769 assert(multifile(Term, Src, Line)). 2770 2771assert_public(PI, Src) :- % :- public(Spec) 2772 pi_to_head(PI, Term), 2773 current_source_line(Line), 2774 assert_called(Src, '<public>'(Line), Term, Line), 2775 assert(public(Term, Src, Line)). 2776 2777assert_export(PI, Src) :- % :- export(Spec) 2778 pi_to_head(PI, Term), 2779 !, 2780 assert(exported(Term, Src)).
2787pi_to_head(Var, _) :- 2788 var(Var), !, fail. 2789pi_to_head(M:PI, M:Term) :- 2790 !, 2791 pi_to_head(PI, Term). 2792pi_to_head(Name/Arity, Term) :- 2793 functor(Term, Name, Arity). 2794pi_to_head(Name//DCGArity, Term) :- 2795 Arity is DCGArity+2, 2796 functor(Term, Name, Arity). 2797 2798 2799assert_used_class(Src, Name) :- 2800 used_class(Name, Src), 2801 !. 2802assert_used_class(Src, Name) :- 2803 assert(used_class(Name, Src)). 2804 2805assert_defined_class(Src, Name, _Meta, _Super, _) :- 2806 defined_class(Name, _, _, Src, _), 2807 !. 2808assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2809assert_defined_class(Src, Name, Meta, Super, Summary) :- 2810 current_source_line(Line), 2811 ( Summary == @(default) 2812 -> Atom = '' 2813 ; is_list(Summary) 2814 -> atom_codes(Atom, Summary) 2815 ; string(Summary) 2816 -> atom_concat(Summary, '', Atom) 2817 ), 2818 assert(defined_class(Name, Super, Atom, Src, Line)), 2819 ( Meta = @(_) 2820 -> true 2821 ; assert_used_class(Src, Meta) 2822 ), 2823 assert_used_class(Src, Super). 2824 2825assert_defined_class(Src, Name, imported_from(_File)) :- 2826 defined_class(Name, _, _, Src, _), 2827 !. 2828assert_defined_class(Src, Name, imported_from(File)) :- 2829 assert(defined_class(Name, _, '', Src, file(File))). 2830 2831 2832 /******************************** 2833 * UTILITIES * 2834 ********************************/
2840generalise(Var, Var) :- 2841 var(Var), 2842 !. % error? 2843generalise(pce_principal:send_implementation(Id, _, _), 2844 pce_principal:send_implementation(Id, _, _)) :- 2845 atom(Id), 2846 !. 2847generalise(pce_principal:get_implementation(Id, _, _, _), 2848 pce_principal:get_implementation(Id, _, _, _)) :- 2849 atom(Id), 2850 !. 2851generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2852generalise(test(Test), test(Test)) :- 2853 current_test_unit(_,_), 2854 ground(Test), 2855 !. 2856generalise(test(Test, _), test(Test, _)) :- 2857 current_test_unit(_,_), 2858 ground(Test), 2859 !. 2860generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !. 2861generalise(Module:Goal0, Module:Goal) :- 2862 atom(Module), 2863 !, 2864 generalise(Goal0, Goal). 2865generalise(Term0, Term) :- 2866 callable(Term0), 2867 generalise_term(Term0, Term). 2868 2869 2870 /******************************* 2871 * SOURCE MANAGEMENT * 2872 *******************************/ 2873 2874/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2875This section of the file contains hookable predicates to reason about 2876sources. The built-in code here can only deal with files. The XPCE 2877library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2878can do cross-referencing on PceEmacs edit buffers. Other examples for 2879hooking can be databases, (HTTP) URIs, etc. 2880- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2881 2882:- multifile 2883 prolog:xref_source_directory/2, % +Source, -Dir 2884 prolog:xref_source_file/3. % +Spec, -Path, +Options
2892xref_source_file(Plain, File, Source) :- 2893 xref_source_file(Plain, File, Source, []). 2894 2895xref_source_file(QSpec, File, Source, Options) :- 2896 nonvar(QSpec), QSpec = _:Spec, 2897 !, 2898 must_be(acyclic, Spec), 2899 xref_source_file(Spec, File, Source, Options). 2900xref_source_file(Spec, File, Source, Options) :- 2901 nonvar(Spec), 2902 prolog:xref_source_file(Spec, File, 2903 [ relative_to(Source) 2904 | Options 2905 ]), 2906 !. 2907xref_source_file(Plain, File, Source, Options) :- 2908 atom(Plain), 2909 \+ is_absolute_file_name(Plain), 2910 ( prolog:xref_source_directory(Source, Dir) 2911 -> true 2912 ; atom(Source), 2913 file_directory_name(Source, Dir) 2914 ), 2915 atomic_list_concat([Dir, /, Plain], Spec0), 2916 absolute_file_name(Spec0, Spec), 2917 do_xref_source_file(Spec, File, Options), 2918 !. 2919xref_source_file(Spec, File, Source, Options) :- 2920 do_xref_source_file(Spec, File, 2921 [ relative_to(Source) 2922 | Options 2923 ]), 2924 !. 2925xref_source_file(_, _, _, Options) :- 2926 option(silent(true), Options), 2927 !, 2928 fail. 2929xref_source_file(Spec, _, Src, _Options) :- 2930 verbose(Src), 2931 print_message(warning, error(existence_error(file, Spec), _)), 2932 fail. 2933 2934do_xref_source_file(Spec, File, Options) :- 2935 nonvar(Spec), 2936 option(file_type(Type), Options, prolog), 2937 absolute_file_name(Spec, File, 2938 [ file_type(Type), 2939 access(read), 2940 file_errors(fail) 2941 ]), 2942 !.
2948canonical_source(Source, Src) :-
2949 ( ground(Source)
2950 -> prolog_canonical_source(Source, Src)
2951 ; Source = Src
2952 ).name()
goals.2959goal_name_arity(Goal, Name, Arity) :- 2960 ( compound(Goal) 2961 -> compound_name_arity(Goal, Name, Arity) 2962 ; atom(Goal) 2963 -> Name = Goal, Arity = 0 2964 ). 2965 2966generalise_term(Specific, General) :- 2967 ( compound(Specific) 2968 -> compound_name_arity(Specific, Name, Arity), 2969 compound_name_arity(General, Name, Arity) 2970 ; General = Specific 2971 ). 2972 2973functor_name(Term, Name) :- 2974 ( compound(Term) 2975 -> compound_name_arity(Term, Name, _) 2976 ; atom(Term) 2977 -> Name = Term 2978 ). 2979 2980rename_goal(Goal0, Name, Goal) :- 2981 ( compound(Goal0) 2982 -> compound_name_arity(Goal0, _, Arity), 2983 compound_name_arity(Goal, Name, Arity) 2984 ; Goal = Name 2985 )
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.