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:- autoload(library(debug),[debug/3]). 74:- autoload(library(dialect),[expects_dialect/1]). 75:- autoload(library(error),[must_be/2,instantiation_error/1]). 76:- autoload(library(lists),[member/2,append/2,append/3,select/3]). 77:- autoload(library(modules),[in_temporary_module/3]). 78:- autoload(library(operators),[push_op/3]). 79:- autoload(library(option),[option/2,option/3]). 80:- autoload(library(ordsets),[ord_intersect/2,ord_intersection/3]). 81:- autoload(library(prolog_code), [pi_head/2]). 82:- autoload(library(prolog_source), 83 [ prolog_canonical_source/2, 84 prolog_open_source/2, 85 prolog_close_source/1, 86 prolog_read_source_term/4 87 ]). 88 89:- if(exists_source(library(shlib))). 90:- autoload(library(shlib),[current_foreign_library/2]). 91:- endif. 92:- autoload(library(solution_sequences),[distinct/2,limit/2]). 93 94:- if(exists_source(library(pldoc))). 95:- use_module(library(pldoc), []). % Must be loaded before doc_process 96:- use_module(library(pldoc/doc_process)). 97 98:- endif. 99 100:- predicate_options(xref_source/2, 2, 101 [ silent(boolean), 102 module(atom), 103 register_called(oneof([all,non_iso,non_built_in])), 104 comments(oneof([store,collect,ignore])), 105 process_include(boolean) 106 ]). 107 108 109:- dynamic 110 called/5, % Head, Src, From, Cond, Line 111 (dynamic)/3, % Head, Src, Line 112 (thread_local)/3, % Head, Src, Line 113 (multifile)/3, % Head, Src, Line 114 (public)/3, % Head, Src, Line 115 defined/3, % Head, Src, Line 116 meta_goal/3, % Head, Called, Src 117 foreign/3, % Head, Src, Line 118 constraint/3, % Head, Src, Line 119 imported/3, % Head, Src, From 120 exported/2, % Head, Src 121 xmodule/2, % Module, Src 122 uses_file/3, % Spec, Src, Path 123 xop/2, % Src, Op 124 source/2, % Src, Time 125 used_class/2, % Name, Src 126 defined_class/5, % Name, Super, Summary, Src, Line 127 (mode)/2, % Mode, Src 128 xoption/2, % Src, Option 129 xflag/4, % Name, Value, Src, Line 130 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).
435set_initial_mode(_Stream, Options) :- 436 option(module(Module), Options), 437 !, 438 '$set_source_module'(Module). 439set_initial_mode(Stream, _) :- 440 stream_property(Stream, file_name(Path)), 441 source_file_property(Path, load_context(M, _, Opts)), 442 !, 443 '$set_source_module'(M), 444 ( option(dialect(Dialect), Opts) 445 -> expects_dialect(Dialect) 446 ; true 447 ). 448set_initial_mode(_, _) :- 449 '$set_source_module'(user).
455xref_input_stream(Stream) :-
456 xref_input(_, Var),
457 !,
458 Stream = Var.465xref_push_op(Src, P, T, N0) :- 466 '$current_source_module'(M0), 467 strip_module(M0:N0, M, N), 468 ( is_list(N), 469 N \== [] 470 -> maplist(push_op(Src, P, T, M), N) 471 ; push_op(Src, P, T, M, N) 472 ). 473 474push_op(Src, P, T, M0, N0) :- 475 strip_module(M0:N0, M, N), 476 Name = M:N, 477 valid_op(op(P,T,Name)), 478 push_op(P, T, Name), 479 assert_op(Src, op(P,T,Name)), 480 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 481 482valid_op(op(P,T,M:N)) :- 483 atom(M), 484 valid_op_name(N), 485 integer(P), 486 between(0, 1200, P), 487 atom(T), 488 op_type(T). 489 490valid_op_name(N) :- 491 atom(N), 492 !. 493valid_op_name(N) :- 494 N == []. 495 496op_type(xf). 497op_type(yf). 498op_type(fx). 499op_type(fy). 500op_type(xfx). 501op_type(xfy). 502op_type(yfx).
508xref_set_prolog_flag(Flag, Value, Src, Line) :- 509 atom(Flag), 510 !, 511 assertz(xflag(Flag, Value, Src, Line)). 512xref_set_prolog_flag(_, _, _, _).
518xref_clean(Source) :- 519 prolog_canonical_source(Source, Src), 520 retractall(called(_, Src, _Origin, _Cond, _Line)), 521 retractall(dynamic(_, Src, Line)), 522 retractall(multifile(_, Src, Line)), 523 retractall(public(_, Src, Line)), 524 retractall(defined(_, Src, Line)), 525 retractall(meta_goal(_, _, Src)), 526 retractall(foreign(_, Src, Line)), 527 retractall(constraint(_, Src, Line)), 528 retractall(imported(_, Src, _From)), 529 retractall(exported(_, Src)), 530 retractall(uses_file(_, Src, _)), 531 retractall(xmodule(_, Src)), 532 retractall(xop(Src, _)), 533 retractall(grammar_rule(_, Src)), 534 retractall(xoption(Src, _)), 535 retractall(xflag(_Name, _Value, Src, Line)), 536 retractall(source(Src, _)), 537 retractall(used_class(_, Src)), 538 retractall(defined_class(_, _, _, Src, _)), 539 retractall(mode(_, Src)), 540 retractall(module_comment(Src, _, _)), 541 retractall(pred_comment(_, Src, _, _)), 542 retractall(pred_comment_link(_, Src, _)), 543 retractall(pred_mode(_, Src, _)). 544 545 546 /******************************* 547 * READ RESULTS * 548 *******************************/
554xref_current_source(Source) :-
555 source(Source, _Time).
562xref_done(Source, Time) :-
563 prolog_canonical_source(Source, Src),
564 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.
586xref_called(Source, Called, By) :- 587 xref_called(Source, Called, By, _). 588 589xref_called(Source, Called, By, Cond) :- 590 canonical_source(Source, Src), 591 distinct(Called-By, called(Called, Src, By, Cond, _)). 592 593xref_called(Source, Called, By, Cond, Line) :- 594 canonical_source(Source, Src), 595 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)617xref_defined(Source, Called, How) :- 618 nonvar(Source), 619 !, 620 canonical_source(Source, Src), 621 xref_defined2(How, Src, Called). 622xref_defined(Source, Called, How) :- 623 xref_defined2(How, Src, Called), 624 canonical_source(Source, Src). 625 626xref_defined2(dynamic(Line), Src, Called) :- 627 dynamic(Called, Src, Line). 628xref_defined2(thread_local(Line), Src, Called) :- 629 thread_local(Called, Src, Line). 630xref_defined2(multifile(Line), Src, Called) :- 631 multifile(Called, Src, Line). 632xref_defined2(public(Line), Src, Called) :- 633 public(Called, Src, Line). 634xref_defined2(local(Line), Src, Called) :- 635 defined(Called, Src, Line). 636xref_defined2(foreign(Line), Src, Called) :- 637 foreign(Called, Src, Line). 638xref_defined2(constraint(Line), Src, Called) :- 639 constraint(Called, Src, Line). 640xref_defined2(imported(From), Src, Called) :- 641 imported(Called, Src, From). 642xref_defined2(dcg, Src, Called) :- 643 grammar_rule(Called, Src).
651xref_definition_line(local(Line), Line). 652xref_definition_line(dynamic(Line), Line). 653xref_definition_line(thread_local(Line), Line). 654xref_definition_line(multifile(Line), Line). 655xref_definition_line(public(Line), Line). 656xref_definition_line(constraint(Line), Line). 657xref_definition_line(foreign(Line), Line).
664xref_exported(Source, Called) :-
665 prolog_canonical_source(Source, Src),
666 exported(Called, Src).672xref_module(Source, Module) :- 673 nonvar(Source), 674 !, 675 prolog_canonical_source(Source, Src), 676 xmodule(Module, Src). 677xref_module(Source, Module) :- 678 xmodule(Module, Src), 679 prolog_canonical_source(Source, Src).
689xref_uses_file(Source, Spec, Path) :-
690 prolog_canonical_source(Source, Src),
691 uses_file(Spec, Src, Path).
701xref_op(Source, Op) :-
702 prolog_canonical_source(Source, Src),
703 xop(Src, Op).711xref_prolog_flag(Source, Flag, Value, Line) :- 712 prolog_canonical_source(Source, Src), 713 xflag(Flag, Value, Src, Line). 714 715xref_built_in(Head) :- 716 system_predicate(Head). 717 718xref_used_class(Source, Class) :- 719 prolog_canonical_source(Source, Src), 720 used_class(Class, Src). 721 722xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 723 prolog_canonical_source(Source, Src), 724 defined_class(Class, Super, Summary, Src, Line), 725 integer(Line), 726 !. 727xref_defined_class(Source, Class, file(File)) :- 728 prolog_canonical_source(Source, Src), 729 defined_class(Class, _, _, Src, file(File)). 730 731:- thread_local 732 current_cond/1, 733 source_line/1, 734 current_test_unit/2. 735 736current_source_line(Line) :- 737 source_line(Var), 738 !, 739 Line = Var.
747collect(Src, File, In, Options) :- 748 ( Src == File 749 -> SrcSpec = Line 750 ; SrcSpec = (File:Line) 751 ), 752 option(comments(CommentHandling), Options, collect), 753 ( CommentHandling == ignore 754 -> CommentOptions = [], 755 Comments = [] 756 ; CommentHandling == store 757 -> CommentOptions = [ process_comment(true) ], 758 Comments = [], 759 set_prolog_flag(xref_store_comments, true) 760 ; CommentOptions = [ comments(Comments) ] 761 ), 762 repeat, 763 catch(prolog_read_source_term( 764 In, Term, Expanded, 765 [ term_position(TermPos) 766 | CommentOptions 767 ]), 768 E, report_syntax_error(E, Src, [])), 769 update_condition(Term), 770 stream_position_data(line_count, TermPos, Line), 771 setup_call_cleanup( 772 asserta(source_line(SrcSpec), Ref), 773 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 774 E, print_message(error, E)), 775 erase(Ref)), 776 EOF == true, 777 !, 778 set_prolog_flag(xref_store_comments, false). 779 780report_syntax_error(E, _, _) :- 781 fatal_error(E), 782 throw(E). 783report_syntax_error(_, _, Options) :- 784 option(silent(true), Options), 785 !, 786 fail. 787report_syntax_error(E, Src, _Options) :- 788 ( verbose(Src) 789 -> print_message(error, E) 790 ; true 791 ), 792 fail. 793 794fatal_error(time_limit_exceeded). 795fatal_error(error(resource_error(_),_)).
801update_condition((:-Directive)) :- 802 !, 803 update_cond(Directive). 804update_condition(_). 805 806update_cond(if(Cond)) :- 807 !, 808 asserta(current_cond(Cond)). 809update_cond(else) :- 810 retract(current_cond(C0)), 811 !, 812 assert(current_cond(\+C0)). 813update_cond(elif(Cond)) :- 814 retract(current_cond(C0)), 815 !, 816 assert(current_cond((\+C0,Cond))). 817update_cond(endif) :- 818 retract(current_cond(_)), 819 !. 820update_cond(_).
827current_condition(Condition) :- 828 \+ current_cond(_), 829 !, 830 Condition = true. 831current_condition(Condition) :- 832 findall(C, current_cond(C), List), 833 list_to_conj(List, Condition). 834 835list_to_conj([], true). 836list_to_conj([C], C) :- !. 837list_to_conj([H|T], (H,C)) :- 838 list_to_conj(T, C). 839 840 841 /******************************* 842 * PROCESS * 843 *******************************/
855process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 856 is_list(Expanded), % term_expansion into list. 857 !, 858 ( member(Term, Expanded), 859 process(Term, Term0, Src), 860 Term == end_of_file 861 -> EOF = true 862 ; EOF = false 863 ), 864 xref_comments(Comments, TermPos, Src). 865process(end_of_file, _, _, _, _, true) :- 866 !. 867process(Term, Comments, Term0, TermPos, Src, false) :- 868 process(Term, Term0, Src), 869 xref_comments(Comments, TermPos, Src).
873process(_, Term0, _) :- 874 ignore_raw_term(Term0), 875 !. 876process(Head :- Body, Head0 --> _, Src) :- 877 pi_head(F/A, Head), 878 pi_head(F/A0, Head0), 879 A =:= A0 + 2, 880 !, 881 assert_grammar_rule(Src, Head), 882 process((Head :- Body), Src). 883process(Term, _Term0, Src) :- 884 process(Term, Src). 885 886ignore_raw_term((:- predicate_options(_,_,_))).
890process(Var, _) :- 891 var(Var), 892 !. % Warn? 893process(end_of_file, _) :- !. 894process((:- Directive), Src) :- 895 !, 896 process_directive(Directive, Src), 897 !. 898process((?- Directive), Src) :- 899 !, 900 process_directive(Directive, Src), 901 !. 902process((Head :- Body), Src) :- 903 !, 904 assert_defined(Src, Head), 905 process_body(Body, Head, Src). 906process((Left => Body), Src) :- 907 !, 908 ( nonvar(Left), 909 Left = (Head, Guard) 910 -> assert_defined(Src, Head), 911 process_body(Guard, Head, Src), 912 process_body(Body, Head, Src) 913 ; assert_defined(Src, Left), 914 process_body(Body, Left, Src) 915 ). 916process(?=>(Head, Body), Src) :- 917 !, 918 assert_defined(Src, Head), 919 process_body(Body, Head, Src). 920process('$source_location'(_File, _Line):Clause, Src) :- 921 !, 922 process(Clause, Src). 923process(Term, Src) :- 924 process_chr(Term, Src), 925 !. 926process(M:(Head :- Body), Src) :- 927 !, 928 process((M:Head :- M:Body), Src). 929process(Head, Src) :- 930 assert_defined(Src, Head). 931 932 933 /******************************* 934 * COMMENTS * 935 *******************************/
939xref_comments([], _Pos, _Src). 940:- if(current_predicate(parse_comment/3)). 941xref_comments([Pos-Comment|T], TermPos, Src) :- 942 ( Pos @> TermPos % comments inside term 943 -> true 944 ; stream_position_data(line_count, Pos, Line), 945 FilePos = Src:Line, 946 ( parse_comment(Comment, FilePos, Parsed) 947 -> assert_comments(Parsed, Src) 948 ; true 949 ), 950 xref_comments(T, TermPos, Src) 951 ). 952 953assert_comments([], _). 954assert_comments([H|T], Src) :- 955 assert_comment(H, Src), 956 assert_comments(T, Src). 957 958assert_comment(section(_Id, Title, Comment), Src) :- 959 assertz(module_comment(Src, Title, Comment)). 960assert_comment(predicate(PI, Summary, Comment), Src) :- 961 pi_to_head(PI, Src, Head), 962 assertz(pred_comment(Head, Src, Summary, Comment)). 963assert_comment(link(PI, PITo), Src) :- 964 pi_to_head(PI, Src, Head), 965 pi_to_head(PITo, Src, HeadTo), 966 assertz(pred_comment_link(Head, Src, HeadTo)). 967assert_comment(mode(Head, Det), Src) :- 968 assertz(pred_mode(Head, Src, Det)). 969 970pi_to_head(PI, Src, Head) :- 971 pi_to_head(PI, Head0), 972 ( Head0 = _:_ 973 -> strip_module(Head0, M, Plain), 974 ( xmodule(M, Src) 975 -> Head = Plain 976 ; Head = M:Plain 977 ) 978 ; Head = Head0 979 ). 980:- endif.
986xref_comment(Source, Title, Comment) :-
987 canonical_source(Source, Src),
988 module_comment(Src, Title, Comment).
994xref_comment(Source, Head, Summary, Comment) :-
995 canonical_source(Source, Src),
996 ( pred_comment(Head, Src, Summary, Comment)
997 ; pred_comment_link(Head, Src, HeadTo),
998 pred_comment(HeadTo, Src, Summary, Comment)
999 ).
1006xref_mode(Source, Mode, Det) :-
1007 canonical_source(Source, Src),
1008 pred_mode(Mode, Src, Det).1015xref_option(Source, Option) :- 1016 canonical_source(Source, Src), 1017 xoption(Src, Option). 1018 1019 1020 /******************************** 1021 * DIRECTIVES * 1022 ********************************/ 1023 1024process_directive(Var, _) :- 1025 var(Var), 1026 !. % error, but that isn't our business 1027process_directive(Dir, _Src) :- 1028 debug(xref(directive), 'Processing :- ~q', [Dir]), 1029 fail. 1030process_directive((A,B), Src) :- % TBD: what about other control 1031 !, 1032 process_directive(A, Src), % structures? 1033 process_directive(B, Src). 1034process_directive(List, Src) :- 1035 is_list(List), 1036 !, 1037 process_directive(consult(List), Src). 1038process_directive(use_module(File, Import), Src) :- 1039 process_use_module2(File, Import, Src, false). 1040process_directive(autoload(File, Import), Src) :- 1041 process_use_module2(File, Import, Src, false). 1042process_directive(require(Import), Src) :- 1043 process_requires(Import, Src). 1044process_directive(expects_dialect(Dialect), Src) :- 1045 process_directive(use_module(library(dialect/Dialect)), Src), 1046 expects_dialect(Dialect). 1047process_directive(reexport(File, Import), Src) :- 1048 process_use_module2(File, Import, Src, true). 1049process_directive(reexport(Modules), Src) :- 1050 process_use_module(Modules, Src, true). 1051process_directive(autoload(Modules), Src) :- 1052 process_use_module(Modules, Src, false). 1053process_directive(use_module(Modules), Src) :- 1054 process_use_module(Modules, Src, false). 1055process_directive(consult(Modules), Src) :- 1056 process_use_module(Modules, Src, false). 1057process_directive(ensure_loaded(Modules), Src) :- 1058 process_use_module(Modules, Src, false). 1059process_directive(load_files(Files, _Options), Src) :- 1060 process_use_module(Files, Src, false). 1061process_directive(include(Files), Src) :- 1062 process_include(Files, Src). 1063process_directive(dynamic(Dynamic), Src) :- 1064 process_predicates(assert_dynamic, Dynamic, Src). 1065process_directive(dynamic(Dynamic, _Options), Src) :- 1066 process_predicates(assert_dynamic, Dynamic, Src). 1067process_directive(thread_local(Dynamic), Src) :- 1068 process_predicates(assert_thread_local, Dynamic, Src). 1069process_directive(multifile(Dynamic), Src) :- 1070 process_predicates(assert_multifile, Dynamic, Src). 1071process_directive(public(Public), Src) :- 1072 process_predicates(assert_public, Public, Src). 1073process_directive(export(Export), Src) :- 1074 process_predicates(assert_export, Export, Src). 1075process_directive(import(Import), Src) :- 1076 process_import(Import, Src). 1077process_directive(module(Module, Export), Src) :- 1078 assert_module(Src, Module), 1079 assert_module_export(Src, Export). 1080process_directive(module(Module, Export, Import), Src) :- 1081 assert_module(Src, Module), 1082 assert_module_export(Src, Export), 1083 assert_module3(Import, Src). 1084process_directive(begin_tests(Unit, _Options), Src) :- 1085 enter_test_unit(Unit, Src). 1086process_directive(begin_tests(Unit), Src) :- 1087 enter_test_unit(Unit, Src). 1088process_directive(end_tests(Unit), Src) :- 1089 leave_test_unit(Unit, Src). 1090process_directive('$set_source_module'(system), Src) :- 1091 assert_module(Src, system). % hack for handling boot/init.pl 1092process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1093 assert_defined_class(Src, Name, Meta, Super, Doc). 1094process_directive(pce_autoload(Name, From), Src) :- 1095 assert_defined_class(Src, Name, imported_from(From)). 1096 1097process_directive(op(P, A, N), Src) :- 1098 xref_push_op(Src, P, A, N). 1099process_directive(set_prolog_flag(Flag, Value), Src) :- 1100 ( Flag == character_escapes 1101 -> set_prolog_flag(character_escapes, Value) 1102 ; true 1103 ), 1104 current_source_line(Line), 1105 xref_set_prolog_flag(Flag, Value, Src, Line). 1106process_directive(style_check(X), _) :- 1107 style_check(X). 1108process_directive(encoding(Enc), _) :- 1109 ( xref_input_stream(Stream) 1110 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1111 ; true % can this happen? 1112 ). 1113process_directive(pce_expansion:push_compile_operators, _) :- 1114 '$current_source_module'(SM), 1115 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1116process_directive(pce_expansion:pop_compile_operators, _) :- 1117 call(pce_expansion:pop_compile_operators). 1118process_directive(meta_predicate(Meta), Src) :- 1119 process_meta_predicate(Meta, Src). 1120process_directive(arithmetic_function(FSpec), Src) :- 1121 arith_callable(FSpec, Goal), 1122 !, 1123 current_source_line(Line), 1124 assert_called(Src, '<directive>'(Line), Goal, Line). 1125process_directive(format_predicate(_, Goal), Src) :- 1126 !, 1127 current_source_line(Line), 1128 assert_called(Src, '<directive>'(Line), Goal, Line). 1129process_directive(if(Cond), Src) :- 1130 !, 1131 current_source_line(Line), 1132 assert_called(Src, '<directive>'(Line), Cond, Line). 1133process_directive(elif(Cond), Src) :- 1134 !, 1135 current_source_line(Line), 1136 assert_called(Src, '<directive>'(Line), Cond, Line). 1137process_directive(else, _) :- !. 1138process_directive(endif, _) :- !. 1139process_directive(Goal, Src) :- 1140 current_source_line(Line), 1141 process_body(Goal, '<directive>'(Line), Src).
1147process_meta_predicate((A,B), Src) :- 1148 !, 1149 process_meta_predicate(A, Src), 1150 process_meta_predicate(B, Src). 1151process_meta_predicate(Decl, Src) :- 1152 process_meta_head(Src, Decl). 1153 1154process_meta_head(Src, Decl) :- % swapped arguments for maplist 1155 compound(Decl), 1156 compound_name_arity(Decl, Name, Arity), 1157 compound_name_arity(Head, Name, Arity), 1158 meta_args(1, Arity, Decl, Head, Meta), 1159 ( ( prolog:meta_goal(Head, _) 1160 ; prolog:called_by(Head, _, _, _) 1161 ; prolog:called_by(Head, _) 1162 ; meta_goal(Head, _) 1163 ) 1164 -> true 1165 ; assert(meta_goal(Head, Meta, Src)) 1166 ). 1167 1168meta_args(I, Arity, _, _, []) :- 1169 I > Arity, 1170 !. 1171meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1172 arg(I, Decl, 0), 1173 !, 1174 arg(I, Head, H), 1175 I2 is I + 1, 1176 meta_args(I2, Arity, Decl, Head, T). 1177meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1178 arg(I, Decl, ^), 1179 !, 1180 arg(I, Head, EH), 1181 setof_goal(EH, H), 1182 I2 is I + 1, 1183 meta_args(I2, Arity, Decl, Head, T). 1184meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1185 arg(I, Decl, //), 1186 !, 1187 arg(I, Head, H), 1188 I2 is I + 1, 1189 meta_args(I2, Arity, Decl, Head, T). 1190meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1191 arg(I, Decl, A), 1192 integer(A), A > 0, 1193 !, 1194 arg(I, Head, H), 1195 I2 is I + 1, 1196 meta_args(I2, Arity, Decl, Head, T). 1197meta_args(I, Arity, Decl, Head, Meta) :- 1198 I2 is I + 1, 1199 meta_args(I2, Arity, Decl, Head, Meta). 1200 1201 1202 /******************************** 1203 * BODY * 1204 ********************************/
1213xref_meta(Source, Head, Called) :-
1214 canonical_source(Source, Src),
1215 xref_meta_src(Head, Called, Src).1230xref_meta_src(Head, Called, Src) :- 1231 meta_goal(Head, Called, Src), 1232 !. 1233xref_meta_src(Head, Called, _) :- 1234 xref_meta(Head, Called), 1235 !. 1236xref_meta_src(Head, Called, _) :- 1237 compound(Head), 1238 compound_name_arity(Head, Name, Arity), 1239 apply_pred(Name), 1240 Arity > 5, 1241 !, 1242 Extra is Arity - 1, 1243 arg(1, Head, G), 1244 Called = [G+Extra]. 1245xref_meta_src(Head, Called, _) :- 1246 predicate_property('$xref_tmp':Head, meta_predicate(Meta)), 1247 !, 1248 Meta =.. [_|Args], 1249 meta_args(Args, 1, Head, Called). 1250 1251meta_args([], _, _, []). 1252meta_args([H0|T0], I, Head, [H|T]) :- 1253 xargs(H0, N), 1254 !, 1255 arg(I, Head, A), 1256 ( N == 0 1257 -> H = A 1258 ; H = (A+N) 1259 ), 1260 I2 is I+1, 1261 meta_args(T0, I2, Head, T). 1262meta_args([_|T0], I, Head, T) :- 1263 I2 is I+1, 1264 meta_args(T0, I2, Head, T). 1265 1266xargs(N, N) :- integer(N), !. 1267xargs(//, 2). 1268xargs(^, 0). 1269 1270apply_pred(call). % built-in 1271apply_pred(maplist). % library(apply_macros) 1272 1273xref_meta((A, B), [A, B]). 1274xref_meta((A; B), [A, B]). 1275xref_meta((A| B), [A, B]). 1276xref_meta((A -> B), [A, B]). 1277xref_meta((A *-> B), [A, B]). 1278xref_meta(findall(_V,G,_L), [G]). 1279xref_meta(findall(_V,G,_L,_T), [G]). 1280xref_meta(findnsols(_N,_V,G,_L), [G]). 1281xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1282xref_meta(setof(_V, EG, _L), [G]) :- 1283 setof_goal(EG, G). 1284xref_meta(bagof(_V, EG, _L), [G]) :- 1285 setof_goal(EG, G). 1286xref_meta(forall(A, B), [A, B]). 1287xref_meta(maplist(G,_), [G+1]). 1288xref_meta(maplist(G,_,_), [G+2]). 1289xref_meta(maplist(G,_,_,_), [G+3]). 1290xref_meta(maplist(G,_,_,_,_), [G+4]). 1291xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1292xref_meta(map_assoc(G, _), [G+1]). 1293xref_meta(map_assoc(G, _, _), [G+2]). 1294xref_meta(checklist(G, _L), [G+1]). 1295xref_meta(sublist(G, _, _), [G+1]). 1296xref_meta(include(G, _, _), [G+1]). 1297xref_meta(exclude(G, _, _), [G+1]). 1298xref_meta(partition(G, _, _, _, _), [G+2]). 1299xref_meta(partition(G, _, _, _),[G+1]). 1300xref_meta(call(G), [G]). 1301xref_meta(call(G, _), [G+1]). 1302xref_meta(call(G, _, _), [G+2]). 1303xref_meta(call(G, _, _, _), [G+3]). 1304xref_meta(call(G, _, _, _, _), [G+4]). 1305xref_meta(not(G), [G]). 1306xref_meta(notrace(G), [G]). 1307xref_meta('$notrace'(G), [G]). 1308xref_meta(\+(G), [G]). 1309xref_meta(ignore(G), [G]). 1310xref_meta(once(G), [G]). 1311xref_meta(initialization(G), [G]). 1312xref_meta(initialization(G,_), [G]). 1313xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1314xref_meta(clause(G, _), [G]). 1315xref_meta(clause(G, _, _), [G]). 1316xref_meta(phrase(G, _A), [//(G)]). 1317xref_meta(phrase(G, _A, _R), [//(G)]). 1318xref_meta(call_dcg(G, _A, _R), [//(G)]). 1319xref_meta(phrase_from_file(G,_),[//(G)]). 1320xref_meta(catch(A, _, B), [A, B]). 1321xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1322xref_meta(thread_create(A,_,_), [A]). 1323xref_meta(thread_create(A,_), [A]). 1324xref_meta(thread_signal(_,A), [A]). 1325xref_meta(thread_idle(A,_), [A]). 1326xref_meta(thread_at_exit(A), [A]). 1327xref_meta(thread_initialization(A), [A]). 1328xref_meta(engine_create(_,A,_), [A]). 1329xref_meta(engine_create(_,A,_,_), [A]). 1330xref_meta(transaction(A), [A]). 1331xref_meta(transaction(A,B,_), [A,B]). 1332xref_meta(snapshot(A), [A]). 1333xref_meta(predsort(A,_,_), [A+3]). 1334xref_meta(call_cleanup(A, B), [A, B]). 1335xref_meta(call_cleanup(A, _, B),[A, B]). 1336xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1337xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1338xref_meta(call_residue_vars(A,_), [A]). 1339xref_meta(with_mutex(_,A), [A]). 1340xref_meta(assume(G), [G]). % library(debug) 1341xref_meta(assertion(G), [G]). % library(debug) 1342xref_meta(freeze(_, G), [G]). 1343xref_meta(when(C, A), [C, A]). 1344xref_meta(time(G), [G]). % development system 1345xref_meta(call_time(G, _), [G]). % development system 1346xref_meta(call_time(G, _, _), [G]). % development system 1347xref_meta(profile(G), [G]). 1348xref_meta(at_halt(G), [G]). 1349xref_meta(call_with_time_limit(_, G), [G]). 1350xref_meta(call_with_depth_limit(G, _, _), [G]). 1351xref_meta(call_with_inference_limit(G, _, _), [G]). 1352xref_meta(alarm(_, G, _), [G]). 1353xref_meta(alarm(_, G, _, _), [G]). 1354xref_meta('$add_directive_wic'(G), [G]). 1355xref_meta(with_output_to(_, G), [G]). 1356xref_meta(if(G), [G]). 1357xref_meta(elif(G), [G]). 1358xref_meta(meta_options(G,_,_), [G+1]). 1359xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1360xref_meta(distinct(G), [G]). % library(solution_sequences) 1361xref_meta(distinct(_, G), [G]). 1362xref_meta(order_by(_, G), [G]). 1363xref_meta(limit(_, G), [G]). 1364xref_meta(offset(_, G), [G]). 1365xref_meta(reset(G,_,_), [G]). 1366xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1367xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1368xref_meta(tnot(G), [G]). 1369xref_meta(not_exists(G), [G]). 1370xref_meta(with_tty_raw(G), [G]). 1371xref_meta(residual_goals(G), [G+2]). 1372 1373 % XPCE meta-predicates 1374xref_meta(pce_global(_, new(_)), _) :- !, fail. 1375xref_meta(pce_global(_, B), [B+1]). 1376xref_meta(ifmaintainer(G), [G]). % used in manual 1377xref_meta(listen(_, G), [G]). % library(broadcast) 1378xref_meta(listen(_, _, G), [G]). 1379xref_meta(in_pce_thread(G), [G]). 1380 1381xref_meta(G, Meta) :- % call user extensions 1382 prolog:meta_goal(G, Meta). 1383xref_meta(G, Meta) :- % Generated from :- meta_predicate 1384 meta_goal(G, Meta). 1385 1386setof_goal(EG, G) :- 1387 var(EG), !, G = EG. 1388setof_goal(_^EG, G) :- 1389 !, 1390 setof_goal(EG, G). 1391setof_goal(G, G). 1392 1393event_xargs(abort, 0). 1394event_xargs(erase, 1). 1395event_xargs(break, 3). 1396event_xargs(frame_finished, 1). 1397event_xargs(thread_exit, 1). 1398event_xargs(this_thread_exit, 0). 1399event_xargs(PI, 2) :- pi_to_head(PI, _).
1405head_of(Var, _) :- 1406 var(Var), !, fail. 1407head_of((Head :- _), Head). 1408head_of(Head, Head).
1416xref_hook(Hook) :- 1417 prolog:hook(Hook). 1418xref_hook(Hook) :- 1419 hook(Hook). 1420 1421 1422hook(attr_portray_hook(_,_)). 1423hook(attr_unify_hook(_,_)). 1424hook(attribute_goals(_,_,_)). 1425hook(goal_expansion(_,_)). 1426hook(term_expansion(_,_)). 1427hook(resource(_,_,_)). 1428hook('$pred_option'(_,_,_,_)). 1429 1430hook(emacs_prolog_colours:goal_classification(_,_)). 1431hook(emacs_prolog_colours:term_colours(_,_)). 1432hook(emacs_prolog_colours:goal_colours(_,_)). 1433hook(emacs_prolog_colours:style(_,_)). 1434hook(emacs_prolog_colours:identify(_,_)). 1435hook(pce_principal:pce_class(_,_,_,_,_,_)). 1436hook(pce_principal:send_implementation(_,_,_)). 1437hook(pce_principal:get_implementation(_,_,_,_)). 1438hook(pce_principal:pce_lazy_get_method(_,_,_)). 1439hook(pce_principal:pce_lazy_send_method(_,_,_)). 1440hook(pce_principal:pce_uses_template(_,_)). 1441hook(prolog:locate_clauses(_,_)). 1442hook(prolog:message(_,_,_)). 1443hook(prolog:error_message(_,_,_)). 1444hook(prolog:message_location(_,_,_)). 1445hook(prolog:message_context(_,_,_)). 1446hook(prolog:message_line_element(_,_)). 1447hook(prolog:debug_control_hook(_)). 1448hook(prolog:help_hook(_)). 1449hook(prolog:show_profile_hook(_,_)). 1450hook(prolog:general_exception(_,_)). 1451hook(prolog:predicate_summary(_,_)). 1452hook(prolog:residual_goals(_,_)). 1453hook(prolog_edit:load). 1454hook(prolog_edit:locate(_,_,_)). 1455hook(shlib:unload_all_foreign_libraries). 1456hook(system:'$foreign_registered'(_, _)). 1457hook(predicate_options:option_decl(_,_,_)). 1458hook(user:exception(_,_,_)). 1459hook(user:file_search_path(_,_)). 1460hook(user:library_directory(_)). 1461hook(user:message_hook(_,_,_)). 1462hook(user:portray(_)). 1463hook(user:prolog_clause_name(_,_)). 1464hook(user:prolog_list_goal(_)). 1465hook(user:prolog_predicate_name(_,_)). 1466hook(user:prolog_trace_interception(_,_,_,_)). 1467hook(prolog:prolog_exception_hook(_,_,_,_,_)). 1468hook(sandbox:safe_primitive(_)). 1469hook(sandbox:safe_meta_predicate(_)). 1470hook(sandbox:safe_meta(_,_)). 1471hook(sandbox:safe_global_variable(_)). 1472hook(sandbox:safe_directive(_)).
1479arith_callable(Var, _) :- 1480 var(Var), !, fail. 1481arith_callable(Module:Spec, Module:Goal) :- 1482 !, 1483 arith_callable(Spec, Goal). 1484arith_callable(Name/Arity, Goal) :- 1485 PredArity is Arity + 1, 1486 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1497process_body(Body, Origin, Src) :-
1498 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1499 true).true if there was a
partial evalation inside Goal that has bound variables.1506process_goal(Var, _, _, _) :- 1507 var(Var), 1508 !. 1509process_goal(_:Goal, _, _, _) :- 1510 var(Goal), 1511 !. 1512process_goal(Goal, Origin, Src, P) :- 1513 Goal = (_,_), % problems 1514 !, 1515 phrase(conjunction(Goal), Goals), 1516 process_conjunction(Goals, Origin, Src, P). 1517process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1518 Goal = (_;_), % problems 1519 !, 1520 phrase(disjunction(Goal), Goals), 1521 forall(member(G, Goals), 1522 process_body(G, Origin, Src)). 1523process_goal(Goal, Origin, Src, P) :- 1524 ( ( xmodule(M, Src) 1525 -> true 1526 ; M = user 1527 ), 1528 pi_head(PI, M:Goal), 1529 ( current_predicate(PI), 1530 predicate_property(M:Goal, imported_from(IM)) 1531 -> true 1532 ; PI = M:Name/Arity, 1533 '$find_library'(M, Name, Arity, IM, _Library) 1534 -> true 1535 ; IM = M 1536 ), 1537 prolog:called_by(Goal, IM, M, Called) 1538 ; prolog:called_by(Goal, Called) 1539 ), 1540 !, 1541 must_be(list, Called), 1542 current_source_line(Here), 1543 assert_called(Src, Origin, Goal, Here), 1544 process_called_list(Called, Origin, Src, P). 1545process_goal(Goal, Origin, Src, _) :- 1546 process_xpce_goal(Goal, Origin, Src), 1547 !. 1548process_goal(load_foreign_library(File), _Origin, Src, _) :- 1549 process_foreign(File, Src). 1550process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1551 process_foreign(File, Src). 1552process_goal(use_foreign_library(File), _Origin, Src, _) :- 1553 process_foreign(File, Src). 1554process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1555 process_foreign(File, Src). 1556process_goal(Goal, Origin, Src, P) :- 1557 xref_meta_src(Goal, Metas, Src), 1558 !, 1559 current_source_line(Here), 1560 assert_called(Src, Origin, Goal, Here), 1561 process_called_list(Metas, Origin, Src, P). 1562process_goal(Goal, Origin, Src, _) :- 1563 asserting_goal(Goal, Rule), 1564 !, 1565 current_source_line(Here), 1566 assert_called(Src, Origin, Goal, Here), 1567 process_assert(Rule, Origin, Src). 1568process_goal(Goal, Origin, Src, P) :- 1569 partial_evaluate(Goal, P), 1570 current_source_line(Here), 1571 assert_called(Src, Origin, Goal, Here). 1572 1573disjunction(Var) --> {var(Var), !}, [Var]. 1574disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1575disjunction(G) --> [G]. 1576 1577conjunction(Var) --> {var(Var), !}, [Var]. 1578conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1579conjunction(G) --> [G]. 1580 (RVars, T) :- 1582 term_variables(T, TVars0), 1583 sort(TVars0, TVars), 1584 ord_intersect(RVars, TVars). 1585 1586process_conjunction([], _, _, _). 1587process_conjunction([Disj|Rest], Origin, Src, P) :- 1588 nonvar(Disj), 1589 Disj = (_;_), 1590 Rest \== [], 1591 !, 1592 phrase(disjunction(Disj), Goals), 1593 term_variables(Rest, RVars0), 1594 sort(RVars0, RVars), 1595 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1596 forall(member(G, NonSHaring), 1597 process_body(G, Origin, Src)), 1598 ( Sharing == [] 1599 -> true 1600 ; maplist(term_variables, Sharing, GVars0), 1601 append(GVars0, GVars1), 1602 sort(GVars1, GVars), 1603 ord_intersection(GVars, RVars, SVars), 1604 VT =.. [v|SVars], 1605 findall(VT, 1606 ( member(G, Sharing), 1607 process_goal(G, Origin, Src, PS), 1608 PS == true 1609 ), 1610 Alts0), 1611 ( Alts0 == [] 1612 -> true 1613 ; ( true 1614 ; P = true, 1615 sort(Alts0, Alts1), 1616 variants(Alts1, 10, Alts), 1617 member(VT, Alts) 1618 ) 1619 ) 1620 ), 1621 process_conjunction(Rest, Origin, Src, P). 1622process_conjunction([H|T], Origin, Src, P) :- 1623 process_goal(H, Origin, Src, P), 1624 process_conjunction(T, Origin, Src, P). 1625 1626 1627process_called_list([], _, _, _). 1628process_called_list([H|T], Origin, Src, P) :- 1629 process_meta(H, Origin, Src, P), 1630 process_called_list(T, Origin, Src, P). 1631 1632process_meta(A+N, Origin, Src, P) :- 1633 !, 1634 ( extend(A, N, AX) 1635 -> process_goal(AX, Origin, Src, P) 1636 ; true 1637 ). 1638process_meta(//(A), Origin, Src, P) :- 1639 !, 1640 process_dcg_goal(A, Origin, Src, P). 1641process_meta(G, Origin, Src, P) :- 1642 process_goal(G, Origin, Src, P).
1649process_dcg_goal(Var, _, _, _) :- 1650 var(Var), 1651 !. 1652process_dcg_goal((A,B), Origin, Src, P) :- 1653 !, 1654 process_dcg_goal(A, Origin, Src, P), 1655 process_dcg_goal(B, Origin, Src, P). 1656process_dcg_goal((A;B), Origin, Src, P) :- 1657 !, 1658 process_dcg_goal(A, Origin, Src, P), 1659 process_dcg_goal(B, Origin, Src, P). 1660process_dcg_goal((A|B), Origin, Src, P) :- 1661 !, 1662 process_dcg_goal(A, Origin, Src, P), 1663 process_dcg_goal(B, Origin, Src, P). 1664process_dcg_goal((A->B), Origin, Src, P) :- 1665 !, 1666 process_dcg_goal(A, Origin, Src, P), 1667 process_dcg_goal(B, Origin, Src, P). 1668process_dcg_goal((A*->B), Origin, Src, P) :- 1669 !, 1670 process_dcg_goal(A, Origin, Src, P), 1671 process_dcg_goal(B, Origin, Src, P). 1672process_dcg_goal({Goal}, Origin, Src, P) :- 1673 !, 1674 process_goal(Goal, Origin, Src, P). 1675process_dcg_goal(List, _Origin, _Src, _) :- 1676 is_list(List), 1677 !. % terminal 1678process_dcg_goal(List, _Origin, _Src, _) :- 1679 string(List), 1680 !. % terminal 1681process_dcg_goal(Callable, Origin, Src, P) :- 1682 extend(Callable, 2, Goal), 1683 !, 1684 process_goal(Goal, Origin, Src, P). 1685process_dcg_goal(_, _, _, _). 1686 1687 1688extend(Var, _, _) :- 1689 var(Var), !, fail. 1690extend(M:G, N, M:GX) :- 1691 !, 1692 callable(G), 1693 extend(G, N, GX). 1694extend(G, N, GX) :- 1695 ( compound(G) 1696 -> compound_name_arguments(G, Name, Args), 1697 length(Rest, N), 1698 append(Args, Rest, NArgs), 1699 compound_name_arguments(GX, Name, NArgs) 1700 ; atom(G) 1701 -> length(NArgs, N), 1702 compound_name_arguments(GX, G, NArgs) 1703 ). 1704 1705asserting_goal(assert(Rule), Rule). 1706asserting_goal(asserta(Rule), Rule). 1707asserting_goal(assertz(Rule), Rule). 1708asserting_goal(assert(Rule,_), Rule). 1709asserting_goal(asserta(Rule,_), Rule). 1710asserting_goal(assertz(Rule,_), Rule). 1711 1712process_assert(0, _, _) :- !. % catch variables 1713process_assert((_:-Body), Origin, Src) :- 1714 !, 1715 process_body(Body, Origin, Src). 1716process_assert(_, _, _).
1720variants([], _, []). 1721variants([H|T], Max, List) :- 1722 variants(T, H, Max, List). 1723 1724variants([], H, _, [H]). 1725variants(_, _, 0, []) :- !. 1726variants([H|T], V, Max, List) :- 1727 ( H =@= V 1728 -> variants(T, V, Max, List) 1729 ; List = [V|List2], 1730 Max1 is Max-1, 1731 variants(T, H, Max1, List2) 1732 ).
T = hello(X),
findall(T, T, List),
1746partial_evaluate(Goal, P) :- 1747 eval(Goal), 1748 !, 1749 P = true. 1750partial_evaluate(_, _). 1751 1752eval(X = Y) :- 1753 unify_with_occurs_check(X, Y). 1754 1755 /******************************* 1756 * PLUNIT SUPPORT * 1757 *******************************/ 1758 1759enter_test_unit(Unit, _Src) :- 1760 current_source_line(Line), 1761 asserta(current_test_unit(Unit, Line)). 1762 1763leave_test_unit(Unit, _Src) :- 1764 retractall(current_test_unit(Unit, _)). 1765 1766 1767 /******************************* 1768 * XPCE STUFF * 1769 *******************************/ 1770 1771pce_goal(new(_,_), new(-, new)). 1772pce_goal(send(_,_), send(arg, msg)). 1773pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1774pce_goal(get(_,_,_), get(arg, msg, -)). 1775pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1776pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1777pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1778 1779process_xpce_goal(G, Origin, Src) :- 1780 pce_goal(G, Process), 1781 !, 1782 current_source_line(Here), 1783 assert_called(Src, Origin, G, Here), 1784 ( arg(I, Process, How), 1785 arg(I, G, Term), 1786 process_xpce_arg(How, Term, Origin, Src), 1787 fail 1788 ; true 1789 ). 1790 1791process_xpce_arg(new, Term, Origin, Src) :- 1792 callable(Term), 1793 process_new(Term, Origin, Src). 1794process_xpce_arg(arg, Term, Origin, Src) :- 1795 compound(Term), 1796 process_new(Term, Origin, Src). 1797process_xpce_arg(msg, Term, Origin, Src) :- 1798 compound(Term), 1799 ( arg(_, Term, Arg), 1800 process_xpce_arg(arg, Arg, Origin, Src), 1801 fail 1802 ; true 1803 ). 1804 1805process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1806process_new(Term, Origin, Src) :- 1807 assert_new(Src, Origin, Term), 1808 ( compound(Term), 1809 arg(_, Term, Arg), 1810 process_xpce_arg(arg, Arg, Origin, Src), 1811 fail 1812 ; true 1813 ). 1814 1815assert_new(_, _, Term) :- 1816 \+ callable(Term), 1817 !. 1818assert_new(Src, Origin, Control) :- 1819 functor_name(Control, Class), 1820 pce_control_class(Class), 1821 !, 1822 forall(arg(_, Control, Arg), 1823 assert_new(Src, Origin, Arg)). 1824assert_new(Src, Origin, Term) :- 1825 compound(Term), 1826 arg(1, Term, Prolog), 1827 Prolog == @(prolog), 1828 ( Term =.. [message, _, Selector | T], 1829 atom(Selector) 1830 -> Called =.. [Selector|T], 1831 process_body(Called, Origin, Src) 1832 ; Term =.. [?, _, Selector | T], 1833 atom(Selector) 1834 -> append(T, [_R], T2), 1835 Called =.. [Selector|T2], 1836 process_body(Called, Origin, Src) 1837 ), 1838 fail. 1839assert_new(_, _, @(_)) :- !. 1840assert_new(Src, _, Term) :- 1841 functor_name(Term, Name), 1842 assert_used_class(Src, Name). 1843 1844 1845pce_control_class(and). 1846pce_control_class(or). 1847pce_control_class(if). 1848pce_control_class(not). 1849 1850 1851 /******************************** 1852 * INCLUDED MODULES * 1853 ********************************/
1857process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1858process_use_module([], _, _) :- !. 1859process_use_module([H|T], Src, Reexport) :- 1860 !, 1861 process_use_module(H, Src, Reexport), 1862 process_use_module(T, Src, Reexport). 1863process_use_module(library(pce), Src, Reexport) :- % bit special 1864 !, 1865 xref_public_list(library(pce), Path, Exports, Src), 1866 forall(member(Import, Exports), 1867 process_pce_import(Import, Src, Path, Reexport)). 1868process_use_module(File, Src, Reexport) :- 1869 load_module_if_needed(File), 1870 ( xoption(Src, silent(Silent)) 1871 -> Extra = [silent(Silent)] 1872 ; Extra = [silent(true)] 1873 ), 1874 ( xref_public_list(File, Src, 1875 [ path(Path), 1876 module(M), 1877 exports(Exports), 1878 public(Public), 1879 meta(Meta) 1880 | Extra 1881 ]) 1882 -> assert(uses_file(File, Src, Path)), 1883 assert_import(Src, Exports, _, Path, Reexport), 1884 assert_xmodule_callable(Exports, M, Src, Path), 1885 assert_xmodule_callable(Public, M, Src, Path), 1886 maplist(process_meta_head(Src), Meta), 1887 ( File = library(chr) % hacky 1888 -> assert(mode(chr, Src)) 1889 ; true 1890 ) 1891 ; assert(uses_file(File, Src, '<not_found>')) 1892 ). 1893 1894process_pce_import(Name/Arity, Src, Path, Reexport) :- 1895 atom(Name), 1896 integer(Arity), 1897 !, 1898 functor(Term, Name, Arity), 1899 ( \+ system_predicate(Term), 1900 \+ Term = pce_error(_) % hack!? 1901 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1902 ; true 1903 ). 1904process_pce_import(op(P,T,N), Src, _, _) :- 1905 xref_push_op(Src, P, T, N).
1911process_use_module2(File, Import, Src, Reexport) :-
1912 load_module_if_needed(File),
1913 ( xref_source_file(File, Path, Src)
1914 -> assert(uses_file(File, Src, Path)),
1915 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1916 -> assert_import(Src, Import, Export, Path, Reexport),
1917 forall(( member(Head, Meta),
1918 imported(Head, _, Path)
1919 ),
1920 process_meta_head(Src, Head))
1921 ; true
1922 )
1923 ; assert(uses_file(File, Src, '<not_found>'))
1924 ).1933load_module_if_needed(File) :- 1934 prolog:no_autoload_module(File), 1935 !, 1936 use_module(File, []). 1937load_module_if_needed(_). 1938 1939prologno_autoload_module(library(apply_macros)). 1940prologno_autoload_module(library(arithmetic)). 1941prologno_autoload_module(library(record)). 1942prologno_autoload_module(library(persistency)). 1943prologno_autoload_module(library(pldoc)). 1944prologno_autoload_module(library(settings)). 1945prologno_autoload_module(library(debug)). 1946prologno_autoload_module(library(plunit)). 1947prologno_autoload_module(library(macros)).
1952process_requires(Import, Src) :- 1953 is_list(Import), 1954 !, 1955 require_list(Import, Src). 1956process_requires(Var, _Src) :- 1957 var(Var), 1958 !. 1959process_requires((A,B), Src) :- 1960 !, 1961 process_requires(A, Src), 1962 process_requires(B, Src). 1963process_requires(PI, Src) :- 1964 requires(PI, Src). 1965 1966require_list([], _). 1967require_list([H|T], Src) :- 1968 requires(H, Src), 1969 require_list(T, Src). 1970 1971requires(PI, _Src) :- 1972 '$pi_head'(PI, Head), 1973 '$get_predicate_attribute'(system:Head, defined, 1), 1974 !. 1975requires(PI, Src) :- 1976 '$pi_head'(PI, Head), 1977 '$pi_head'(Name/Arity, Head), 1978 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1979 ( imported(Head, Src, Library) 1980 -> true 1981 ; assertz(imported(Head, Src, Library)) 1982 ).
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.
2013xref_public_list(File, Src, Options) :-
2014 option(path(Path), Options, _),
2015 option(module(Module), Options, _),
2016 option(exports(Exports), Options, _),
2017 option(public(Public), Options, _),
2018 option(meta(Meta), Options, _),
2019 xref_source_file(File, Path, Src, Options),
2020 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
2042xref_public_list(File, Path, Export, Src) :- 2043 xref_source_file(File, Path, Src), 2044 public_list(Path, _, _, Export, _, []). 2045xref_public_list(File, Path, Module, Export, Meta, Src) :- 2046 xref_source_file(File, Path, Src), 2047 public_list(Path, Module, Meta, Export, _, []). 2048xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 2049 xref_source_file(File, Path, Src), 2050 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2060:- dynamic public_list_cache/6. 2061:- volatile public_list_cache/6. 2062 2063public_list(Path, Module, Meta, Export, Public, _Options) :- 2064 public_list_cache(Path, Modified, 2065 Module0, Meta0, Export0, Public0), 2066 time_file(Path, ModifiedNow), 2067 ( abs(Modified-ModifiedNow) < 0.0001 2068 -> !, 2069 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2070 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2071 fail 2072 ). 2073public_list(Path, Module, Meta, Export, Public, Options) :- 2074 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2075 ( Error = error(_,_), 2076 catch(time_file(Path, Modified), Error, fail) 2077 -> asserta(public_list_cache(Path, Modified, 2078 Module0, Meta0, Export0, Public0)) 2079 ; true 2080 ), 2081 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2082 2083public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2084 in_temporary_module( 2085 TempModule, 2086 true, 2087 public_list_diff(TempModule, Path, Module, 2088 Meta, [], Export, [], Public, [], Options)). 2089 2090 2091public_list_diff(TempModule, 2092 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2093 setup_call_cleanup( 2094 public_list_setup(TempModule, Path, In, State), 2095 phrase(read_directives(In, Options, [true]), Directives), 2096 public_list_cleanup(In, State)), 2097 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2098 2099public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2100 prolog_open_source(Path, In), 2101 '$set_source_module'(OldM, TempModule), 2102 set_xref(OldXref). 2103 2104public_list_cleanup(In, state(OldM, OldXref)) :- 2105 '$set_source_module'(OldM), 2106 set_prolog_flag(xref, OldXref), 2107 prolog_close_source(In). 2108 2109 2110read_directives(In, Options, State) --> 2111 { repeat, 2112 catch(prolog_read_source_term(In, Term, Expanded, 2113 [ process_comment(true), 2114 syntax_errors(error) 2115 ]), 2116 E, report_syntax_error(E, -, Options)) 2117 -> nonvar(Term), 2118 Term = (:-_) 2119 }, 2120 !, 2121 terms(Expanded, State, State1), 2122 read_directives(In, Options, State1). 2123read_directives(_, _, _) --> []. 2124 2125terms(Var, State, State) --> { var(Var) }, !. 2126terms([H|T], State0, State) --> 2127 !, 2128 terms(H, State0, State1), 2129 terms(T, State1, State). 2130terms((:-if(Cond)), State0, [True|State0]) --> 2131 !, 2132 { eval_cond(Cond, True) }. 2133terms((:-elif(Cond)), [True0|State], [True|State]) --> 2134 !, 2135 { eval_cond(Cond, True1), 2136 elif(True0, True1, True) 2137 }. 2138terms((:-else), [True0|State], [True|State]) --> 2139 !, 2140 { negate(True0, True) }. 2141terms((:-endif), [_|State], State) --> !. 2142terms(H, State, State) --> 2143 ( {State = [true|_]} 2144 -> [H] 2145 ; [] 2146 ). 2147 2148eval_cond(Cond, true) :- 2149 catch(Cond, _, fail), 2150 !. 2151eval_cond(_, false). 2152 2153elif(true, _, else_false) :- !. 2154elif(false, true, true) :- !. 2155elif(True, _, True). 2156 2157negate(true, false). 2158negate(false, true). 2159negate(else_false, else_false). 2160 2161public_list([(:- module(Module, Export0))|Decls], Path, 2162 Module, Meta, MT, Export, Rest, Public, PT) :- 2163 !, 2164 ( is_list(Export0) 2165 -> append(Export0, Reexport, Export) 2166 ; Reexport = Export 2167 ), 2168 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2169public_list([(:- encoding(_))|Decls], Path, 2170 Module, Meta, MT, Export, Rest, Public, PT) :- 2171 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2172 2173public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2174public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2175 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2176 !, 2177 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2178public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2179 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2180 2181public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2182 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2183public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2184 public_from_import(Import, Spec, Path, Reexport, Rest). 2185public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2186 phrase(meta_decls(Decl), Meta, MT). 2187public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2188 phrase(public_decls(Decl), Public, PT).
2194reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2195reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2196 !, 2197 xref_source_file(H, Path, Src), 2198 public_list(Path, _Module, Meta0, Export0, Public0, []), 2199 append(Meta0, MT1, Meta), 2200 append(Export0, ET1, Export), 2201 append(Public0, PT1, Public), 2202 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2203reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2204 xref_source_file(Spec, Path, Src), 2205 public_list(Path, _Module, Meta0, Export0, Public0, []), 2206 append(Meta0, MT, Meta), 2207 append(Export0, ET, Export), 2208 append(Public0, PT, Public). 2209 2210public_from_import(except(Map), Path, Src, Export, Rest) :- 2211 !, 2212 xref_public_list(Path, _, AllExports, Src), 2213 except(Map, AllExports, NewExports), 2214 append(NewExports, Rest, Export). 2215public_from_import(Import, _, _, Export, Rest) :- 2216 import_name_map(Import, Export, Rest).
2221except([], Exports, Exports). 2222except([PI0 as NewName|Map], Exports0, Exports) :- 2223 !, 2224 canonical_pi(PI0, PI), 2225 map_as(Exports0, PI, NewName, Exports1), 2226 except(Map, Exports1, Exports). 2227except([PI0|Map], Exports0, Exports) :- 2228 canonical_pi(PI0, PI), 2229 select(PI2, Exports0, Exports1), 2230 same_pi(PI, PI2), 2231 !, 2232 except(Map, Exports1, Exports). 2233 2234 2235map_as([PI|T], Repl, As, [PI2|T]) :- 2236 same_pi(Repl, PI), 2237 !, 2238 pi_as(PI, As, PI2). 2239map_as([H|T0], Repl, As, [H|T]) :- 2240 map_as(T0, Repl, As, T). 2241 2242pi_as(_/Arity, Name, Name/Arity). 2243pi_as(_//Arity, Name, Name//Arity). 2244 2245import_name_map([], L, L). 2246import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2247 !, 2248 import_name_map(T0, T, Tail). 2249import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2250 !, 2251 import_name_map(T0, T, Tail). 2252import_name_map([H|T0], [H|T], Tail) :- 2253 import_name_map(T0, T, Tail). 2254 2255canonical_pi(Name//Arity0, PI) :- 2256 integer(Arity0), 2257 !, 2258 PI = Name/Arity, 2259 Arity is Arity0 + 2. 2260canonical_pi(PI, PI). 2261 2262same_pi(Canonical, PI2) :- 2263 canonical_pi(PI2, Canonical). 2264 2265meta_decls(Var) --> 2266 { var(Var) }, 2267 !. 2268meta_decls((A,B)) --> 2269 !, 2270 meta_decls(A), 2271 meta_decls(B). 2272meta_decls(A) --> 2273 [A]. 2274 2275public_decls(Var) --> 2276 { var(Var) }, 2277 !. 2278public_decls((A,B)) --> 2279 !, 2280 public_decls(A), 2281 public_decls(B). 2282public_decls(A) --> 2283 [A]. 2284 2285 /******************************* 2286 * INCLUDE * 2287 *******************************/ 2288 2289process_include([], _) :- !. 2290process_include([H|T], Src) :- 2291 !, 2292 process_include(H, Src), 2293 process_include(T, Src). 2294process_include(File, Src) :- 2295 callable(File), 2296 !, 2297 ( once(xref_input(ParentSrc, _)), 2298 xref_source_file(File, Path, ParentSrc) 2299 -> ( ( uses_file(_, Src, Path) 2300 ; Path == Src 2301 ) 2302 -> true 2303 ; assert(uses_file(File, Src, Path)), 2304 ( xoption(Src, process_include(true)) 2305 -> findall(O, xoption(Src, O), Options), 2306 setup_call_cleanup( 2307 open_include_file(Path, In, Refs), 2308 collect(Src, Path, In, Options), 2309 close_include(In, Refs)) 2310 ; true 2311 ) 2312 ) 2313 ; assert(uses_file(File, Src, '<not_found>')) 2314 ). 2315process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2323open_include_file(Path, In, [Ref]) :- 2324 once(xref_input(_, Parent)), 2325 stream_property(Parent, encoding(Enc)), 2326 '$push_input_context'(xref_include), 2327 catch(( prolog:xref_open_source(Path, In) 2328 -> catch(set_stream(In, encoding(Enc)), 2329 error(_,_), true) % deal with non-file input 2330 ; include_encoding(Enc, Options), 2331 open(Path, read, In, Options) 2332 ), E, 2333 ( '$pop_input_context', throw(E))), 2334 catch(( peek_char(In, #) % Deal with #! script 2335 -> skip(In, 10) 2336 ; true 2337 ), E, 2338 ( close_include(In, []), throw(E))), 2339 asserta(xref_input(Path, In), Ref). 2340 2341include_encoding(wchar_t, []) :- !. 2342include_encoding(Enc, [encoding(Enc)]). 2343 2344 2345close_include(In, Refs) :- 2346 maplist(erase, Refs), 2347 close(In, [force(true)]), 2348 '$pop_input_context'.
2354process_foreign(Spec, Src) :- 2355 ground(Spec), 2356 current_foreign_library(Spec, Defined), 2357 !, 2358 ( xmodule(Module, Src) 2359 -> true 2360 ; Module = user 2361 ), 2362 process_foreign_defined(Defined, Module, Src). 2363process_foreign(_, _). 2364 2365process_foreign_defined([], _, _). 2366process_foreign_defined([H|T], M, Src) :- 2367 ( H = M:Head 2368 -> assert_foreign(Src, Head) 2369 ; assert_foreign(Src, H) 2370 ), 2371 process_foreign_defined(T, M, Src). 2372 2373 2374 /******************************* 2375 * CHR SUPPORT * 2376 *******************************/ 2377 2378/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2379This part of the file supports CHR. Our choice is between making special 2380hooks to make CHR expansion work and then handle the (complex) expanded 2381code or process the CHR source directly. The latter looks simpler, 2382though I don't like the idea of adding support for libraries to this 2383module. A file is supposed to be a CHR file if it uses a 2384use_module(library(chr) or contains a :- constraint/1 directive. As an 2385extra bonus we get the source-locations right :-) 2386- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2387 2388process_chr(@(_Name, Rule), Src) :- 2389 mode(chr, Src), 2390 process_chr(Rule, Src). 2391process_chr(pragma(Rule, _Pragma), Src) :- 2392 mode(chr, Src), 2393 process_chr(Rule, Src). 2394process_chr(<=>(Head, Body), Src) :- 2395 mode(chr, Src), 2396 chr_head(Head, Src, H), 2397 chr_body(Body, H, Src). 2398process_chr(==>(Head, Body), Src) :- 2399 mode(chr, Src), 2400 chr_head(Head, H, Src), 2401 chr_body(Body, H, Src). 2402process_chr((:- chr_constraint(_)), Src) :- 2403 ( mode(chr, Src) 2404 -> true 2405 ; assert(mode(chr, Src)) 2406 ). 2407 2408chr_head(X, _, _) :- 2409 var(X), 2410 !. % Illegal. Warn? 2411chr_head(\(A,B), Src, H) :- 2412 chr_head(A, Src, H), 2413 process_body(B, H, Src). 2414chr_head((H0,B), Src, H) :- 2415 chr_defined(H0, Src, H), 2416 process_body(B, H, Src). 2417chr_head(H0, Src, H) :- 2418 chr_defined(H0, Src, H). 2419 2420chr_defined(X, _, _) :- 2421 var(X), 2422 !. 2423chr_defined(#(C,_Id), Src, C) :- 2424 !, 2425 assert_constraint(Src, C). 2426chr_defined(A, Src, A) :- 2427 assert_constraint(Src, A). 2428 2429chr_body(X, From, Src) :- 2430 var(X), 2431 !, 2432 process_body(X, From, Src). 2433chr_body('|'(Guard, Goals), H, Src) :- 2434 !, 2435 chr_body(Guard, H, Src), 2436 chr_body(Goals, H, Src). 2437chr_body(G, From, Src) :- 2438 process_body(G, From, Src). 2439 2440assert_constraint(_, Head) :- 2441 var(Head), 2442 !. 2443assert_constraint(Src, Head) :- 2444 constraint(Head, Src, _), 2445 !. 2446assert_constraint(Src, Head) :- 2447 generalise_term(Head, Term), 2448 current_source_line(Line), 2449 assert(constraint(Term, Src, Line)). 2450 2451 2452 /******************************** 2453 * PHASE 1 ASSERTIONS * 2454 ********************************/
2461assert_called(_, _, Var, _) :- 2462 var(Var), 2463 !. 2464assert_called(Src, From, Goal, Line) :- 2465 var(From), 2466 !, 2467 assert_called(Src, '<unknown>', Goal, Line). 2468assert_called(_, _, Goal, _) :- 2469 expand_hide_called(Goal), 2470 !. 2471assert_called(Src, Origin, M:G, Line) :- 2472 !, 2473 ( atom(M), 2474 callable(G) 2475 -> current_condition(Cond), 2476 ( xmodule(M, Src) % explicit call to own module 2477 -> assert_called(Src, Origin, G, Line) 2478 ; called(M:G, Src, Origin, Cond, Line) % already registered 2479 -> true 2480 ; hide_called(M:G, Src) % not interesting (now) 2481 -> true 2482 ; generalise(Origin, OTerm), 2483 generalise(G, GTerm) 2484 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2485 ; true 2486 ) 2487 ; true % call to variable module 2488 ). 2489assert_called(Src, _, Goal, _) :- 2490 ( xmodule(M, Src) 2491 -> M \== system 2492 ; M = user 2493 ), 2494 hide_called(M:Goal, Src), 2495 !. 2496assert_called(Src, Origin, Goal, Line) :- 2497 current_condition(Cond), 2498 ( called(Goal, Src, Origin, Cond, Line) 2499 -> true 2500 ; generalise(Origin, OTerm), 2501 generalise(Goal, Term) 2502 -> assert(called(Term, Src, OTerm, Cond, Line)) 2503 ; true 2504 ).
2512expand_hide_called(pce_principal:send_implementation(_, _, _)). 2513expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2514expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2515expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2516 2517assert_defined(Src, Goal) :- 2518 Goal = test(_Test), 2519 current_test_unit(Unit, Line), 2520 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2521 fail. 2522assert_defined(Src, Goal) :- 2523 Goal = test(_Test, _Options), 2524 current_test_unit(Unit, Line), 2525 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2526 fail. 2527assert_defined(Src, Goal) :- 2528 defined(Goal, Src, _), 2529 !. 2530assert_defined(Src, Goal) :- 2531 generalise(Goal, Term), 2532 current_source_line(Line), 2533 assert(defined(Term, Src, Line)). 2534 2535assert_foreign(Src, Goal) :- 2536 foreign(Goal, Src, _), 2537 !. 2538assert_foreign(Src, Goal) :- 2539 generalise(Goal, Term), 2540 current_source_line(Line), 2541 assert(foreign(Term, Src, Line)). 2542 2543assert_grammar_rule(Src, Goal) :- 2544 grammar_rule(Goal, Src), 2545 !. 2546assert_grammar_rule(Src, Goal) :- 2547 generalise(Goal, Term), 2548 assert(grammar_rule(Term, Src)).
true, re-export the
imported predicates.
2561assert_import(_, [], _, _, _) :- !. 2562assert_import(Src, [H|T], Export, From, Reexport) :- 2563 !, 2564 assert_import(Src, H, Export, From, Reexport), 2565 assert_import(Src, T, Export, From, Reexport). 2566assert_import(Src, except(Except), Export, From, Reexport) :- 2567 !, 2568 is_list(Export), 2569 !, 2570 except(Except, Export, Import), 2571 assert_import(Src, Import, _All, From, Reexport). 2572assert_import(Src, Import as Name, Export, From, Reexport) :- 2573 !, 2574 pi_to_head(Import, Term0), 2575 rename_goal(Term0, Name, Term), 2576 ( in_export_list(Term0, Export) 2577 -> assert(imported(Term, Src, From)), 2578 assert_reexport(Reexport, Src, Term) 2579 ; current_source_line(Line), 2580 assert_called(Src, '<directive>'(Line), Term0, Line) 2581 ). 2582assert_import(Src, Import, Export, From, Reexport) :- 2583 pi_to_head(Import, Term), 2584 !, 2585 ( in_export_list(Term, Export) 2586 -> assert(imported(Term, Src, From)), 2587 assert_reexport(Reexport, Src, Term) 2588 ; current_source_line(Line), 2589 assert_called(Src, '<directive>'(Line), Term, Line) 2590 ). 2591assert_import(Src, op(P,T,N), _, _, _) :- 2592 xref_push_op(Src, P,T,N). 2593 2594in_export_list(_Head, Export) :- 2595 var(Export), 2596 !. 2597in_export_list(Head, Export) :- 2598 member(PI, Export), 2599 pi_to_head(PI, Head). 2600 2601assert_reexport(false, _, _) :- !. 2602assert_reexport(true, Src, Term) :- 2603 assert(exported(Term, Src)).
2609process_import(M:PI, Src) :- 2610 pi_to_head(PI, Head), 2611 !, 2612 ( atom(M), 2613 current_module(M), 2614 module_property(M, file(From)) 2615 -> true 2616 ; From = '<unknown>' 2617 ), 2618 assert(imported(Head, Src, From)). 2619process_import(_, _).
2628assert_xmodule_callable([], _, _, _). 2629assert_xmodule_callable([PI|T], M, Src, From) :- 2630 ( pi_to_head(M:PI, Head) 2631 -> assert(imported(Head, Src, From)) 2632 ; true 2633 ), 2634 assert_xmodule_callable(T, M, Src, From).
2641assert_op(Src, op(P,T,M:N)) :-
2642 ( '$current_source_module'(M)
2643 -> Name = N
2644 ; Name = M:N
2645 ),
2646 ( xop(Src, op(P,T,Name))
2647 -> true
2648 ; assert(xop(Src, op(P,T,Name)))
2649 ).2656assert_module(Src, Module) :- 2657 xmodule(Module, Src), 2658 !. 2659assert_module(Src, Module) :- 2660 '$set_source_module'(Module), 2661 assert(xmodule(Module, Src)), 2662 ( module_property(Module, class(system)) 2663 -> retractall(xoption(Src, register_called(_))), 2664 assert(xoption(Src, register_called(all))) 2665 ; true 2666 ). 2667 2668assert_module_export(_, []) :- !. 2669assert_module_export(Src, [H|T]) :- 2670 !, 2671 assert_module_export(Src, H), 2672 assert_module_export(Src, T). 2673assert_module_export(Src, PI) :- 2674 pi_to_head(PI, Term), 2675 !, 2676 assert(exported(Term, Src)). 2677assert_module_export(Src, op(P, A, N)) :- 2678 xref_push_op(Src, P, A, N).
2684assert_module3([], _) :- !. 2685assert_module3([H|T], Src) :- 2686 !, 2687 assert_module3(H, Src), 2688 assert_module3(T, Src). 2689assert_module3(Option, Src) :- 2690 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2699process_predicates(Closure, Preds, Src) :- 2700 is_list(Preds), 2701 !, 2702 process_predicate_list(Preds, Closure, Src). 2703process_predicates(Closure, as(Preds, _Options), Src) :- 2704 !, 2705 process_predicates(Closure, Preds, Src). 2706process_predicates(Closure, Preds, Src) :- 2707 process_predicate_comma(Preds, Closure, Src). 2708 2709process_predicate_list([], _, _). 2710process_predicate_list([H|T], Closure, Src) :- 2711 ( nonvar(H) 2712 -> call(Closure, H, Src) 2713 ; true 2714 ), 2715 process_predicate_list(T, Closure, Src). 2716 2717process_predicate_comma(Var, _, _) :- 2718 var(Var), 2719 !. 2720process_predicate_comma(M:(A,B), Closure, Src) :- 2721 !, 2722 process_predicate_comma(M:A, Closure, Src), 2723 process_predicate_comma(M:B, Closure, Src). 2724process_predicate_comma((A,B), Closure, Src) :- 2725 !, 2726 process_predicate_comma(A, Closure, Src), 2727 process_predicate_comma(B, Closure, Src). 2728process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2729 !, 2730 process_predicate_comma(Spec, Closure, Src). 2731process_predicate_comma(A, Closure, Src) :- 2732 call(Closure, A, Src). 2733 2734 2735assert_dynamic(PI, Src) :- 2736 pi_to_head(PI, Term), 2737 ( thread_local(Term, Src, _) % dynamic after thread_local has 2738 -> true % no effect 2739 ; current_source_line(Line), 2740 assert(dynamic(Term, Src, Line)) 2741 ). 2742 2743assert_thread_local(PI, Src) :- 2744 pi_to_head(PI, Term), 2745 current_source_line(Line), 2746 assert(thread_local(Term, Src, Line)). 2747 2748assert_multifile(PI, Src) :- % :- multifile(Spec) 2749 pi_to_head(PI, Term), 2750 current_source_line(Line), 2751 assert(multifile(Term, Src, Line)). 2752 2753assert_public(PI, Src) :- % :- public(Spec) 2754 pi_to_head(PI, Term), 2755 current_source_line(Line), 2756 assert_called(Src, '<public>'(Line), Term, Line), 2757 assert(public(Term, Src, Line)). 2758 2759assert_export(PI, Src) :- % :- export(Spec) 2760 pi_to_head(PI, Term), 2761 !, 2762 assert(exported(Term, Src)).
2769pi_to_head(Var, _) :- 2770 var(Var), !, fail. 2771pi_to_head(M:PI, M:Term) :- 2772 !, 2773 pi_to_head(PI, Term). 2774pi_to_head(Name/Arity, Term) :- 2775 functor(Term, Name, Arity). 2776pi_to_head(Name//DCGArity, Term) :- 2777 Arity is DCGArity+2, 2778 functor(Term, Name, Arity). 2779 2780 2781assert_used_class(Src, Name) :- 2782 used_class(Name, Src), 2783 !. 2784assert_used_class(Src, Name) :- 2785 assert(used_class(Name, Src)). 2786 2787assert_defined_class(Src, Name, _Meta, _Super, _) :- 2788 defined_class(Name, _, _, Src, _), 2789 !. 2790assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2791assert_defined_class(Src, Name, Meta, Super, Summary) :- 2792 current_source_line(Line), 2793 ( Summary == @(default) 2794 -> Atom = '' 2795 ; is_list(Summary) 2796 -> atom_codes(Atom, Summary) 2797 ; string(Summary) 2798 -> atom_concat(Summary, '', Atom) 2799 ), 2800 assert(defined_class(Name, Super, Atom, Src, Line)), 2801 ( Meta = @(_) 2802 -> true 2803 ; assert_used_class(Src, Meta) 2804 ), 2805 assert_used_class(Src, Super). 2806 2807assert_defined_class(Src, Name, imported_from(_File)) :- 2808 defined_class(Name, _, _, Src, _), 2809 !. 2810assert_defined_class(Src, Name, imported_from(File)) :- 2811 assert(defined_class(Name, _, '', Src, file(File))). 2812 2813 2814 /******************************** 2815 * UTILITIES * 2816 ********************************/
2822generalise(Var, Var) :- 2823 var(Var), 2824 !. % error? 2825generalise(pce_principal:send_implementation(Id, _, _), 2826 pce_principal:send_implementation(Id, _, _)) :- 2827 atom(Id), 2828 !. 2829generalise(pce_principal:get_implementation(Id, _, _, _), 2830 pce_principal:get_implementation(Id, _, _, _)) :- 2831 atom(Id), 2832 !. 2833generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2834generalise(test(Test), test(Test)) :- 2835 current_test_unit(_,_), 2836 ground(Test), 2837 !. 2838generalise(test(Test, _), test(Test, _)) :- 2839 current_test_unit(_,_), 2840 ground(Test), 2841 !. 2842generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !. 2843generalise(Module:Goal0, Module:Goal) :- 2844 atom(Module), 2845 !, 2846 generalise(Goal0, Goal). 2847generalise(Term0, Term) :- 2848 callable(Term0), 2849 generalise_term(Term0, Term). 2850 2851 2852 /******************************* 2853 * SOURCE MANAGEMENT * 2854 *******************************/ 2855 2856/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2857This section of the file contains hookable predicates to reason about 2858sources. The built-in code here can only deal with files. The XPCE 2859library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2860can do cross-referencing on PceEmacs edit buffers. Other examples for 2861hooking can be databases, (HTTP) URIs, etc. 2862- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2863 2864:- multifile 2865 prolog:xref_source_directory/2, % +Source, -Dir 2866 prolog:xref_source_file/3. % +Spec, -Path, +Options
2874xref_source_file(Plain, File, Source) :- 2875 xref_source_file(Plain, File, Source, []). 2876 2877xref_source_file(QSpec, File, Source, Options) :- 2878 nonvar(QSpec), QSpec = _:Spec, 2879 !, 2880 must_be(acyclic, Spec), 2881 xref_source_file(Spec, File, Source, Options). 2882xref_source_file(Spec, File, Source, Options) :- 2883 nonvar(Spec), 2884 prolog:xref_source_file(Spec, File, 2885 [ relative_to(Source) 2886 | Options 2887 ]), 2888 !. 2889xref_source_file(Plain, File, Source, Options) :- 2890 atom(Plain), 2891 \+ is_absolute_file_name(Plain), 2892 ( prolog:xref_source_directory(Source, Dir) 2893 -> true 2894 ; atom(Source), 2895 file_directory_name(Source, Dir) 2896 ), 2897 atomic_list_concat([Dir, /, Plain], Spec0), 2898 absolute_file_name(Spec0, Spec), 2899 do_xref_source_file(Spec, File, Options), 2900 !. 2901xref_source_file(Spec, File, Source, Options) :- 2902 do_xref_source_file(Spec, File, 2903 [ relative_to(Source) 2904 | Options 2905 ]), 2906 !. 2907xref_source_file(_, _, _, Options) :- 2908 option(silent(true), Options), 2909 !, 2910 fail. 2911xref_source_file(Spec, _, Src, _Options) :- 2912 verbose(Src), 2913 print_message(warning, error(existence_error(file, Spec), _)), 2914 fail. 2915 2916do_xref_source_file(Spec, File, Options) :- 2917 nonvar(Spec), 2918 option(file_type(Type), Options, prolog), 2919 absolute_file_name(Spec, File, 2920 [ file_type(Type), 2921 access(read), 2922 file_errors(fail) 2923 ]), 2924 !.
2930canonical_source(Source, Src) :-
2931 ( ground(Source)
2932 -> prolog_canonical_source(Source, Src)
2933 ; Source = Src
2934 ).name()
goals.2941goal_name_arity(Goal, Name, Arity) :- 2942 ( compound(Goal) 2943 -> compound_name_arity(Goal, Name, Arity) 2944 ; atom(Goal) 2945 -> Name = Goal, Arity = 0 2946 ). 2947 2948generalise_term(Specific, General) :- 2949 ( compound(Specific) 2950 -> compound_name_arity(Specific, Name, Arity), 2951 compound_name_arity(General, Name, Arity) 2952 ; General = Specific 2953 ). 2954 2955functor_name(Term, Name) :- 2956 ( compound(Term) 2957 -> compound_name_arity(Term, Name, _) 2958 ; atom(Term) 2959 -> Name = Term 2960 ). 2961 2962rename_goal(Goal0, Name, Goal) :- 2963 ( compound(Goal0) 2964 -> compound_name_arity(Goal0, _, Arity), 2965 compound_name_arity(Goal, Name, Arity) 2966 ; Goal = Name 2967 )
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.