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:term_colours(_,_)). 1446hook(emacs_prolog_colours:goal_colours(_,_)). 1447hook(emacs_prolog_colours:style(_,_)). 1448hook(emacs_prolog_colours:identify(_,_)). 1449hook(pce_principal:pce_class(_,_,_,_,_,_)). 1450hook(pce_principal:send_implementation(_,_,_)). 1451hook(pce_principal:get_implementation(_,_,_,_)). 1452hook(pce_principal:pce_lazy_get_method(_,_,_)). 1453hook(pce_principal:pce_lazy_send_method(_,_,_)). 1454hook(pce_principal:pce_uses_template(_,_)). 1455hook(prolog:locate_clauses(_,_)). 1456hook(prolog:message(_,_,_)). 1457hook(prolog:error_message(_,_,_)). 1458hook(prolog:message_location(_,_,_)). 1459hook(prolog:message_context(_,_,_)). 1460hook(prolog:message_line_element(_,_)). 1461hook(prolog:debug_control_hook(_)). 1462hook(prolog:help_hook(_)). 1463hook(prolog:show_profile_hook(_,_)). 1464hook(prolog:general_exception(_,_)). 1465hook(prolog:predicate_summary(_,_)). 1466hook(prolog:residual_goals(_,_)). 1467hook(prolog_edit:load). 1468hook(prolog_edit:locate(_,_,_)). 1469hook(shlib:unload_all_foreign_libraries). 1470hook(system:'$foreign_registered'(_, _)). 1471hook(predicate_options:option_decl(_,_,_)). 1472hook(user:exception(_,_,_)). 1473hook(user:file_search_path(_,_)). 1474hook(user:library_directory(_)). 1475hook(user:message_hook(_,_,_)). 1476hook(user:portray(_)). 1477hook(user:prolog_clause_name(_,_)). 1478hook(user:prolog_list_goal(_)). 1479hook(user:prolog_predicate_name(_,_)). 1480hook(user:prolog_trace_interception(_,_,_,_)). 1481hook(prolog:prolog_exception_hook(_,_,_,_,_)). 1482hook(sandbox:safe_primitive(_)). 1483hook(sandbox:safe_meta_predicate(_)). 1484hook(sandbox:safe_meta(_,_)). 1485hook(sandbox:safe_global_variable(_)). 1486hook(sandbox:safe_directive(_)). 1487hook(sandbox:safe_prolog_flag(_,_)).
1493arith_callable(Var, _) :- 1494 var(Var), !, fail. 1495arith_callable(Module:Spec, Module:Goal) :- 1496 !, 1497 arith_callable(Spec, Goal). 1498arith_callable(Name/Arity, Goal) :- 1499 PredArity is Arity + 1, 1500 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1511process_body(Body, Origin, Src) :-
1512 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1513 true).true if there was a
partial evalation inside Goal that has bound variables.1520process_goal(Var, _, _, _) :- 1521 var(Var), 1522 !. 1523process_goal(_:Goal, _, _, _) :- 1524 var(Goal), 1525 !. 1526process_goal(Goal, Origin, Src, P) :- 1527 Goal = (_,_), % problems 1528 !, 1529 phrase(conjunction(Goal), Goals), 1530 process_conjunction(Goals, Origin, Src, P). 1531process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1532 Goal = (_;_), % problems 1533 !, 1534 phrase(disjunction(Goal), Goals), 1535 forall(member(G, Goals), 1536 process_body(G, Origin, Src)). 1537process_goal(Goal, Origin, Src, P) :- 1538 ( ( xmodule(M, Src) 1539 -> true 1540 ; M = user 1541 ), 1542 pi_head(PI, M:Goal), 1543 ( current_predicate(PI), 1544 predicate_property(M:Goal, imported_from(IM)) 1545 -> true 1546 ; PI = M:Name/Arity, 1547 '$find_library'(M, Name, Arity, IM, _Library) 1548 -> true 1549 ; IM = M 1550 ), 1551 prolog:called_by(Goal, IM, M, Called) 1552 ; prolog:called_by(Goal, Called) 1553 ), 1554 !, 1555 must_be(list, Called), 1556 current_source_line(Here), 1557 assert_called(Src, Origin, Goal, Here), 1558 process_called_list(Called, Origin, Src, P). 1559process_goal(Goal, Origin, Src, _) :- 1560 process_xpce_goal(Goal, Origin, Src), 1561 !. 1562process_goal(load_foreign_library(File), _Origin, Src, _) :- 1563 process_foreign(File, Src). 1564process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1565 process_foreign(File, Src). 1566process_goal(use_foreign_library(File), _Origin, Src, _) :- 1567 process_foreign(File, Src). 1568process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1569 process_foreign(File, Src). 1570process_goal(Goal, Origin, Src, P) :- 1571 xref_meta_src(Goal, Metas, Src), 1572 !, 1573 current_source_line(Here), 1574 assert_called(Src, Origin, Goal, Here), 1575 process_called_list(Metas, Origin, Src, P). 1576process_goal(Goal, Origin, Src, _) :- 1577 asserting_goal(Goal, Rule), 1578 !, 1579 current_source_line(Here), 1580 assert_called(Src, Origin, Goal, Here), 1581 process_assert(Rule, Origin, Src). 1582process_goal(Goal, Origin, Src, P) :- 1583 partial_evaluate(Goal, P), 1584 current_source_line(Here), 1585 assert_called(Src, Origin, Goal, Here). 1586 1587disjunction(Var) --> {var(Var), !}, [Var]. 1588disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1589disjunction(G) --> [G]. 1590 1591conjunction(Var) --> {var(Var), !}, [Var]. 1592conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1593conjunction(G) --> [G]. 1594 (RVars, T) :- 1596 term_variables(T, TVars0), 1597 sort(TVars0, TVars), 1598 ord_intersect(RVars, TVars). 1599 1600process_conjunction([], _, _, _). 1601process_conjunction([Disj|Rest], Origin, Src, P) :- 1602 nonvar(Disj), 1603 Disj = (_;_), 1604 Rest \== [], 1605 !, 1606 phrase(disjunction(Disj), Goals), 1607 term_variables(Rest, RVars0), 1608 sort(RVars0, RVars), 1609 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1610 forall(member(G, NonSHaring), 1611 process_body(G, Origin, Src)), 1612 ( Sharing == [] 1613 -> true 1614 ; maplist(term_variables, Sharing, GVars0), 1615 append(GVars0, GVars1), 1616 sort(GVars1, GVars), 1617 ord_intersection(GVars, RVars, SVars), 1618 VT =.. [v|SVars], 1619 findall(VT, 1620 ( member(G, Sharing), 1621 process_goal(G, Origin, Src, PS), 1622 PS == true 1623 ), 1624 Alts0), 1625 ( Alts0 == [] 1626 -> true 1627 ; ( true 1628 ; P = true, 1629 sort(Alts0, Alts1), 1630 variants(Alts1, 10, Alts), 1631 member(VT, Alts) 1632 ) 1633 ) 1634 ), 1635 process_conjunction(Rest, Origin, Src, P). 1636process_conjunction([H|T], Origin, Src, P) :- 1637 process_goal(H, Origin, Src, P), 1638 process_conjunction(T, Origin, Src, P). 1639 1640 1641process_called_list([], _, _, _). 1642process_called_list([H|T], Origin, Src, P) :- 1643 process_meta(H, Origin, Src, P), 1644 process_called_list(T, Origin, Src, P). 1645 1646process_meta(A+N, Origin, Src, P) :- 1647 !, 1648 ( extend(A, N, AX) 1649 -> process_goal(AX, Origin, Src, P) 1650 ; true 1651 ). 1652process_meta(//(A), Origin, Src, P) :- 1653 !, 1654 process_dcg_goal(A, Origin, Src, P). 1655process_meta(G, Origin, Src, P) :- 1656 process_goal(G, Origin, Src, P).
1663process_dcg_goal(Var, _, _, _) :- 1664 var(Var), 1665 !. 1666process_dcg_goal((A,B), Origin, Src, P) :- 1667 !, 1668 process_dcg_goal(A, Origin, Src, P), 1669 process_dcg_goal(B, Origin, Src, P). 1670process_dcg_goal((A;B), Origin, Src, P) :- 1671 !, 1672 process_dcg_goal(A, Origin, Src, P), 1673 process_dcg_goal(B, Origin, Src, P). 1674process_dcg_goal((A|B), Origin, Src, P) :- 1675 !, 1676 process_dcg_goal(A, Origin, Src, P), 1677 process_dcg_goal(B, Origin, Src, P). 1678process_dcg_goal((A->B), Origin, Src, P) :- 1679 !, 1680 process_dcg_goal(A, Origin, Src, P), 1681 process_dcg_goal(B, Origin, Src, P). 1682process_dcg_goal((A*->B), Origin, Src, P) :- 1683 !, 1684 process_dcg_goal(A, Origin, Src, P), 1685 process_dcg_goal(B, Origin, Src, P). 1686process_dcg_goal({Goal}, Origin, Src, P) :- 1687 !, 1688 process_goal(Goal, Origin, Src, P). 1689process_dcg_goal(List, _Origin, _Src, _) :- 1690 is_list(List), 1691 !. % terminal 1692process_dcg_goal(List, _Origin, _Src, _) :- 1693 string(List), 1694 !. % terminal 1695process_dcg_goal(Callable, Origin, Src, P) :- 1696 extend(Callable, 2, Goal), 1697 !, 1698 process_goal(Goal, Origin, Src, P). 1699process_dcg_goal(_, _, _, _). 1700 1701 1702extend(Var, _, _) :- 1703 var(Var), !, fail. 1704extend(M:G, N, M:GX) :- 1705 !, 1706 callable(G), 1707 extend(G, N, GX). 1708extend(G, N, GX) :- 1709 ( compound(G) 1710 -> compound_name_arguments(G, Name, Args), 1711 length(Rest, N), 1712 append(Args, Rest, NArgs), 1713 compound_name_arguments(GX, Name, NArgs) 1714 ; atom(G) 1715 -> length(NArgs, N), 1716 compound_name_arguments(GX, G, NArgs) 1717 ). 1718 1719asserting_goal(assert(Rule), Rule). 1720asserting_goal(asserta(Rule), Rule). 1721asserting_goal(assertz(Rule), Rule). 1722asserting_goal(assert(Rule,_), Rule). 1723asserting_goal(asserta(Rule,_), Rule). 1724asserting_goal(assertz(Rule,_), Rule). 1725 1726process_assert(0, _, _) :- !. % catch variables 1727process_assert((_:-Body), Origin, Src) :- 1728 !, 1729 process_body(Body, Origin, Src). 1730process_assert(_, _, _).
1734variants([], _, []). 1735variants([H|T], Max, List) :- 1736 variants(T, H, Max, List). 1737 1738variants([], H, _, [H]). 1739variants(_, _, 0, []) :- !. 1740variants([H|T], V, Max, List) :- 1741 ( H =@= V 1742 -> variants(T, V, Max, List) 1743 ; List = [V|List2], 1744 Max1 is Max-1, 1745 variants(T, H, Max1, List2) 1746 ).
T = hello(X),
findall(T, T, List),
1760partial_evaluate(Goal, P) :- 1761 eval(Goal), 1762 !, 1763 P = true. 1764partial_evaluate(_, _). 1765 1766eval(X = Y) :- 1767 unify_with_occurs_check(X, Y). 1768 1769 /******************************* 1770 * PLUNIT SUPPORT * 1771 *******************************/ 1772 1773enter_test_unit(Unit, _Src) :- 1774 current_source_line(Line), 1775 asserta(current_test_unit(Unit, Line)). 1776 1777leave_test_unit(Unit, _Src) :- 1778 retractall(current_test_unit(Unit, _)). 1779 1780 1781 /******************************* 1782 * XPCE STUFF * 1783 *******************************/ 1784 1785pce_goal(new(_,_), new(-, new)). 1786pce_goal(send(_,_), send(arg, msg)). 1787pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1788pce_goal(get(_,_,_), get(arg, msg, -)). 1789pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1790pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1791pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1792 1793process_xpce_goal(G, Origin, Src) :- 1794 pce_goal(G, Process), 1795 !, 1796 current_source_line(Here), 1797 assert_called(Src, Origin, G, Here), 1798 ( arg(I, Process, How), 1799 arg(I, G, Term), 1800 process_xpce_arg(How, Term, Origin, Src), 1801 fail 1802 ; true 1803 ). 1804 1805process_xpce_arg(new, Term, Origin, Src) :- 1806 callable(Term), 1807 process_new(Term, Origin, Src). 1808process_xpce_arg(arg, Term, Origin, Src) :- 1809 compound(Term), 1810 process_new(Term, Origin, Src). 1811process_xpce_arg(msg, Term, Origin, Src) :- 1812 compound(Term), 1813 ( arg(_, Term, Arg), 1814 process_xpce_arg(arg, Arg, Origin, Src), 1815 fail 1816 ; true 1817 ). 1818 1819process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1820process_new(Term, Origin, Src) :- 1821 assert_new(Src, Origin, Term), 1822 ( compound(Term), 1823 arg(_, Term, Arg), 1824 process_xpce_arg(arg, Arg, Origin, Src), 1825 fail 1826 ; true 1827 ). 1828 1829assert_new(_, _, Term) :- 1830 \+ callable(Term), 1831 !. 1832assert_new(Src, Origin, Control) :- 1833 functor_name(Control, Class), 1834 pce_control_class(Class), 1835 !, 1836 forall(arg(_, Control, Arg), 1837 assert_new(Src, Origin, Arg)). 1838assert_new(Src, Origin, Term) :- 1839 compound(Term), 1840 arg(1, Term, Prolog), 1841 Prolog == @(prolog), 1842 ( Term =.. [message, _, Selector | T], 1843 atom(Selector) 1844 -> Called =.. [Selector|T], 1845 process_body(Called, Origin, Src) 1846 ; Term =.. [?, _, Selector | T], 1847 atom(Selector) 1848 -> append(T, [_R], T2), 1849 Called =.. [Selector|T2], 1850 process_body(Called, Origin, Src) 1851 ), 1852 fail. 1853assert_new(_, _, @(_)) :- !. 1854assert_new(Src, _, Term) :- 1855 functor_name(Term, Name), 1856 assert_used_class(Src, Name). 1857 1858 1859pce_control_class(and). 1860pce_control_class(or). 1861pce_control_class(if). 1862pce_control_class(not). 1863 1864 1865 /******************************** 1866 * INCLUDED MODULES * 1867 ********************************/
1871process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1872process_use_module([], _, _) :- !. 1873process_use_module([H|T], Src, Reexport) :- 1874 !, 1875 process_use_module(H, Src, Reexport), 1876 process_use_module(T, Src, Reexport). 1877process_use_module(library(pce), Src, Reexport) :- % bit special 1878 !, 1879 xref_public_list(library(pce), Path, Exports, Src), 1880 forall(member(Import, Exports), 1881 process_pce_import(Import, Src, Path, Reexport)). 1882process_use_module(File, Src, Reexport) :- 1883 load_module_if_needed(File), 1884 ( xoption(Src, silent(Silent)) 1885 -> Extra = [silent(Silent)] 1886 ; Extra = [silent(true)] 1887 ), 1888 ( xref_public_list(File, Src, 1889 [ path(Path), 1890 module(M), 1891 exports(Exports), 1892 public(Public), 1893 meta(Meta) 1894 | Extra 1895 ]) 1896 -> assert(uses_file(File, Src, Path)), 1897 assert_import(Src, Exports, _, Path, Reexport), 1898 assert_xmodule_callable(Exports, M, Src, Path), 1899 assert_xmodule_callable(Public, M, Src, Path), 1900 maplist(process_meta_head(Src), Meta), 1901 ( File = library(chr) % hacky 1902 -> assert(mode(chr, Src)) 1903 ; true 1904 ) 1905 ; assert(uses_file(File, Src, '<not_found>')) 1906 ). 1907 1908process_pce_import(Name/Arity, Src, Path, Reexport) :- 1909 atom(Name), 1910 integer(Arity), 1911 !, 1912 functor(Term, Name, Arity), 1913 ( \+ system_predicate(Term), 1914 \+ Term = pce_error(_) % hack!? 1915 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1916 ; true 1917 ). 1918process_pce_import(op(P,T,N), Src, _, _) :- 1919 xref_push_op(Src, P, T, N).
1925process_use_module2(File, Import, Src, Reexport) :-
1926 load_module_if_needed(File),
1927 ( xref_source_file(File, Path, Src)
1928 -> assert(uses_file(File, Src, Path)),
1929 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1930 -> assert_import(Src, Import, Export, Path, Reexport),
1931 forall(( member(Head, Meta),
1932 imported(Head, _, Path)
1933 ),
1934 process_meta_head(Src, Head))
1935 ; true
1936 )
1937 ; assert(uses_file(File, Src, '<not_found>'))
1938 ).1947load_module_if_needed(File) :- 1948 prolog:no_autoload_module(File), 1949 !, 1950 use_module(File, []). 1951load_module_if_needed(_). 1952 1953prologno_autoload_module(library(apply_macros)). 1954prologno_autoload_module(library(arithmetic)). 1955prologno_autoload_module(library(record)). 1956prologno_autoload_module(library(persistency)). 1957prologno_autoload_module(library(pldoc)). 1958prologno_autoload_module(library(settings)). 1959prologno_autoload_module(library(debug)). 1960prologno_autoload_module(library(plunit)). 1961prologno_autoload_module(library(macros)). 1962prologno_autoload_module(library(yall)).
1967process_requires(Import, Src) :- 1968 is_list(Import), 1969 !, 1970 require_list(Import, Src). 1971process_requires(Var, _Src) :- 1972 var(Var), 1973 !. 1974process_requires((A,B), Src) :- 1975 !, 1976 process_requires(A, Src), 1977 process_requires(B, Src). 1978process_requires(PI, Src) :- 1979 requires(PI, Src). 1980 1981require_list([], _). 1982require_list([H|T], Src) :- 1983 requires(H, Src), 1984 require_list(T, Src). 1985 1986requires(PI, _Src) :- 1987 '$pi_head'(PI, Head), 1988 '$get_predicate_attribute'(system:Head, defined, 1), 1989 !. 1990requires(PI, Src) :- 1991 '$pi_head'(PI, Head), 1992 '$pi_head'(Name/Arity, Head), 1993 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1994 ( imported(Head, Src, Library) 1995 -> true 1996 ; assertz(imported(Head, Src, Library)) 1997 ).
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.
2028xref_public_list(File, Src, Options) :-
2029 option(path(Path), Options, _),
2030 option(module(Module), Options, _),
2031 option(exports(Exports), Options, _),
2032 option(public(Public), Options, _),
2033 option(meta(Meta), Options, _),
2034 xref_source_file(File, Path, Src, Options),
2035 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
2057xref_public_list(File, Path, Export, Src) :- 2058 xref_source_file(File, Path, Src), 2059 public_list(Path, _, _, Export, _, []). 2060xref_public_list(File, Path, Module, Export, Meta, Src) :- 2061 xref_source_file(File, Path, Src), 2062 public_list(Path, Module, Meta, Export, _, []). 2063xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 2064 xref_source_file(File, Path, Src), 2065 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2075:- dynamic public_list_cache/6. 2076:- volatile public_list_cache/6. 2077 2078public_list(Path, Module, Meta, Export, Public, _Options) :- 2079 public_list_cache(Path, Modified, 2080 Module0, Meta0, Export0, Public0), 2081 time_file(Path, ModifiedNow), 2082 ( abs(Modified-ModifiedNow) < 0.0001 2083 -> !, 2084 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2085 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2086 fail 2087 ). 2088public_list(Path, Module, Meta, Export, Public, Options) :- 2089 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2090 ( Error = error(_,_), 2091 catch(time_file(Path, Modified), Error, fail) 2092 -> asserta(public_list_cache(Path, Modified, 2093 Module0, Meta0, Export0, Public0)) 2094 ; true 2095 ), 2096 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2097 2098public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2099 in_temporary_module( 2100 TempModule, 2101 true, 2102 public_list_diff(TempModule, Path, Module, 2103 Meta, [], Export, [], Public, [], Options)). 2104 2105 2106public_list_diff(TempModule, 2107 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2108 setup_call_cleanup( 2109 public_list_setup(TempModule, Path, In, State), 2110 phrase(read_directives(In, Options, [true]), Directives), 2111 public_list_cleanup(In, State)), 2112 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2113 2114public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2115 prolog_open_source(Path, In), 2116 '$set_source_module'(OldM, TempModule), 2117 set_xref(OldXref). 2118 2119public_list_cleanup(In, state(OldM, OldXref)) :- 2120 '$set_source_module'(OldM), 2121 set_prolog_flag(xref, OldXref), 2122 prolog_close_source(In). 2123 2124 2125read_directives(In, Options, State) --> 2126 { repeat, 2127 catch(prolog_read_source_term(In, Term, Expanded, 2128 [ process_comment(true), 2129 syntax_errors(error) 2130 ]), 2131 E, report_syntax_error(E, -, Options)) 2132 -> nonvar(Term), 2133 Term = (:-_) 2134 }, 2135 !, 2136 terms(Expanded, State, State1), 2137 read_directives(In, Options, State1). 2138read_directives(_, _, _) --> []. 2139 2140terms(Var, State, State) --> { var(Var) }, !. 2141terms([H|T], State0, State) --> 2142 !, 2143 terms(H, State0, State1), 2144 terms(T, State1, State). 2145terms((:-if(Cond)), State0, [True|State0]) --> 2146 !, 2147 { eval_cond(Cond, True) }. 2148terms((:-elif(Cond)), [True0|State], [True|State]) --> 2149 !, 2150 { eval_cond(Cond, True1), 2151 elif(True0, True1, True) 2152 }. 2153terms((:-else), [True0|State], [True|State]) --> 2154 !, 2155 { negate(True0, True) }. 2156terms((:-endif), [_|State], State) --> !. 2157terms(H, State, State) --> 2158 ( {State = [true|_]} 2159 -> [H] 2160 ; [] 2161 ). 2162 2163eval_cond(Cond, true) :- 2164 catch(Cond, _, fail), 2165 !. 2166eval_cond(_, false). 2167 2168elif(true, _, else_false) :- !. 2169elif(false, true, true) :- !. 2170elif(True, _, True). 2171 2172negate(true, false). 2173negate(false, true). 2174negate(else_false, else_false). 2175 2176public_list([(:- module(Module, Export0))|Decls], Path, 2177 Module, Meta, MT, Export, Rest, Public, PT) :- 2178 !, 2179 ( is_list(Export0) 2180 -> append(Export0, Reexport, Export) 2181 ; Reexport = Export 2182 ), 2183 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2184public_list([(:- encoding(_))|Decls], Path, 2185 Module, Meta, MT, Export, Rest, Public, PT) :- 2186 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2187 2188public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2189public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2190 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2191 !, 2192 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2193public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2194 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2195 2196public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2197 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2198public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2199 public_from_import(Import, Spec, Path, Reexport, Rest). 2200public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2201 phrase(meta_decls(Decl), Meta, MT). 2202public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2203 phrase(public_decls(Decl), Public, PT).
2209reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2210reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2211 !, 2212 xref_source_file(H, Path, Src), 2213 public_list(Path, _Module, Meta0, Export0, Public0, []), 2214 append(Meta0, MT1, Meta), 2215 append(Export0, ET1, Export), 2216 append(Public0, PT1, Public), 2217 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2218reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2219 xref_source_file(Spec, Path, Src), 2220 public_list(Path, _Module, Meta0, Export0, Public0, []), 2221 append(Meta0, MT, Meta), 2222 append(Export0, ET, Export), 2223 append(Public0, PT, Public). 2224 2225public_from_import(except(Map), Path, Src, Export, Rest) :- 2226 !, 2227 xref_public_list(Path, _, AllExports, Src), 2228 except(Map, AllExports, NewExports), 2229 append(NewExports, Rest, Export). 2230public_from_import(Import, _, _, Export, Rest) :- 2231 import_name_map(Import, Export, Rest).
2236except([], Exports, Exports). 2237except([PI0 as NewName|Map], Exports0, Exports) :- 2238 !, 2239 canonical_pi(PI0, PI), 2240 map_as(Exports0, PI, NewName, Exports1), 2241 except(Map, Exports1, Exports). 2242except([PI0|Map], Exports0, Exports) :- 2243 canonical_pi(PI0, PI), 2244 select(PI2, Exports0, Exports1), 2245 same_pi(PI, PI2), 2246 !, 2247 except(Map, Exports1, Exports). 2248 2249 2250map_as([PI|T], Repl, As, [PI2|T]) :- 2251 same_pi(Repl, PI), 2252 !, 2253 pi_as(PI, As, PI2). 2254map_as([H|T0], Repl, As, [H|T]) :- 2255 map_as(T0, Repl, As, T). 2256 2257pi_as(_/Arity, Name, Name/Arity). 2258pi_as(_//Arity, Name, Name//Arity). 2259 2260import_name_map([], L, L). 2261import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2262 !, 2263 import_name_map(T0, T, Tail). 2264import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2265 !, 2266 import_name_map(T0, T, Tail). 2267import_name_map([H|T0], [H|T], Tail) :- 2268 import_name_map(T0, T, Tail). 2269 2270canonical_pi(Name//Arity0, PI) :- 2271 integer(Arity0), 2272 !, 2273 PI = Name/Arity, 2274 Arity is Arity0 + 2. 2275canonical_pi(PI, PI). 2276 2277same_pi(Canonical, PI2) :- 2278 canonical_pi(PI2, Canonical). 2279 2280meta_decls(Var) --> 2281 { var(Var) }, 2282 !. 2283meta_decls((A,B)) --> 2284 !, 2285 meta_decls(A), 2286 meta_decls(B). 2287meta_decls(A) --> 2288 [A]. 2289 2290public_decls(Var) --> 2291 { var(Var) }, 2292 !. 2293public_decls((A,B)) --> 2294 !, 2295 public_decls(A), 2296 public_decls(B). 2297public_decls(A) --> 2298 [A]. 2299 2300 /******************************* 2301 * INCLUDE * 2302 *******************************/ 2303 2304process_include([], _) :- !. 2305process_include([H|T], Src) :- 2306 !, 2307 process_include(H, Src), 2308 process_include(T, Src). 2309process_include(File, Src) :- 2310 callable(File), 2311 !, 2312 ( once(xref_input(ParentSrc, _)), 2313 xref_source_file(File, Path, ParentSrc) 2314 -> ( ( uses_file(_, Src, Path) 2315 ; Path == Src 2316 ) 2317 -> true 2318 ; assert(uses_file(File, Src, Path)), 2319 ( xoption(Src, process_include(true)) 2320 -> findall(O, xoption(Src, O), Options), 2321 setup_call_cleanup( 2322 open_include_file(Path, In, Refs), 2323 collect(Src, Path, In, Options), 2324 close_include(In, Refs)) 2325 ; true 2326 ) 2327 ) 2328 ; assert(uses_file(File, Src, '<not_found>')) 2329 ). 2330process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2338open_include_file(Path, In, [Ref]) :- 2339 once(xref_input(_, Parent)), 2340 stream_property(Parent, encoding(Enc)), 2341 '$push_input_context'(xref_include), 2342 catch(( prolog:xref_open_source(Path, In) 2343 -> catch(set_stream(In, encoding(Enc)), 2344 error(_,_), true) % deal with non-file input 2345 ; include_encoding(Enc, Options), 2346 open(Path, read, In, Options) 2347 ), E, 2348 ( '$pop_input_context', throw(E))), 2349 catch(( peek_char(In, #) % Deal with #! script 2350 -> skip(In, 10) 2351 ; true 2352 ), E, 2353 ( close_include(In, []), throw(E))), 2354 asserta(xref_input(Path, In), Ref). 2355 2356include_encoding(wchar_t, []) :- !. 2357include_encoding(Enc, [encoding(Enc)]). 2358 2359 2360close_include(In, Refs) :- 2361 maplist(erase, Refs), 2362 close(In, [force(true)]), 2363 '$pop_input_context'.
2369process_foreign(Spec, Src) :- 2370 ground(Spec), 2371 current_foreign_library(Spec, Defined), 2372 !, 2373 ( xmodule(Module, Src) 2374 -> true 2375 ; Module = user 2376 ), 2377 process_foreign_defined(Defined, Module, Src). 2378process_foreign(_, _). 2379 2380process_foreign_defined([], _, _). 2381process_foreign_defined([H|T], M, Src) :- 2382 ( H = M:Head 2383 -> assert_foreign(Src, Head) 2384 ; assert_foreign(Src, H) 2385 ), 2386 process_foreign_defined(T, M, Src). 2387 2388 2389 /******************************* 2390 * CHR SUPPORT * 2391 *******************************/ 2392 2393/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2394This part of the file supports CHR. Our choice is between making special 2395hooks to make CHR expansion work and then handle the (complex) expanded 2396code or process the CHR source directly. The latter looks simpler, 2397though I don't like the idea of adding support for libraries to this 2398module. A file is supposed to be a CHR file if it uses a 2399use_module(library(chr) or contains a :- constraint/1 directive. As an 2400extra bonus we get the source-locations right :-) 2401- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2402 2403process_chr(@(_Name, Rule), Src) :- 2404 mode(chr, Src), 2405 process_chr(Rule, Src). 2406process_chr(pragma(Rule, _Pragma), Src) :- 2407 mode(chr, Src), 2408 process_chr(Rule, Src). 2409process_chr(<=>(Head, Body), Src) :- 2410 mode(chr, Src), 2411 chr_head(Head, Src, H), 2412 chr_body(Body, H, Src). 2413process_chr(==>(Head, Body), Src) :- 2414 mode(chr, Src), 2415 chr_head(Head, H, Src), 2416 chr_body(Body, H, Src). 2417process_chr((:- chr_constraint(_)), Src) :- 2418 ( mode(chr, Src) 2419 -> true 2420 ; assert(mode(chr, Src)) 2421 ). 2422 2423chr_head(X, _, _) :- 2424 var(X), 2425 !. % Illegal. Warn? 2426chr_head(\(A,B), Src, H) :- 2427 chr_head(A, Src, H), 2428 process_body(B, H, Src). 2429chr_head((H0,B), Src, H) :- 2430 chr_defined(H0, Src, H), 2431 process_body(B, H, Src). 2432chr_head(H0, Src, H) :- 2433 chr_defined(H0, Src, H). 2434 2435chr_defined(X, _, _) :- 2436 var(X), 2437 !. 2438chr_defined(#(C,_Id), Src, C) :- 2439 !, 2440 assert_constraint(Src, C). 2441chr_defined(A, Src, A) :- 2442 assert_constraint(Src, A). 2443 2444chr_body(X, From, Src) :- 2445 var(X), 2446 !, 2447 process_body(X, From, Src). 2448chr_body('|'(Guard, Goals), H, Src) :- 2449 !, 2450 chr_body(Guard, H, Src), 2451 chr_body(Goals, H, Src). 2452chr_body(G, From, Src) :- 2453 process_body(G, From, Src). 2454 2455assert_constraint(_, Head) :- 2456 var(Head), 2457 !. 2458assert_constraint(Src, Head) :- 2459 constraint(Head, Src, _), 2460 !. 2461assert_constraint(Src, Head) :- 2462 generalise_term(Head, Term), 2463 current_source_line(Line), 2464 assert(constraint(Term, Src, Line)). 2465 2466 2467 /******************************** 2468 * PHASE 1 ASSERTIONS * 2469 ********************************/
2476assert_called(_, _, Var, _) :- 2477 var(Var), 2478 !. 2479assert_called(Src, From, Goal, Line) :- 2480 var(From), 2481 !, 2482 assert_called(Src, '<unknown>', Goal, Line). 2483assert_called(_, _, Goal, _) :- 2484 expand_hide_called(Goal), 2485 !. 2486assert_called(Src, Origin, M:G, Line) :- 2487 !, 2488 ( atom(M), 2489 callable(G) 2490 -> current_condition(Cond), 2491 ( xmodule(M, Src) % explicit call to own module 2492 -> assert_called(Src, Origin, G, Line) 2493 ; called(M:G, Src, Origin, Cond, Line) % already registered 2494 -> true 2495 ; hide_called(M:G, Src) % not interesting (now) 2496 -> true 2497 ; generalise(Origin, OTerm), 2498 generalise(G, GTerm) 2499 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2500 ; true 2501 ) 2502 ; true % call to variable module 2503 ). 2504assert_called(Src, _, Goal, _) :- 2505 ( xmodule(M, Src) 2506 -> M \== system 2507 ; M = user 2508 ), 2509 hide_called(M:Goal, Src), 2510 !. 2511assert_called(Src, Origin, Goal, Line) :- 2512 current_condition(Cond), 2513 ( called(Goal, Src, Origin, Cond, Line) 2514 -> true 2515 ; generalise(Origin, OTerm), 2516 generalise(Goal, Term) 2517 -> assert(called(Term, Src, OTerm, Cond, Line)) 2518 ; true 2519 ).
2527expand_hide_called(pce_principal:send_implementation(_, _, _)). 2528expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2529expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2530expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2531 2532assert_defined(Src, Goal) :- 2533 Goal = test(_Test), 2534 current_test_unit(Unit, Line), 2535 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2536 fail. 2537assert_defined(Src, Goal) :- 2538 Goal = test(_Test, _Options), 2539 current_test_unit(Unit, Line), 2540 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2541 fail. 2542assert_defined(Src, Goal) :- 2543 defined(Goal, Src, _), 2544 !. 2545assert_defined(Src, Goal) :- 2546 generalise(Goal, Term), 2547 current_source_line(Line), 2548 assert(defined(Term, Src, Line)). 2549 2550assert_foreign(Src, Goal) :- 2551 foreign(Goal, Src, _), 2552 !. 2553assert_foreign(Src, Goal) :- 2554 generalise(Goal, Term), 2555 current_source_line(Line), 2556 assert(foreign(Term, Src, Line)). 2557 2558assert_grammar_rule(Src, Goal) :- 2559 grammar_rule(Goal, Src), 2560 !. 2561assert_grammar_rule(Src, Goal) :- 2562 generalise(Goal, Term), 2563 assert(grammar_rule(Term, Src)).
true, re-export the
imported predicates.
2576assert_import(_, [], _, _, _) :- !. 2577assert_import(Src, [H|T], Export, From, Reexport) :- 2578 !, 2579 assert_import(Src, H, Export, From, Reexport), 2580 assert_import(Src, T, Export, From, Reexport). 2581assert_import(Src, except(Except), Export, From, Reexport) :- 2582 !, 2583 is_list(Export), 2584 !, 2585 except(Except, Export, Import), 2586 assert_import(Src, Import, _All, From, Reexport). 2587assert_import(Src, Import as Name, Export, From, Reexport) :- 2588 !, 2589 pi_to_head(Import, Term0), 2590 rename_goal(Term0, Name, Term), 2591 ( in_export_list(Term0, Export) 2592 -> assert(imported(Term, Src, From)), 2593 assert_reexport(Reexport, Src, Term) 2594 ; current_source_line(Line), 2595 assert_called(Src, '<directive>'(Line), Term0, Line) 2596 ). 2597assert_import(Src, Import, Export, From, Reexport) :- 2598 pi_to_head(Import, Term), 2599 !, 2600 ( in_export_list(Term, Export) 2601 -> assert(imported(Term, Src, From)), 2602 assert_reexport(Reexport, Src, Term) 2603 ; current_source_line(Line), 2604 assert_called(Src, '<directive>'(Line), Term, Line) 2605 ). 2606assert_import(Src, op(P,T,N), _, _, _) :- 2607 xref_push_op(Src, P,T,N). 2608 2609in_export_list(_Head, Export) :- 2610 var(Export), 2611 !. 2612in_export_list(Head, Export) :- 2613 member(PI, Export), 2614 pi_to_head(PI, Head). 2615 2616assert_reexport(false, _, _) :- !. 2617assert_reexport(true, Src, Term) :- 2618 assert(exported(Term, Src)).
2624process_import(M:PI, Src) :- 2625 pi_to_head(PI, Head), 2626 !, 2627 ( atom(M), 2628 current_module(M), 2629 module_property(M, file(From)) 2630 -> true 2631 ; From = '<unknown>' 2632 ), 2633 assert(imported(Head, Src, From)). 2634process_import(_, _).
2643assert_xmodule_callable([], _, _, _). 2644assert_xmodule_callable([PI|T], M, Src, From) :- 2645 ( pi_to_head(M:PI, Head) 2646 -> assert(imported(Head, Src, From)) 2647 ; true 2648 ), 2649 assert_xmodule_callable(T, M, Src, From).
2656assert_op(Src, op(P,T,M:N)) :-
2657 ( '$current_source_module'(M)
2658 -> Name = N
2659 ; Name = M:N
2660 ),
2661 ( xop(Src, op(P,T,Name))
2662 -> true
2663 ; assert(xop(Src, op(P,T,Name)))
2664 ).2671assert_module(Src, Module) :- 2672 xmodule(Module, Src), 2673 !. 2674assert_module(Src, Module) :- 2675 '$set_source_module'(Module), 2676 assert(xmodule(Module, Src)), 2677 ( module_property(Module, class(system)) 2678 -> retractall(xoption(Src, register_called(_))), 2679 assert(xoption(Src, register_called(all))) 2680 ; true 2681 ). 2682 2683assert_module_export(_, []) :- !. 2684assert_module_export(Src, [H|T]) :- 2685 !, 2686 assert_module_export(Src, H), 2687 assert_module_export(Src, T). 2688assert_module_export(Src, PI) :- 2689 pi_to_head(PI, Term), 2690 !, 2691 assert(exported(Term, Src)). 2692assert_module_export(Src, op(P, A, N)) :- 2693 xref_push_op(Src, P, A, N).
2699assert_module3([], _) :- !. 2700assert_module3([H|T], Src) :- 2701 !, 2702 assert_module3(H, Src), 2703 assert_module3(T, Src). 2704assert_module3(Option, Src) :- 2705 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2714process_predicates(Closure, Preds, Src) :- 2715 is_list(Preds), 2716 !, 2717 process_predicate_list(Preds, Closure, Src). 2718process_predicates(Closure, as(Preds, _Options), Src) :- 2719 !, 2720 process_predicates(Closure, Preds, Src). 2721process_predicates(Closure, Preds, Src) :- 2722 process_predicate_comma(Preds, Closure, Src). 2723 2724process_predicate_list([], _, _). 2725process_predicate_list([H|T], Closure, Src) :- 2726 ( nonvar(H) 2727 -> call(Closure, H, Src) 2728 ; true 2729 ), 2730 process_predicate_list(T, Closure, Src). 2731 2732process_predicate_comma(Var, _, _) :- 2733 var(Var), 2734 !. 2735process_predicate_comma(M:(A,B), Closure, Src) :- 2736 !, 2737 process_predicate_comma(M:A, Closure, Src), 2738 process_predicate_comma(M:B, Closure, Src). 2739process_predicate_comma((A,B), Closure, Src) :- 2740 !, 2741 process_predicate_comma(A, Closure, Src), 2742 process_predicate_comma(B, Closure, Src). 2743process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2744 !, 2745 process_predicate_comma(Spec, Closure, Src). 2746process_predicate_comma(A, Closure, Src) :- 2747 call(Closure, A, Src). 2748 2749 2750assert_dynamic(PI, Src) :- 2751 pi_to_head(PI, Term), 2752 ( thread_local(Term, Src, _) % dynamic after thread_local has 2753 -> true % no effect 2754 ; current_source_line(Line), 2755 assert(dynamic(Term, Src, Line)) 2756 ). 2757 2758assert_thread_local(PI, Src) :- 2759 pi_to_head(PI, Term), 2760 current_source_line(Line), 2761 assert(thread_local(Term, Src, Line)). 2762 2763assert_multifile(PI, Src) :- % :- multifile(Spec) 2764 pi_to_head(PI, Term), 2765 current_source_line(Line), 2766 assert(multifile(Term, Src, Line)). 2767 2768assert_public(PI, Src) :- % :- public(Spec) 2769 pi_to_head(PI, Term), 2770 current_source_line(Line), 2771 assert_called(Src, '<public>'(Line), Term, Line), 2772 assert(public(Term, Src, Line)). 2773 2774assert_export(PI, Src) :- % :- export(Spec) 2775 pi_to_head(PI, Term), 2776 !, 2777 assert(exported(Term, Src)).
2784pi_to_head(Var, _) :- 2785 var(Var), !, fail. 2786pi_to_head(M:PI, M:Term) :- 2787 !, 2788 pi_to_head(PI, Term). 2789pi_to_head(Name/Arity, Term) :- 2790 functor(Term, Name, Arity). 2791pi_to_head(Name//DCGArity, Term) :- 2792 Arity is DCGArity+2, 2793 functor(Term, Name, Arity). 2794 2795 2796assert_used_class(Src, Name) :- 2797 used_class(Name, Src), 2798 !. 2799assert_used_class(Src, Name) :- 2800 assert(used_class(Name, Src)). 2801 2802assert_defined_class(Src, Name, _Meta, _Super, _) :- 2803 defined_class(Name, _, _, Src, _), 2804 !. 2805assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2806assert_defined_class(Src, Name, Meta, Super, Summary) :- 2807 current_source_line(Line), 2808 ( Summary == @(default) 2809 -> Atom = '' 2810 ; is_list(Summary) 2811 -> atom_codes(Atom, Summary) 2812 ; string(Summary) 2813 -> atom_concat(Summary, '', Atom) 2814 ), 2815 assert(defined_class(Name, Super, Atom, Src, Line)), 2816 ( Meta = @(_) 2817 -> true 2818 ; assert_used_class(Src, Meta) 2819 ), 2820 assert_used_class(Src, Super). 2821 2822assert_defined_class(Src, Name, imported_from(_File)) :- 2823 defined_class(Name, _, _, Src, _), 2824 !. 2825assert_defined_class(Src, Name, imported_from(File)) :- 2826 assert(defined_class(Name, _, '', Src, file(File))). 2827 2828 2829 /******************************** 2830 * UTILITIES * 2831 ********************************/
2837generalise(Var, Var) :- 2838 var(Var), 2839 !. % error? 2840generalise(pce_principal:send_implementation(Id, _, _), 2841 pce_principal:send_implementation(Id, _, _)) :- 2842 atom(Id), 2843 !. 2844generalise(pce_principal:get_implementation(Id, _, _, _), 2845 pce_principal:get_implementation(Id, _, _, _)) :- 2846 atom(Id), 2847 !. 2848generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2849generalise(test(Test), test(Test)) :- 2850 current_test_unit(_,_), 2851 ground(Test), 2852 !. 2853generalise(test(Test, _), test(Test, _)) :- 2854 current_test_unit(_,_), 2855 ground(Test), 2856 !. 2857generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !. 2858generalise(Module:Goal0, Module:Goal) :- 2859 atom(Module), 2860 !, 2861 generalise(Goal0, Goal). 2862generalise(Term0, Term) :- 2863 callable(Term0), 2864 generalise_term(Term0, Term). 2865 2866 2867 /******************************* 2868 * SOURCE MANAGEMENT * 2869 *******************************/ 2870 2871/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2872This section of the file contains hookable predicates to reason about 2873sources. The built-in code here can only deal with files. The XPCE 2874library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2875can do cross-referencing on PceEmacs edit buffers. Other examples for 2876hooking can be databases, (HTTP) URIs, etc. 2877- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2878 2879:- multifile 2880 prolog:xref_source_directory/2, % +Source, -Dir 2881 prolog:xref_source_file/3. % +Spec, -Path, +Options
2889xref_source_file(Plain, File, Source) :- 2890 xref_source_file(Plain, File, Source, []). 2891 2892xref_source_file(QSpec, File, Source, Options) :- 2893 nonvar(QSpec), QSpec = _:Spec, 2894 !, 2895 must_be(acyclic, Spec), 2896 xref_source_file(Spec, File, Source, Options). 2897xref_source_file(Spec, File, Source, Options) :- 2898 nonvar(Spec), 2899 prolog:xref_source_file(Spec, File, 2900 [ relative_to(Source) 2901 | Options 2902 ]), 2903 !. 2904xref_source_file(Plain, File, Source, Options) :- 2905 atom(Plain), 2906 \+ is_absolute_file_name(Plain), 2907 ( prolog:xref_source_directory(Source, Dir) 2908 -> true 2909 ; atom(Source), 2910 file_directory_name(Source, Dir) 2911 ), 2912 atomic_list_concat([Dir, /, Plain], Spec0), 2913 absolute_file_name(Spec0, Spec), 2914 do_xref_source_file(Spec, File, Options), 2915 !. 2916xref_source_file(Spec, File, Source, Options) :- 2917 do_xref_source_file(Spec, File, 2918 [ relative_to(Source) 2919 | Options 2920 ]), 2921 !. 2922xref_source_file(_, _, _, Options) :- 2923 option(silent(true), Options), 2924 !, 2925 fail. 2926xref_source_file(Spec, _, Src, _Options) :- 2927 verbose(Src), 2928 print_message(warning, error(existence_error(file, Spec), _)), 2929 fail. 2930 2931do_xref_source_file(Spec, File, Options) :- 2932 nonvar(Spec), 2933 option(file_type(Type), Options, prolog), 2934 absolute_file_name(Spec, File, 2935 [ file_type(Type), 2936 access(read), 2937 file_errors(fail) 2938 ]), 2939 !.
2945canonical_source(Source, Src) :-
2946 ( ground(Source)
2947 -> prolog_canonical_source(Source, Src)
2948 ; Source = Src
2949 ).name()
goals.2956goal_name_arity(Goal, Name, Arity) :- 2957 ( compound(Goal) 2958 -> compound_name_arity(Goal, Name, Arity) 2959 ; atom(Goal) 2960 -> Name = Goal, Arity = 0 2961 ). 2962 2963generalise_term(Specific, General) :- 2964 ( compound(Specific) 2965 -> compound_name_arity(Specific, Name, Arity), 2966 compound_name_arity(General, Name, Arity) 2967 ; General = Specific 2968 ). 2969 2970functor_name(Term, Name) :- 2971 ( compound(Term) 2972 -> compound_name_arity(Term, Name, _) 2973 ; atom(Term) 2974 -> Name = Term 2975 ). 2976 2977rename_goal(Goal0, Name, Goal) :- 2978 ( compound(Goal0) 2979 -> compound_name_arity(Goal0, _, Arity), 2980 compound_name_arity(Goal, Name, Arity) 2981 ; Goal = Name 2982 )
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.