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-2020, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(prolog_xref, 38 [ xref_source/1, % +Source 39 xref_source/2, % +Source, +Options 40 xref_called/3, % ?Source, ?Callable, ?By 41 xref_called/4, % ?Source, ?Callable, ?By, ?Cond 42 xref_called/5, % ?Source, ?Callable, ?By, ?Cond, ?Line 43 xref_defined/3, % ?Source. ?Callable, -How 44 xref_definition_line/2, % +How, -Line 45 xref_exported/2, % ?Source, ?Callable 46 xref_module/2, % ?Source, ?Module 47 xref_uses_file/3, % ?Source, ?Spec, ?Path 48 xref_op/2, % ?Source, ?Op 49 xref_prolog_flag/4, % ?Source, ?Flag, ?Value, ?Line 50 xref_comment/3, % ?Source, ?Title, ?Comment 51 xref_comment/4, % ?Source, ?Head, ?Summary, ?Comment 52 xref_mode/3, % ?Source, ?Mode, ?Det 53 xref_option/2, % ?Source, ?Option 54 xref_clean/1, % +Source 55 xref_current_source/1, % ?Source 56 xref_done/2, % +Source, -When 57 xref_built_in/1, % ?Callable 58 xref_source_file/3, % +Spec, -Path, +Source 59 xref_source_file/4, % +Spec, -Path, +Source, +Options 60 xref_public_list/3, % +File, +Src, +Options 61 xref_public_list/4, % +File, -Path, -Export, +Src 62 xref_public_list/6, % +File, -Path, -Module, -Export, -Meta, +Src 63 xref_public_list/7, % +File, -Path, -Module, -Export, -Public, -Meta, +Src 64 xref_meta/3, % +Source, +Goal, -Called 65 xref_meta/2, % +Goal, -Called 66 xref_hook/1, % ?Callable 67 % XPCE class references 68 xref_used_class/2, % ?Source, ?ClassName 69 xref_defined_class/3 % ?Source, ?ClassName, -How 70 ]). 71:- autoload(library(apply),[maplist/2,partition/4,maplist/3]). 72:- autoload(library(debug),[debug/3]). 73:- autoload(library(dialect),[expects_dialect/1]). 74:- autoload(library(error),[must_be/2,instantiation_error/1]). 75:- autoload(library(lists),[member/2,append/2,append/3,select/3]). 76:- autoload(library(modules),[in_temporary_module/3]). 77:- autoload(library(operators),[push_op/3]). 78:- autoload(library(option),[option/2,option/3]). 79:- autoload(library(ordsets),[ord_intersect/2,ord_intersection/3]). 80:- autoload(library(prolog_source), 81 [ prolog_canonical_source/2, 82 prolog_open_source/2, 83 prolog_close_source/1, 84 prolog_read_source_term/4 85 ]). 86:- autoload(library(shlib),[current_foreign_library/2]). 87:- autoload(library(solution_sequences),[distinct/2,limit/2]). 88 89:- if(exists_source(library(pldoc))). 90:- use_module(library(pldoc), []). % Must be loaded before doc_process 91:- use_module(library(pldoc/doc_process)). 92:- endif. 93 94:- predicate_options(xref_source/2, 2, 95 [ silent(boolean), 96 module(atom), 97 register_called(oneof([all,non_iso,non_built_in])), 98 comments(oneof([store,collect,ignore])), 99 process_include(boolean) 100 ]). 101 102 103:- dynamic 104 called/5, % Head, Src, From, Cond, Line 105 (dynamic)/3, % Head, Src, Line 106 (thread_local)/3, % Head, Src, Line 107 (multifile)/3, % Head, Src, Line 108 (public)/3, % Head, Src, Line 109 defined/3, % Head, Src, Line 110 meta_goal/3, % Head, Called, Src 111 foreign/3, % Head, Src, Line 112 constraint/3, % Head, Src, Line 113 imported/3, % Head, Src, From 114 exported/2, % Head, Src 115 xmodule/2, % Module, Src 116 uses_file/3, % Spec, Src, Path 117 xop/2, % Src, Op 118 source/2, % Src, Time 119 used_class/2, % Name, Src 120 defined_class/5, % Name, Super, Summary, Src, Line 121 (mode)/2, % Mode, Src 122 xoption/2, % Src, Option 123 xflag/4, % Name, Value, Src, Line 124 125 module_comment/3, % Src, Title, Comment 126 pred_comment/4, % Head, Src, Summary, Comment 127 pred_comment_link/3, % Head, Src, HeadTo 128 pred_mode/3. % Head, Src, Det 129 130:- create_prolog_flag(xref, false, [type(boolean)]).
167:- predicate_options(xref_source_file/4, 4, 168 [ file_type(oneof([txt,prolog,directory])), 169 silent(boolean) 170 ]). 171:- predicate_options(xref_public_list/3, 3, 172 [ path(-atom), 173 module(-atom), 174 exports(-list(any)), 175 public(-list(any)), 176 meta(-list(any)), 177 silent(boolean) 178 ]). 179 180 181 /******************************* 182 * HOOKS * 183 *******************************/
210:- multifile 211 prolog:called_by/4, % +Goal, +Module, +Context, -Called 212 prolog:called_by/2, % +Goal, -Called 213 prolog:meta_goal/2, % +Goal, -Pattern 214 prolog:hook/1, % +Callable 215 prolog:generated_predicate/1, % :PI 216 prolog:no_autoload_module/1. % Module is not suitable for autoloading. 217 218:- meta_predicate 219 prolog:generated_predicate(). 220 221:- dynamic 222 meta_goal/2. 223 224:- meta_predicate 225 process_predicates(, , ). 226 227 /******************************* 228 * BUILT-INS * 229 *******************************/
register_called.237hide_called(Callable, Src) :- 238 xoption(Src, register_called(Which)), 239 !, 240 mode_hide_called(Which, Callable). 241hide_called(Callable, _) :- 242 mode_hide_called(non_built_in, Callable). 243 244mode_hide_called(all, _) :- !, fail. 245mode_hide_called(non_iso, _:Goal) :- 246 goal_name_arity(Goal, Name, Arity), 247 current_predicate(system:Name/Arity), 248 predicate_property(system:Goal, iso). 249mode_hide_called(non_built_in, _:Goal) :- 250 goal_name_arity(Goal, Name, Arity), 251 current_predicate(system:Name/Arity), 252 predicate_property(system:Goal, built_in). 253mode_hide_called(non_built_in, M:Goal) :- 254 goal_name_arity(Goal, Name, Arity), 255 current_predicate(M:Name/Arity), 256 predicate_property(M:Goal, built_in).
262system_predicate(Goal) :- 263 goal_name_arity(Goal, Name, Arity), 264 current_predicate(system:Name/Arity), % avoid autoloading 265 predicate_property(system:Goal, built_in), 266 !. 267 268 269 /******************************** 270 * TOPLEVEL * 271 ********************************/ 272 273verbose(Src) :- 274 \+ xoption(Src, silent(true)). 275 276:- thread_local 277 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).305xref_source(Source) :- 306 xref_source(Source, []). 307 308xref_source(Source, Options) :- 309 prolog_canonical_source(Source, Src), 310 ( last_modified(Source, Modified) 311 -> ( source(Src, Modified) 312 -> true 313 ; xref_clean(Src), 314 assert(source(Src, Modified)), 315 do_xref(Src, Options) 316 ) 317 ; xref_clean(Src), 318 get_time(Now), 319 assert(source(Src, Now)), 320 do_xref(Src, Options) 321 ). 322 323do_xref(Src, Options) :- 324 must_be(list, Options), 325 setup_call_cleanup( 326 xref_setup(Src, In, Options, State), 327 collect(Src, Src, In, Options), 328 xref_cleanup(State)). 329 330last_modified(Source, Modified) :- 331 prolog:xref_source_time(Source, Modified), 332 !. 333last_modified(Source, Modified) :- 334 atom(Source), 335 \+ is_global_url(Source), 336 exists_file(Source), 337 time_file(Source, Modified). 338 339is_global_url(File) :- 340 sub_atom(File, B, _, _, '://'), 341 !, 342 B > 1, 343 sub_atom(File, 0, B, _, Scheme), 344 atom_codes(Scheme, Codes), 345 maplist(between(0'a, 0'z), Codes). 346 347xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :- 348 maplist(assert_option(Src), Options), 349 assert_default_options(Src), 350 current_prolog_flag(emulated_dialect, Dialect), 351 prolog_open_source(Src, In), 352 set_initial_mode(In, Options), 353 asserta(xref_input(Src, In), SRef), 354 set_xref(Xref), 355 ( verbose(Src) 356 -> HRefs = [] 357 ; asserta((user:thread_message_hook(_,Level,_) :- 358 hide_message(Level)), 359 Ref), 360 HRefs = [Ref] 361 ). 362 363hide_message(warning). 364hide_message(error). 365hide_message(informational). 366 367assert_option(_, Var) :- 368 var(Var), 369 !, 370 instantiation_error(Var). 371assert_option(Src, silent(Boolean)) :- 372 !, 373 must_be(boolean, Boolean), 374 assert(xoption(Src, silent(Boolean))). 375assert_option(Src, register_called(Which)) :- 376 !, 377 must_be(oneof([all,non_iso,non_built_in]), Which), 378 assert(xoption(Src, register_called(Which))). 379assert_option(Src, comments(CommentHandling)) :- 380 !, 381 must_be(oneof([store,collect,ignore]), CommentHandling), 382 assert(xoption(Src, comments(CommentHandling))). 383assert_option(Src, module(Module)) :- 384 !, 385 must_be(atom, Module), 386 assert(xoption(Src, module(Module))). 387assert_option(Src, process_include(Boolean)) :- 388 !, 389 must_be(boolean, Boolean), 390 assert(xoption(Src, process_include(Boolean))). 391 392assert_default_options(Src) :- 393 ( xref_option_default(Opt), 394 generalise_term(Opt, Gen), 395 ( xoption(Src, Gen) 396 -> true 397 ; assertz(xoption(Src, Opt)) 398 ), 399 fail 400 ; true 401 ). 402 403xref_option_default(silent(false)). 404xref_option_default(register_called(non_built_in)). 405xref_option_default(comments(collect)). 406xref_option_default(process_include(true)).
412xref_cleanup(state(In, Dialect, Xref, Refs)) :- 413 prolog_close_source(In), 414 set_prolog_flag(emulated_dialect, Dialect), 415 set_prolog_flag(xref, Xref), 416 maplist(erase, Refs). 417 418set_xref(Xref) :- 419 current_prolog_flag(xref, Xref), 420 set_prolog_flag(xref, true).
429set_initial_mode(_Stream, Options) :- 430 option(module(Module), Options), 431 !, 432 '$set_source_module'(Module). 433set_initial_mode(Stream, _) :- 434 stream_property(Stream, file_name(Path)), 435 source_file_property(Path, load_context(M, _, Opts)), 436 !, 437 '$set_source_module'(M), 438 ( option(dialect(Dialect), Opts) 439 -> expects_dialect(Dialect) 440 ; true 441 ). 442set_initial_mode(_, _) :- 443 '$set_source_module'(user).
449xref_input_stream(Stream) :-
450 xref_input(_, Var),
451 !,
452 Stream = Var.459xref_push_op(Src, P, T, N0) :- 460 '$current_source_module'(M0), 461 strip_module(M0:N0, M, N), 462 ( is_list(N), 463 N \== [] 464 -> maplist(push_op(Src, P, T, M), N) 465 ; push_op(Src, P, T, M, N) 466 ). 467 468push_op(Src, P, T, M0, N0) :- 469 strip_module(M0:N0, M, N), 470 Name = M:N, 471 valid_op(op(P,T,Name)), 472 push_op(P, T, Name), 473 assert_op(Src, op(P,T,Name)), 474 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 475 476valid_op(op(P,T,M:N)) :- 477 atom(M), 478 valid_op_name(N), 479 integer(P), 480 between(0, 1200, P), 481 atom(T), 482 op_type(T). 483 484valid_op_name(N) :- 485 atom(N), 486 !. 487valid_op_name(N) :- 488 N == []. 489 490op_type(xf). 491op_type(yf). 492op_type(fx). 493op_type(fy). 494op_type(xfx). 495op_type(xfy). 496op_type(yfx).
502xref_set_prolog_flag(Flag, Value, Src, Line) :- 503 atom(Flag), 504 !, 505 assertz(xflag(Flag, Value, Src, Line)). 506xref_set_prolog_flag(_, _, _, _).
512xref_clean(Source) :- 513 prolog_canonical_source(Source, Src), 514 retractall(called(_, Src, _Origin, _Cond, _Line)), 515 retractall(dynamic(_, Src, Line)), 516 retractall(multifile(_, Src, Line)), 517 retractall(public(_, Src, Line)), 518 retractall(defined(_, Src, Line)), 519 retractall(meta_goal(_, _, Src)), 520 retractall(foreign(_, Src, Line)), 521 retractall(constraint(_, Src, Line)), 522 retractall(imported(_, Src, _From)), 523 retractall(exported(_, Src)), 524 retractall(uses_file(_, Src, _)), 525 retractall(xmodule(_, Src)), 526 retractall(xop(Src, _)), 527 retractall(xoption(Src, _)), 528 retractall(xflag(_Name, _Value, Src, Line)), 529 retractall(source(Src, _)), 530 retractall(used_class(_, Src)), 531 retractall(defined_class(_, _, _, Src, _)), 532 retractall(mode(_, Src)), 533 retractall(module_comment(Src, _, _)), 534 retractall(pred_comment(_, Src, _, _)), 535 retractall(pred_comment_link(_, Src, _)), 536 retractall(pred_mode(_, Src, _)). 537 538 539 /******************************* 540 * READ RESULTS * 541 *******************************/
547xref_current_source(Source) :-
548 source(Source, _Time).
555xref_done(Source, Time) :-
556 prolog_canonical_source(Source, Src),
557 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.
579xref_called(Source, Called, By) :- 580 xref_called(Source, Called, By, _). 581 582xref_called(Source, Called, By, Cond) :- 583 canonical_source(Source, Src), 584 distinct(Called-By, called(Called, Src, By, Cond, _)). 585 586xref_called(Source, Called, By, Cond, Line) :- 587 canonical_source(Source, Src), 588 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)609xref_defined(Source, Called, How) :- 610 nonvar(Source), 611 !, 612 canonical_source(Source, Src), 613 xref_defined2(How, Src, Called). 614xref_defined(Source, Called, How) :- 615 xref_defined2(How, Src, Called), 616 canonical_source(Source, Src). 617 618xref_defined2(dynamic(Line), Src, Called) :- 619 dynamic(Called, Src, Line). 620xref_defined2(thread_local(Line), Src, Called) :- 621 thread_local(Called, Src, Line). 622xref_defined2(multifile(Line), Src, Called) :- 623 multifile(Called, Src, Line). 624xref_defined2(public(Line), Src, Called) :- 625 public(Called, Src, Line). 626xref_defined2(local(Line), Src, Called) :- 627 defined(Called, Src, Line). 628xref_defined2(foreign(Line), Src, Called) :- 629 foreign(Called, Src, Line). 630xref_defined2(constraint(Line), Src, Called) :- 631 constraint(Called, Src, Line). 632xref_defined2(imported(From), Src, Called) :- 633 imported(Called, Src, From).
641xref_definition_line(local(Line), Line). 642xref_definition_line(dynamic(Line), Line). 643xref_definition_line(thread_local(Line), Line). 644xref_definition_line(multifile(Line), Line). 645xref_definition_line(public(Line), Line). 646xref_definition_line(constraint(Line), Line). 647xref_definition_line(foreign(Line), Line).
654xref_exported(Source, Called) :-
655 prolog_canonical_source(Source, Src),
656 exported(Called, Src).662xref_module(Source, Module) :- 663 nonvar(Source), 664 !, 665 prolog_canonical_source(Source, Src), 666 xmodule(Module, Src). 667xref_module(Source, Module) :- 668 xmodule(Module, Src), 669 prolog_canonical_source(Source, Src).
679xref_uses_file(Source, Spec, Path) :-
680 prolog_canonical_source(Source, Src),
681 uses_file(Spec, Src, Path).
691xref_op(Source, Op) :-
692 prolog_canonical_source(Source, Src),
693 xop(Src, Op).701xref_prolog_flag(Source, Flag, Value, Line) :- 702 prolog_canonical_source(Source, Src), 703 xflag(Flag, Value, Src, Line). 704 705xref_built_in(Head) :- 706 system_predicate(Head). 707 708xref_used_class(Source, Class) :- 709 prolog_canonical_source(Source, Src), 710 used_class(Class, Src). 711 712xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 713 prolog_canonical_source(Source, Src), 714 defined_class(Class, Super, Summary, Src, Line), 715 integer(Line), 716 !. 717xref_defined_class(Source, Class, file(File)) :- 718 prolog_canonical_source(Source, Src), 719 defined_class(Class, _, _, Src, file(File)). 720 721:- thread_local 722 current_cond/1, 723 source_line/1. 724 725current_source_line(Line) :- 726 source_line(Var), 727 !, 728 Line = Var.
736collect(Src, File, In, Options) :- 737 ( Src == File 738 -> SrcSpec = Line 739 ; SrcSpec = (File:Line) 740 ), 741 option(comments(CommentHandling), Options, collect), 742 ( CommentHandling == ignore 743 -> CommentOptions = [], 744 Comments = [] 745 ; CommentHandling == store 746 -> CommentOptions = [ process_comment(true) ], 747 Comments = [] 748 ; CommentOptions = [ comments(Comments) ] 749 ), 750 repeat, 751 catch(prolog_read_source_term( 752 In, Term, Expanded, 753 [ term_position(TermPos) 754 | CommentOptions 755 ]), 756 E, report_syntax_error(E, Src, [])), 757 update_condition(Term), 758 stream_position_data(line_count, TermPos, Line), 759 setup_call_cleanup( 760 asserta(source_line(SrcSpec), Ref), 761 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 762 E, print_message(error, E)), 763 erase(Ref)), 764 EOF == true, 765 !. 766 767report_syntax_error(E, _, _) :- 768 fatal_error(E), 769 throw(E). 770report_syntax_error(_, _, Options) :- 771 option(silent(true), Options), 772 !, 773 fail. 774report_syntax_error(E, Src, _Options) :- 775 ( verbose(Src) 776 -> print_message(error, E) 777 ; true 778 ), 779 fail. 780 781fatal_error(time_limit_exceeded). 782fatal_error(error(resource_error(_),_)).
788update_condition((:-Directive)) :- 789 !, 790 update_cond(Directive). 791update_condition(_). 792 793update_cond(if(Cond)) :- 794 !, 795 asserta(current_cond(Cond)). 796update_cond(else) :- 797 retract(current_cond(C0)), 798 !, 799 assert(current_cond(\+C0)). 800update_cond(elif(Cond)) :- 801 retract(current_cond(C0)), 802 !, 803 assert(current_cond((\+C0,Cond))). 804update_cond(endif) :- 805 retract(current_cond(_)), 806 !. 807update_cond(_).
814current_condition(Condition) :- 815 \+ current_cond(_), 816 !, 817 Condition = true. 818current_condition(Condition) :- 819 findall(C, current_cond(C), List), 820 list_to_conj(List, Condition). 821 822list_to_conj([], true). 823list_to_conj([C], C) :- !. 824list_to_conj([H|T], (H,C)) :- 825 list_to_conj(T, C). 826 827 828 /******************************* 829 * PROCESS * 830 *******************************/
842process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 843 is_list(Expanded), % term_expansion into list. 844 !, 845 ( member(Term, Expanded), 846 process(Term, Term0, Src), 847 Term == end_of_file 848 -> EOF = true 849 ; EOF = false 850 ), 851 xref_comments(Comments, TermPos, Src). 852process(end_of_file, _, _, _, _, true) :- 853 !. 854process(Term, Comments, Term0, TermPos, Src, false) :- 855 process(Term, Term0, Src), 856 xref_comments(Comments, TermPos, Src).
860process(_, Term0, _) :- 861 ignore_raw_term(Term0), 862 !. 863process(Term, _Term0, Src) :- 864 process(Term, Src). 865 866ignore_raw_term((:- predicate_options(_,_,_))).
870process(Var, _) :- 871 var(Var), 872 !. % Warn? 873process(end_of_file, _) :- !. 874process((:- Directive), Src) :- 875 !, 876 process_directive(Directive, Src), 877 !. 878process((?- Directive), Src) :- 879 !, 880 process_directive(Directive, Src), 881 !. 882process((Head :- Body), Src) :- 883 !, 884 assert_defined(Src, Head), 885 process_body(Body, Head, Src). 886process((Left => Body), Src) :- 887 !, 888 ( nonvar(Left), 889 Left = (Head, Guard) 890 -> assert_defined(Src, Head), 891 process_body(Guard, Head, Src), 892 process_body(Body, Head, Src) 893 ; assert_defined(Src, Left), 894 process_body(Body, Left, Src) 895 ). 896process(?=>(Head, Body), Src) :- 897 !, 898 assert_defined(Src, Head), 899 process_body(Body, Head, Src). 900process('$source_location'(_File, _Line):Clause, Src) :- 901 !, 902 process(Clause, Src). 903process(Term, Src) :- 904 process_chr(Term, Src), 905 !. 906process(M:(Head :- Body), Src) :- 907 !, 908 process((M:Head :- M:Body), Src). 909process(Head, Src) :- 910 assert_defined(Src, Head). 911 912 913 /******************************* 914 * COMMENTS * 915 *******************************/
919xref_comments([], _Pos, _Src). 920:- if(current_predicate(parse_comment/3)). 921xref_comments([Pos-Comment|T], TermPos, Src) :- 922 ( Pos @> TermPos % comments inside term 923 -> true 924 ; stream_position_data(line_count, Pos, Line), 925 FilePos = Src:Line, 926 ( parse_comment(Comment, FilePos, Parsed) 927 -> assert_comments(Parsed, Src) 928 ; true 929 ), 930 xref_comments(T, TermPos, Src) 931 ). 932 933assert_comments([], _). 934assert_comments([H|T], Src) :- 935 assert_comment(H, Src), 936 assert_comments(T, Src). 937 938assert_comment(section(_Id, Title, Comment), Src) :- 939 assertz(module_comment(Src, Title, Comment)). 940assert_comment(predicate(PI, Summary, Comment), Src) :- 941 pi_to_head(PI, Src, Head), 942 assertz(pred_comment(Head, Src, Summary, Comment)). 943assert_comment(link(PI, PITo), Src) :- 944 pi_to_head(PI, Src, Head), 945 pi_to_head(PITo, Src, HeadTo), 946 assertz(pred_comment_link(Head, Src, HeadTo)). 947assert_comment(mode(Head, Det), Src) :- 948 assertz(pred_mode(Head, Src, Det)). 949 950pi_to_head(PI, Src, Head) :- 951 pi_to_head(PI, Head0), 952 ( Head0 = _:_ 953 -> strip_module(Head0, M, Plain), 954 ( xmodule(M, Src) 955 -> Head = Plain 956 ; Head = M:Plain 957 ) 958 ; Head = Head0 959 ). 960:- endif.
966xref_comment(Source, Title, Comment) :-
967 canonical_source(Source, Src),
968 module_comment(Src, Title, Comment).
974xref_comment(Source, Head, Summary, Comment) :-
975 canonical_source(Source, Src),
976 ( pred_comment(Head, Src, Summary, Comment)
977 ; pred_comment_link(Head, Src, HeadTo),
978 pred_comment(HeadTo, Src, Summary, Comment)
979 ).
986xref_mode(Source, Mode, Det) :-
987 canonical_source(Source, Src),
988 pred_mode(Mode, Src, Det).995xref_option(Source, Option) :- 996 canonical_source(Source, Src), 997 xoption(Src, Option). 998 999 1000 /******************************** 1001 * DIRECTIVES * 1002 ********************************/ 1003 1004process_directive(Var, _) :- 1005 var(Var), 1006 !. % error, but that isn't our business 1007process_directive(Dir, _Src) :- 1008 debug(xref(directive), 'Processing :- ~q', [Dir]), 1009 fail. 1010process_directive((A,B), Src) :- % TBD: what about other control 1011 !, 1012 process_directive(A, Src), % structures? 1013 process_directive(B, Src). 1014process_directive(List, Src) :- 1015 is_list(List), 1016 !, 1017 process_directive(consult(List), Src). 1018process_directive(use_module(File, Import), Src) :- 1019 process_use_module2(File, Import, Src, false). 1020process_directive(autoload(File, Import), Src) :- 1021 process_use_module2(File, Import, Src, false). 1022process_directive(require(Import), Src) :- 1023 process_requires(Import, Src). 1024process_directive(expects_dialect(Dialect), Src) :- 1025 process_directive(use_module(library(dialect/Dialect)), Src), 1026 expects_dialect(Dialect). 1027process_directive(reexport(File, Import), Src) :- 1028 process_use_module2(File, Import, Src, true). 1029process_directive(reexport(Modules), Src) :- 1030 process_use_module(Modules, Src, true). 1031process_directive(autoload(Modules), Src) :- 1032 process_use_module(Modules, Src, false). 1033process_directive(use_module(Modules), Src) :- 1034 process_use_module(Modules, Src, false). 1035process_directive(consult(Modules), Src) :- 1036 process_use_module(Modules, Src, false). 1037process_directive(ensure_loaded(Modules), Src) :- 1038 process_use_module(Modules, Src, false). 1039process_directive(load_files(Files, _Options), Src) :- 1040 process_use_module(Files, Src, false). 1041process_directive(include(Files), Src) :- 1042 process_include(Files, Src). 1043process_directive(dynamic(Dynamic), Src) :- 1044 process_predicates(assert_dynamic, Dynamic, Src). 1045process_directive(dynamic(Dynamic, _Options), Src) :- 1046 process_predicates(assert_dynamic, Dynamic, Src). 1047process_directive(thread_local(Dynamic), Src) :- 1048 process_predicates(assert_thread_local, Dynamic, Src). 1049process_directive(multifile(Dynamic), Src) :- 1050 process_predicates(assert_multifile, Dynamic, Src). 1051process_directive(public(Public), Src) :- 1052 process_predicates(assert_public, Public, Src). 1053process_directive(export(Export), Src) :- 1054 process_predicates(assert_export, Export, Src). 1055process_directive(import(Import), Src) :- 1056 process_import(Import, Src). 1057process_directive(module(Module, Export), Src) :- 1058 assert_module(Src, Module), 1059 assert_module_export(Src, Export). 1060process_directive(module(Module, Export, Import), Src) :- 1061 assert_module(Src, Module), 1062 assert_module_export(Src, Export), 1063 assert_module3(Import, Src). 1064process_directive('$set_source_module'(system), Src) :- 1065 assert_module(Src, system). % hack for handling boot/init.pl 1066process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1067 assert_defined_class(Src, Name, Meta, Super, Doc). 1068process_directive(pce_autoload(Name, From), Src) :- 1069 assert_defined_class(Src, Name, imported_from(From)). 1070 1071process_directive(op(P, A, N), Src) :- 1072 xref_push_op(Src, P, A, N). 1073process_directive(set_prolog_flag(Flag, Value), Src) :- 1074 ( Flag == character_escapes 1075 -> set_prolog_flag(character_escapes, Value) 1076 ; true 1077 ), 1078 current_source_line(Line), 1079 xref_set_prolog_flag(Flag, Value, Src, Line). 1080process_directive(style_check(X), _) :- 1081 style_check(X). 1082process_directive(encoding(Enc), _) :- 1083 ( xref_input_stream(Stream) 1084 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1085 ; true % can this happen? 1086 ). 1087process_directive(pce_expansion:push_compile_operators, _) :- 1088 '$current_source_module'(SM), 1089 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1090process_directive(pce_expansion:pop_compile_operators, _) :- 1091 call(pce_expansion:pop_compile_operators). 1092process_directive(meta_predicate(Meta), Src) :- 1093 process_meta_predicate(Meta, Src). 1094process_directive(arithmetic_function(FSpec), Src) :- 1095 arith_callable(FSpec, Goal), 1096 !, 1097 current_source_line(Line), 1098 assert_called(Src, '<directive>'(Line), Goal, Line). 1099process_directive(format_predicate(_, Goal), Src) :- 1100 !, 1101 current_source_line(Line), 1102 assert_called(Src, '<directive>'(Line), Goal, Line). 1103process_directive(if(Cond), Src) :- 1104 !, 1105 current_source_line(Line), 1106 assert_called(Src, '<directive>'(Line), Cond, Line). 1107process_directive(elif(Cond), Src) :- 1108 !, 1109 current_source_line(Line), 1110 assert_called(Src, '<directive>'(Line), Cond, Line). 1111process_directive(else, _) :- !. 1112process_directive(endif, _) :- !. 1113process_directive(Goal, Src) :- 1114 current_source_line(Line), 1115 process_body(Goal, '<directive>'(Line), Src).
1121process_meta_predicate((A,B), Src) :- 1122 !, 1123 process_meta_predicate(A, Src), 1124 process_meta_predicate(B, Src). 1125process_meta_predicate(Decl, Src) :- 1126 process_meta_head(Src, Decl). 1127 1128process_meta_head(Src, Decl) :- % swapped arguments for maplist 1129 compound(Decl), 1130 compound_name_arity(Decl, Name, Arity), 1131 compound_name_arity(Head, Name, Arity), 1132 meta_args(1, Arity, Decl, Head, Meta), 1133 ( ( prolog:meta_goal(Head, _) 1134 ; prolog:called_by(Head, _, _, _) 1135 ; prolog:called_by(Head, _) 1136 ; meta_goal(Head, _) 1137 ) 1138 -> true 1139 ; assert(meta_goal(Head, Meta, Src)) 1140 ). 1141 1142meta_args(I, Arity, _, _, []) :- 1143 I > Arity, 1144 !. 1145meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1146 arg(I, Decl, 0), 1147 !, 1148 arg(I, Head, H), 1149 I2 is I + 1, 1150 meta_args(I2, Arity, Decl, Head, T). 1151meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1152 arg(I, Decl, ^), 1153 !, 1154 arg(I, Head, EH), 1155 setof_goal(EH, H), 1156 I2 is I + 1, 1157 meta_args(I2, Arity, Decl, Head, T). 1158meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1159 arg(I, Decl, //), 1160 !, 1161 arg(I, Head, H), 1162 I2 is I + 1, 1163 meta_args(I2, Arity, Decl, Head, T). 1164meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1165 arg(I, Decl, A), 1166 integer(A), A > 0, 1167 !, 1168 arg(I, Head, H), 1169 I2 is I + 1, 1170 meta_args(I2, Arity, Decl, Head, T). 1171meta_args(I, Arity, Decl, Head, Meta) :- 1172 I2 is I + 1, 1173 meta_args(I2, Arity, Decl, Head, Meta). 1174 1175 1176 /******************************** 1177 * BODY * 1178 ********************************/
1187xref_meta(Source, Head, Called) :-
1188 canonical_source(Source, Src),
1189 xref_meta_src(Head, Called, Src).1204xref_meta_src(Head, Called, Src) :- 1205 meta_goal(Head, Called, Src), 1206 !. 1207xref_meta_src(Head, Called, _) :- 1208 xref_meta(Head, Called), 1209 !. 1210xref_meta_src(Head, Called, _) :- 1211 compound(Head), 1212 compound_name_arity(Head, Name, Arity), 1213 apply_pred(Name), 1214 Arity > 5, 1215 !, 1216 Extra is Arity - 1, 1217 arg(1, Head, G), 1218 Called = [G+Extra]. 1219xref_meta_src(Head, Called, _) :- 1220 predicate_property(user:Head, meta_predicate(Meta)), 1221 !, 1222 Meta =.. [_|Args], 1223 meta_args(Args, 1, Head, Called). 1224 1225meta_args([], _, _, []). 1226meta_args([H0|T0], I, Head, [H|T]) :- 1227 xargs(H0, N), 1228 !, 1229 arg(I, Head, A), 1230 ( N == 0 1231 -> H = A 1232 ; H = (A+N) 1233 ), 1234 I2 is I+1, 1235 meta_args(T0, I2, Head, T). 1236meta_args([_|T0], I, Head, T) :- 1237 I2 is I+1, 1238 meta_args(T0, I2, Head, T). 1239 1240xargs(N, N) :- integer(N), !. 1241xargs(//, 2). 1242xargs(^, 0). 1243 1244apply_pred(call). % built-in 1245apply_pred(maplist). % library(apply_macros) 1246 1247xref_meta((A, B), [A, B]). 1248xref_meta((A; B), [A, B]). 1249xref_meta((A| B), [A, B]). 1250xref_meta((A -> B), [A, B]). 1251xref_meta((A *-> B), [A, B]). 1252xref_meta(findall(_V,G,_L), [G]). 1253xref_meta(findall(_V,G,_L,_T), [G]). 1254xref_meta(findnsols(_N,_V,G,_L), [G]). 1255xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1256xref_meta(setof(_V, EG, _L), [G]) :- 1257 setof_goal(EG, G). 1258xref_meta(bagof(_V, EG, _L), [G]) :- 1259 setof_goal(EG, G). 1260xref_meta(forall(A, B), [A, B]). 1261xref_meta(maplist(G,_), [G+1]). 1262xref_meta(maplist(G,_,_), [G+2]). 1263xref_meta(maplist(G,_,_,_), [G+3]). 1264xref_meta(maplist(G,_,_,_,_), [G+4]). 1265xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1266xref_meta(map_assoc(G, _), [G+1]). 1267xref_meta(map_assoc(G, _, _), [G+2]). 1268xref_meta(checklist(G, _L), [G+1]). 1269xref_meta(sublist(G, _, _), [G+1]). 1270xref_meta(include(G, _, _), [G+1]). 1271xref_meta(exclude(G, _, _), [G+1]). 1272xref_meta(partition(G, _, _, _, _), [G+2]). 1273xref_meta(partition(G, _, _, _),[G+1]). 1274xref_meta(call(G), [G]). 1275xref_meta(call(G, _), [G+1]). 1276xref_meta(call(G, _, _), [G+2]). 1277xref_meta(call(G, _, _, _), [G+3]). 1278xref_meta(call(G, _, _, _, _), [G+4]). 1279xref_meta(not(G), [G]). 1280xref_meta(notrace(G), [G]). 1281xref_meta(\+(G), [G]). 1282xref_meta(ignore(G), [G]). 1283xref_meta(once(G), [G]). 1284xref_meta(initialization(G), [G]). 1285xref_meta(initialization(G,_), [G]). 1286xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1287xref_meta(clause(G, _), [G]). 1288xref_meta(clause(G, _, _), [G]). 1289xref_meta(phrase(G, _A), [//(G)]). 1290xref_meta(phrase(G, _A, _R), [//(G)]). 1291xref_meta(call_dcg(G, _A, _R), [//(G)]). 1292xref_meta(phrase_from_file(G,_),[//(G)]). 1293xref_meta(catch(A, _, B), [A, B]). 1294xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1295xref_meta(thread_create(A,_,_), [A]). 1296xref_meta(thread_create(A,_), [A]). 1297xref_meta(thread_signal(_,A), [A]). 1298xref_meta(thread_idle(A,_), [A]). 1299xref_meta(thread_at_exit(A), [A]). 1300xref_meta(thread_initialization(A), [A]). 1301xref_meta(engine_create(_,A,_), [A]). 1302xref_meta(engine_create(_,A,_,_), [A]). 1303xref_meta(transaction(A), [A]). 1304xref_meta(transaction(A,B,_), [A,B]). 1305xref_meta(snapshot(A), [A]). 1306xref_meta(predsort(A,_,_), [A+3]). 1307xref_meta(call_cleanup(A, B), [A, B]). 1308xref_meta(call_cleanup(A, _, B),[A, B]). 1309xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1310xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1311xref_meta(call_residue_vars(A,_), [A]). 1312xref_meta(with_mutex(_,A), [A]). 1313xref_meta(assume(G), [G]). % library(debug) 1314xref_meta(assertion(G), [G]). % library(debug) 1315xref_meta(freeze(_, G), [G]). 1316xref_meta(when(C, A), [C, A]). 1317xref_meta(time(G), [G]). % development system 1318xref_meta(call_time(G, _), [G]). % development system 1319xref_meta(call_time(G, _, _), [G]). % development system 1320xref_meta(profile(G), [G]). 1321xref_meta(at_halt(G), [G]). 1322xref_meta(call_with_time_limit(_, G), [G]). 1323xref_meta(call_with_depth_limit(G, _, _), [G]). 1324xref_meta(call_with_inference_limit(G, _, _), [G]). 1325xref_meta(alarm(_, G, _), [G]). 1326xref_meta(alarm(_, G, _, _), [G]). 1327xref_meta('$add_directive_wic'(G), [G]). 1328xref_meta(with_output_to(_, G), [G]). 1329xref_meta(if(G), [G]). 1330xref_meta(elif(G), [G]). 1331xref_meta(meta_options(G,_,_), [G+1]). 1332xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1333xref_meta(distinct(G), [G]). % library(solution_sequences) 1334xref_meta(distinct(_, G), [G]). 1335xref_meta(order_by(_, G), [G]). 1336xref_meta(limit(_, G), [G]). 1337xref_meta(offset(_, G), [G]). 1338xref_meta(reset(G,_,_), [G]). 1339xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1340xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1341xref_meta(tnot(G), [G]). 1342xref_meta(not_exists(G), [G]). 1343xref_meta(with_tty_raw(G), [G]). 1344xref_meta(residual_goals(G), [G+2]). 1345 1346 % XPCE meta-predicates 1347xref_meta(pce_global(_, new(_)), _) :- !, fail. 1348xref_meta(pce_global(_, B), [B+1]). 1349xref_meta(ifmaintainer(G), [G]). % used in manual 1350xref_meta(listen(_, G), [G]). % library(broadcast) 1351xref_meta(listen(_, _, G), [G]). 1352xref_meta(in_pce_thread(G), [G]). 1353 1354xref_meta(G, Meta) :- % call user extensions 1355 prolog:meta_goal(G, Meta). 1356xref_meta(G, Meta) :- % Generated from :- meta_predicate 1357 meta_goal(G, Meta). 1358 1359setof_goal(EG, G) :- 1360 var(EG), !, G = EG. 1361setof_goal(_^EG, G) :- 1362 !, 1363 setof_goal(EG, G). 1364setof_goal(G, G). 1365 1366event_xargs(abort, 0). 1367event_xargs(erase, 1). 1368event_xargs(break, 3). 1369event_xargs(frame_finished, 1). 1370event_xargs(thread_exit, 1). 1371event_xargs(this_thread_exit, 0). 1372event_xargs(PI, 2) :- pi_to_head(PI, _).
1378head_of(Var, _) :- 1379 var(Var), !, fail. 1380head_of((Head :- _), Head). 1381head_of(Head, Head).
1389xref_hook(Hook) :- 1390 prolog:hook(Hook). 1391xref_hook(Hook) :- 1392 hook(Hook). 1393 1394 1395hook(attr_portray_hook(_,_)). 1396hook(attr_unify_hook(_,_)). 1397hook(attribute_goals(_,_,_)). 1398hook(goal_expansion(_,_)). 1399hook(term_expansion(_,_)). 1400hook(resource(_,_,_)). 1401hook('$pred_option'(_,_,_,_)). 1402 1403hook(emacs_prolog_colours:goal_classification(_,_)). 1404hook(emacs_prolog_colours:term_colours(_,_)). 1405hook(emacs_prolog_colours:goal_colours(_,_)). 1406hook(emacs_prolog_colours:style(_,_)). 1407hook(emacs_prolog_colours:identify(_,_)). 1408hook(pce_principal:pce_class(_,_,_,_,_,_)). 1409hook(pce_principal:send_implementation(_,_,_)). 1410hook(pce_principal:get_implementation(_,_,_,_)). 1411hook(pce_principal:pce_lazy_get_method(_,_,_)). 1412hook(pce_principal:pce_lazy_send_method(_,_,_)). 1413hook(pce_principal:pce_uses_template(_,_)). 1414hook(prolog:locate_clauses(_,_)). 1415hook(prolog:message(_,_,_)). 1416hook(prolog:error_message(_,_,_)). 1417hook(prolog:message_location(_,_,_)). 1418hook(prolog:message_context(_,_,_)). 1419hook(prolog:message_line_element(_,_)). 1420hook(prolog:debug_control_hook(_)). 1421hook(prolog:help_hook(_)). 1422hook(prolog:show_profile_hook(_,_)). 1423hook(prolog:general_exception(_,_)). 1424hook(prolog:predicate_summary(_,_)). 1425hook(prolog:residual_goals(_,_)). 1426hook(prolog_edit:load). 1427hook(prolog_edit:locate(_,_,_)). 1428hook(shlib:unload_all_foreign_libraries). 1429hook(system:'$foreign_registered'(_, _)). 1430hook(predicate_options:option_decl(_,_,_)). 1431hook(user:exception(_,_,_)). 1432hook(user:file_search_path(_,_)). 1433hook(user:library_directory(_)). 1434hook(user:message_hook(_,_,_)). 1435hook(user:portray(_)). 1436hook(user:prolog_clause_name(_,_)). 1437hook(user:prolog_list_goal(_)). 1438hook(user:prolog_predicate_name(_,_)). 1439hook(user:prolog_trace_interception(_,_,_,_)). 1440hook(user:prolog_exception_hook(_,_,_,_)). 1441hook(sandbox:safe_primitive(_)). 1442hook(sandbox:safe_meta_predicate(_)). 1443hook(sandbox:safe_meta(_,_)). 1444hook(sandbox:safe_global_variable(_)). 1445hook(sandbox:safe_directive(_)).
1452arith_callable(Var, _) :- 1453 var(Var), !, fail. 1454arith_callable(Module:Spec, Module:Goal) :- 1455 !, 1456 arith_callable(Spec, Goal). 1457arith_callable(Name/Arity, Goal) :- 1458 PredArity is Arity + 1, 1459 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1470process_body(Body, Origin, Src) :-
1471 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1472 true).true if there was a
partial evalation inside Goal that has bound variables.1479process_goal(Var, _, _, _) :- 1480 var(Var), 1481 !. 1482process_goal(Goal, Origin, Src, P) :- 1483 Goal = (_,_), % problems 1484 !, 1485 phrase(conjunction(Goal), Goals), 1486 process_conjunction(Goals, Origin, Src, P). 1487process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1488 Goal = (_;_), % problems 1489 !, 1490 phrase(disjunction(Goal), Goals), 1491 forall(member(G, Goals), 1492 process_body(G, Origin, Src)). 1493process_goal(Goal, Origin, Src, P) :- 1494 ( ( xmodule(M, Src) 1495 -> true 1496 ; M = user 1497 ), 1498 ( predicate_property(M:Goal, imported_from(IM)) 1499 -> true 1500 ; IM = M 1501 ), 1502 prolog:called_by(Goal, IM, M, Called) 1503 ; prolog:called_by(Goal, Called) 1504 ), 1505 !, 1506 must_be(list, Called), 1507 current_source_line(Here), 1508 assert_called(Src, Origin, Goal, Here), 1509 process_called_list(Called, Origin, Src, P). 1510process_goal(Goal, Origin, Src, _) :- 1511 process_xpce_goal(Goal, Origin, Src), 1512 !. 1513process_goal(load_foreign_library(File), _Origin, Src, _) :- 1514 process_foreign(File, Src). 1515process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1516 process_foreign(File, Src). 1517process_goal(use_foreign_library(File), _Origin, Src, _) :- 1518 process_foreign(File, Src). 1519process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1520 process_foreign(File, Src). 1521process_goal(Goal, Origin, Src, P) :- 1522 xref_meta_src(Goal, Metas, Src), 1523 !, 1524 current_source_line(Here), 1525 assert_called(Src, Origin, Goal, Here), 1526 process_called_list(Metas, Origin, Src, P). 1527process_goal(Goal, Origin, Src, _) :- 1528 asserting_goal(Goal, Rule), 1529 !, 1530 current_source_line(Here), 1531 assert_called(Src, Origin, Goal, Here), 1532 process_assert(Rule, Origin, Src). 1533process_goal(Goal, Origin, Src, P) :- 1534 partial_evaluate(Goal, P), 1535 current_source_line(Here), 1536 assert_called(Src, Origin, Goal, Here). 1537 1538disjunction(Var) --> {var(Var), !}, [Var]. 1539disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1540disjunction(G) --> [G]. 1541 1542conjunction(Var) --> {var(Var), !}, [Var]. 1543conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1544conjunction(G) --> [G]. 1545 (RVars, T) :- 1547 term_variables(T, TVars0), 1548 sort(TVars0, TVars), 1549 ord_intersect(RVars, TVars). 1550 1551process_conjunction([], _, _, _). 1552process_conjunction([Disj|Rest], Origin, Src, P) :- 1553 nonvar(Disj), 1554 Disj = (_;_), 1555 Rest \== [], 1556 !, 1557 phrase(disjunction(Disj), Goals), 1558 term_variables(Rest, RVars0), 1559 sort(RVars0, RVars), 1560 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1561 forall(member(G, NonSHaring), 1562 process_body(G, Origin, Src)), 1563 ( Sharing == [] 1564 -> true 1565 ; maplist(term_variables, Sharing, GVars0), 1566 append(GVars0, GVars1), 1567 sort(GVars1, GVars), 1568 ord_intersection(GVars, RVars, SVars), 1569 VT =.. [v|SVars], 1570 findall(VT, 1571 ( member(G, Sharing), 1572 process_goal(G, Origin, Src, PS), 1573 PS == true 1574 ), 1575 Alts0), 1576 ( Alts0 == [] 1577 -> true 1578 ; ( true 1579 ; P = true, 1580 sort(Alts0, Alts1), 1581 variants(Alts1, 10, Alts), 1582 member(VT, Alts) 1583 ) 1584 ) 1585 ), 1586 process_conjunction(Rest, Origin, Src, P). 1587process_conjunction([H|T], Origin, Src, P) :- 1588 process_goal(H, Origin, Src, P), 1589 process_conjunction(T, Origin, Src, P). 1590 1591 1592process_called_list([], _, _, _). 1593process_called_list([H|T], Origin, Src, P) :- 1594 process_meta(H, Origin, Src, P), 1595 process_called_list(T, Origin, Src, P). 1596 1597process_meta(A+N, Origin, Src, P) :- 1598 !, 1599 ( extend(A, N, AX) 1600 -> process_goal(AX, Origin, Src, P) 1601 ; true 1602 ). 1603process_meta(//(A), Origin, Src, P) :- 1604 !, 1605 process_dcg_goal(A, Origin, Src, P). 1606process_meta(G, Origin, Src, P) :- 1607 process_goal(G, Origin, Src, P).
1614process_dcg_goal(Var, _, _, _) :- 1615 var(Var), 1616 !. 1617process_dcg_goal((A,B), Origin, Src, P) :- 1618 !, 1619 process_dcg_goal(A, Origin, Src, P), 1620 process_dcg_goal(B, Origin, Src, P). 1621process_dcg_goal((A;B), Origin, Src, P) :- 1622 !, 1623 process_dcg_goal(A, Origin, Src, P), 1624 process_dcg_goal(B, Origin, Src, P). 1625process_dcg_goal((A|B), Origin, Src, P) :- 1626 !, 1627 process_dcg_goal(A, Origin, Src, P), 1628 process_dcg_goal(B, Origin, Src, P). 1629process_dcg_goal((A->B), Origin, Src, P) :- 1630 !, 1631 process_dcg_goal(A, Origin, Src, P), 1632 process_dcg_goal(B, Origin, Src, P). 1633process_dcg_goal((A*->B), Origin, Src, P) :- 1634 !, 1635 process_dcg_goal(A, Origin, Src, P), 1636 process_dcg_goal(B, Origin, Src, P). 1637process_dcg_goal({Goal}, Origin, Src, P) :- 1638 !, 1639 process_goal(Goal, Origin, Src, P). 1640process_dcg_goal(List, _Origin, _Src, _) :- 1641 is_list(List), 1642 !. % terminal 1643process_dcg_goal(List, _Origin, _Src, _) :- 1644 string(List), 1645 !. % terminal 1646process_dcg_goal(Callable, Origin, Src, P) :- 1647 extend(Callable, 2, Goal), 1648 !, 1649 process_goal(Goal, Origin, Src, P). 1650process_dcg_goal(_, _, _, _). 1651 1652 1653extend(Var, _, _) :- 1654 var(Var), !, fail. 1655extend(M:G, N, M:GX) :- 1656 !, 1657 callable(G), 1658 extend(G, N, GX). 1659extend(G, N, GX) :- 1660 ( compound(G) 1661 -> compound_name_arguments(G, Name, Args), 1662 length(Rest, N), 1663 append(Args, Rest, NArgs), 1664 compound_name_arguments(GX, Name, NArgs) 1665 ; atom(G) 1666 -> length(NArgs, N), 1667 compound_name_arguments(GX, G, NArgs) 1668 ). 1669 1670asserting_goal(assert(Rule), Rule). 1671asserting_goal(asserta(Rule), Rule). 1672asserting_goal(assertz(Rule), Rule). 1673asserting_goal(assert(Rule,_), Rule). 1674asserting_goal(asserta(Rule,_), Rule). 1675asserting_goal(assertz(Rule,_), Rule). 1676 1677process_assert(0, _, _) :- !. % catch variables 1678process_assert((_:-Body), Origin, Src) :- 1679 !, 1680 process_body(Body, Origin, Src). 1681process_assert(_, _, _).
1685variants([], _, []). 1686variants([H|T], Max, List) :- 1687 variants(T, H, Max, List). 1688 1689variants([], H, _, [H]). 1690variants(_, _, 0, []) :- !. 1691variants([H|T], V, Max, List) :- 1692 ( H =@= V 1693 -> variants(T, V, Max, List) 1694 ; List = [V|List2], 1695 Max1 is Max-1, 1696 variants(T, H, Max1, List2) 1697 ).
T = hello(X),
findall(T, T, List),
1711partial_evaluate(Goal, P) :- 1712 eval(Goal), 1713 !, 1714 P = true. 1715partial_evaluate(_, _). 1716 1717eval(X = Y) :- 1718 unify_with_occurs_check(X, Y). 1719 1720 1721 /******************************* 1722 * XPCE STUFF * 1723 *******************************/ 1724 1725pce_goal(new(_,_), new(-, new)). 1726pce_goal(send(_,_), send(arg, msg)). 1727pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1728pce_goal(get(_,_,_), get(arg, msg, -)). 1729pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1730pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1731pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1732 1733process_xpce_goal(G, Origin, Src) :- 1734 pce_goal(G, Process), 1735 !, 1736 current_source_line(Here), 1737 assert_called(Src, Origin, G, Here), 1738 ( arg(I, Process, How), 1739 arg(I, G, Term), 1740 process_xpce_arg(How, Term, Origin, Src), 1741 fail 1742 ; true 1743 ). 1744 1745process_xpce_arg(new, Term, Origin, Src) :- 1746 callable(Term), 1747 process_new(Term, Origin, Src). 1748process_xpce_arg(arg, Term, Origin, Src) :- 1749 compound(Term), 1750 process_new(Term, Origin, Src). 1751process_xpce_arg(msg, Term, Origin, Src) :- 1752 compound(Term), 1753 ( arg(_, Term, Arg), 1754 process_xpce_arg(arg, Arg, Origin, Src), 1755 fail 1756 ; true 1757 ). 1758 1759process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1760process_new(Term, Origin, Src) :- 1761 assert_new(Src, Origin, Term), 1762 ( compound(Term), 1763 arg(_, Term, Arg), 1764 process_xpce_arg(arg, Arg, Origin, Src), 1765 fail 1766 ; true 1767 ). 1768 1769assert_new(_, _, Term) :- 1770 \+ callable(Term), 1771 !. 1772assert_new(Src, Origin, Control) :- 1773 functor_name(Control, Class), 1774 pce_control_class(Class), 1775 !, 1776 forall(arg(_, Control, Arg), 1777 assert_new(Src, Origin, Arg)). 1778assert_new(Src, Origin, Term) :- 1779 compound(Term), 1780 arg(1, Term, Prolog), 1781 Prolog == @(prolog), 1782 ( Term =.. [message, _, Selector | T], 1783 atom(Selector) 1784 -> Called =.. [Selector|T], 1785 process_body(Called, Origin, Src) 1786 ; Term =.. [?, _, Selector | T], 1787 atom(Selector) 1788 -> append(T, [_R], T2), 1789 Called =.. [Selector|T2], 1790 process_body(Called, Origin, Src) 1791 ), 1792 fail. 1793assert_new(_, _, @(_)) :- !. 1794assert_new(Src, _, Term) :- 1795 functor_name(Term, Name), 1796 assert_used_class(Src, Name). 1797 1798 1799pce_control_class(and). 1800pce_control_class(or). 1801pce_control_class(if). 1802pce_control_class(not). 1803 1804 1805 /******************************** 1806 * INCLUDED MODULES * 1807 ********************************/
1811process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1812process_use_module([], _, _) :- !. 1813process_use_module([H|T], Src, Reexport) :- 1814 !, 1815 process_use_module(H, Src, Reexport), 1816 process_use_module(T, Src, Reexport). 1817process_use_module(library(pce), Src, Reexport) :- % bit special 1818 !, 1819 xref_public_list(library(pce), Path, Exports, Src), 1820 forall(member(Import, Exports), 1821 process_pce_import(Import, Src, Path, Reexport)). 1822process_use_module(File, Src, Reexport) :- 1823 load_module_if_needed(File), 1824 ( xoption(Src, silent(Silent)) 1825 -> Extra = [silent(Silent)] 1826 ; Extra = [silent(true)] 1827 ), 1828 ( xref_public_list(File, Src, 1829 [ path(Path), 1830 module(M), 1831 exports(Exports), 1832 public(Public), 1833 meta(Meta) 1834 | Extra 1835 ]) 1836 -> assert(uses_file(File, Src, Path)), 1837 assert_import(Src, Exports, _, Path, Reexport), 1838 assert_xmodule_callable(Exports, M, Src, Path), 1839 assert_xmodule_callable(Public, M, Src, Path), 1840 maplist(process_meta_head(Src), Meta), 1841 ( File = library(chr) % hacky 1842 -> assert(mode(chr, Src)) 1843 ; true 1844 ) 1845 ; assert(uses_file(File, Src, '<not_found>')) 1846 ). 1847 1848process_pce_import(Name/Arity, Src, Path, Reexport) :- 1849 atom(Name), 1850 integer(Arity), 1851 !, 1852 functor(Term, Name, Arity), 1853 ( \+ system_predicate(Term), 1854 \+ Term = pce_error(_) % hack!? 1855 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1856 ; true 1857 ). 1858process_pce_import(op(P,T,N), Src, _, _) :- 1859 xref_push_op(Src, P, T, N).
1865process_use_module2(File, Import, Src, Reexport) :-
1866 load_module_if_needed(File),
1867 ( xref_source_file(File, Path, Src)
1868 -> assert(uses_file(File, Src, Path)),
1869 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1870 -> assert_import(Src, Import, Export, Path, Reexport),
1871 forall(( member(Head, Meta),
1872 imported(Head, _, Path)
1873 ),
1874 process_meta_head(Src, Head))
1875 ; true
1876 )
1877 ; assert(uses_file(File, Src, '<not_found>'))
1878 ).1887load_module_if_needed(File) :- 1888 prolog:no_autoload_module(File), 1889 !, 1890 use_module(File, []). 1891load_module_if_needed(_). 1892 1893prologno_autoload_module(library(apply_macros)). 1894prologno_autoload_module(library(arithmetic)). 1895prologno_autoload_module(library(record)). 1896prologno_autoload_module(library(persistency)). 1897prologno_autoload_module(library(pldoc)). 1898prologno_autoload_module(library(settings)). 1899prologno_autoload_module(library(debug)). 1900prologno_autoload_module(library(plunit)).
1905process_requires(Import, Src) :- 1906 is_list(Import), 1907 !, 1908 require_list(Import, Src). 1909process_requires(Var, _Src) :- 1910 var(Var), 1911 !. 1912process_requires((A,B), Src) :- 1913 !, 1914 process_requires(A, Src), 1915 process_requires(B, Src). 1916process_requires(PI, Src) :- 1917 requires(PI, Src). 1918 1919require_list([], _). 1920require_list([H|T], Src) :- 1921 requires(H, Src), 1922 require_list(T, Src). 1923 1924requires(PI, _Src) :- 1925 '$pi_head'(PI, Head), 1926 '$get_predicate_attribute'(system:Head, defined, 1), 1927 !. 1928requires(PI, Src) :- 1929 '$pi_head'(PI, Head), 1930 '$pi_head'(Name/Arity, Head), 1931 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1932 ( imported(Head, Src, Library) 1933 -> true 1934 ; assertz(imported(Head, Src, Library)) 1935 ).
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.
1966xref_public_list(File, Src, Options) :-
1967 option(path(Path), Options, _),
1968 option(module(Module), Options, _),
1969 option(exports(Exports), Options, _),
1970 option(public(Public), Options, _),
1971 option(meta(Meta), Options, _),
1972 xref_source_file(File, Path, Src, Options),
1973 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
1995xref_public_list(File, Path, Export, Src) :- 1996 xref_source_file(File, Path, Src), 1997 public_list(Path, _, _, Export, _, []). 1998xref_public_list(File, Path, Module, Export, Meta, Src) :- 1999 xref_source_file(File, Path, Src), 2000 public_list(Path, Module, Meta, Export, _, []). 2001xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 2002 xref_source_file(File, Path, Src), 2003 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2013:- dynamic public_list_cache/6. 2014:- volatile public_list_cache/6. 2015 2016public_list(Path, Module, Meta, Export, Public, _Options) :- 2017 public_list_cache(Path, Modified, 2018 Module0, Meta0, Export0, Public0), 2019 time_file(Path, ModifiedNow), 2020 ( abs(Modified-ModifiedNow) < 0.0001 2021 -> !, 2022 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2023 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2024 fail 2025 ). 2026public_list(Path, Module, Meta, Export, Public, Options) :- 2027 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2028 ( Error = error(_,_), 2029 catch(time_file(Path, Modified), Error, fail) 2030 -> asserta(public_list_cache(Path, Modified, 2031 Module0, Meta0, Export0, Public0)) 2032 ; true 2033 ), 2034 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2035 2036public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2037 in_temporary_module( 2038 TempModule, 2039 true, 2040 public_list_diff(TempModule, Path, Module, 2041 Meta, [], Export, [], Public, [], Options)). 2042 2043 2044public_list_diff(TempModule, 2045 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2046 setup_call_cleanup( 2047 public_list_setup(TempModule, Path, In, State), 2048 phrase(read_directives(In, Options, [true]), Directives), 2049 public_list_cleanup(In, State)), 2050 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2051 2052public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2053 prolog_open_source(Path, In), 2054 '$set_source_module'(OldM, TempModule), 2055 set_xref(OldXref). 2056 2057public_list_cleanup(In, state(OldM, OldXref)) :- 2058 '$set_source_module'(OldM), 2059 set_prolog_flag(xref, OldXref), 2060 prolog_close_source(In). 2061 2062 2063read_directives(In, Options, State) --> 2064 { repeat, 2065 catch(prolog_read_source_term(In, Term, Expanded, 2066 [ process_comment(true), 2067 syntax_errors(error) 2068 ]), 2069 E, report_syntax_error(E, -, Options)) 2070 -> nonvar(Term), 2071 Term = (:-_) 2072 }, 2073 !, 2074 terms(Expanded, State, State1), 2075 read_directives(In, Options, State1). 2076read_directives(_, _, _) --> []. 2077 2078terms(Var, State, State) --> { var(Var) }, !. 2079terms([H|T], State0, State) --> 2080 !, 2081 terms(H, State0, State1), 2082 terms(T, State1, State). 2083terms((:-if(Cond)), State0, [True|State0]) --> 2084 !, 2085 { eval_cond(Cond, True) }. 2086terms((:-elif(Cond)), [True0|State], [True|State]) --> 2087 !, 2088 { eval_cond(Cond, True1), 2089 elif(True0, True1, True) 2090 }. 2091terms((:-else), [True0|State], [True|State]) --> 2092 !, 2093 { negate(True0, True) }. 2094terms((:-endif), [_|State], State) --> !. 2095terms(H, State, State) --> 2096 ( {State = [true|_]} 2097 -> [H] 2098 ; [] 2099 ). 2100 2101eval_cond(Cond, true) :- 2102 catch(Cond, _, fail), 2103 !. 2104eval_cond(_, false). 2105 2106elif(true, _, else_false) :- !. 2107elif(false, true, true) :- !. 2108elif(True, _, True). 2109 2110negate(true, false). 2111negate(false, true). 2112negate(else_false, else_false). 2113 2114public_list([(:- module(Module, Export0))|Decls], Path, 2115 Module, Meta, MT, Export, Rest, Public, PT) :- 2116 !, 2117 ( is_list(Export0) 2118 -> append(Export0, Reexport, Export) 2119 ; Reexport = Export 2120 ), 2121 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2122public_list([(:- encoding(_))|Decls], Path, 2123 Module, Meta, MT, Export, Rest, Public, PT) :- 2124 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2125 2126public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2127public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2128 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2129 !, 2130 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2131public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2132 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2133 2134public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2135 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2136public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2137 public_from_import(Import, Spec, Path, Reexport, Rest). 2138public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2139 phrase(meta_decls(Decl), Meta, MT). 2140public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2141 phrase(public_decls(Decl), Public, PT).
2147reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2148reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2149 !, 2150 xref_source_file(H, Path, Src), 2151 public_list(Path, _Module, Meta0, Export0, Public0, []), 2152 append(Meta0, MT1, Meta), 2153 append(Export0, ET1, Export), 2154 append(Public0, PT1, Public), 2155 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2156reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2157 xref_source_file(Spec, Path, Src), 2158 public_list(Path, _Module, Meta0, Export0, Public0, []), 2159 append(Meta0, MT, Meta), 2160 append(Export0, ET, Export), 2161 append(Public0, PT, Public). 2162 2163public_from_import(except(Map), Path, Src, Export, Rest) :- 2164 !, 2165 xref_public_list(Path, _, AllExports, Src), 2166 except(Map, AllExports, NewExports), 2167 append(NewExports, Rest, Export). 2168public_from_import(Import, _, _, Export, Rest) :- 2169 import_name_map(Import, Export, Rest).
2174except([], Exports, Exports). 2175except([PI0 as NewName|Map], Exports0, Exports) :- 2176 !, 2177 canonical_pi(PI0, PI), 2178 map_as(Exports0, PI, NewName, Exports1), 2179 except(Map, Exports1, Exports). 2180except([PI0|Map], Exports0, Exports) :- 2181 canonical_pi(PI0, PI), 2182 select(PI2, Exports0, Exports1), 2183 same_pi(PI, PI2), 2184 !, 2185 except(Map, Exports1, Exports). 2186 2187 2188map_as([PI|T], Repl, As, [PI2|T]) :- 2189 same_pi(Repl, PI), 2190 !, 2191 pi_as(PI, As, PI2). 2192map_as([H|T0], Repl, As, [H|T]) :- 2193 map_as(T0, Repl, As, T). 2194 2195pi_as(_/Arity, Name, Name/Arity). 2196pi_as(_//Arity, Name, Name//Arity). 2197 2198import_name_map([], L, L). 2199import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2200 !, 2201 import_name_map(T0, T, Tail). 2202import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2203 !, 2204 import_name_map(T0, T, Tail). 2205import_name_map([H|T0], [H|T], Tail) :- 2206 import_name_map(T0, T, Tail). 2207 2208canonical_pi(Name//Arity0, PI) :- 2209 integer(Arity0), 2210 !, 2211 PI = Name/Arity, 2212 Arity is Arity0 + 2. 2213canonical_pi(PI, PI). 2214 2215same_pi(Canonical, PI2) :- 2216 canonical_pi(PI2, Canonical). 2217 2218meta_decls(Var) --> 2219 { var(Var) }, 2220 !. 2221meta_decls((A,B)) --> 2222 !, 2223 meta_decls(A), 2224 meta_decls(B). 2225meta_decls(A) --> 2226 [A]. 2227 2228public_decls(Var) --> 2229 { var(Var) }, 2230 !. 2231public_decls((A,B)) --> 2232 !, 2233 public_decls(A), 2234 public_decls(B). 2235public_decls(A) --> 2236 [A]. 2237 2238 /******************************* 2239 * INCLUDE * 2240 *******************************/ 2241 2242process_include([], _) :- !. 2243process_include([H|T], Src) :- 2244 !, 2245 process_include(H, Src), 2246 process_include(T, Src). 2247process_include(File, Src) :- 2248 callable(File), 2249 !, 2250 ( once(xref_input(ParentSrc, _)), 2251 xref_source_file(File, Path, ParentSrc) 2252 -> ( ( uses_file(_, Src, Path) 2253 ; Path == Src 2254 ) 2255 -> true 2256 ; assert(uses_file(File, Src, Path)), 2257 ( xoption(Src, process_include(true)) 2258 -> findall(O, xoption(Src, O), Options), 2259 setup_call_cleanup( 2260 open_include_file(Path, In, Refs), 2261 collect(Src, Path, In, Options), 2262 close_include(In, Refs)) 2263 ; true 2264 ) 2265 ) 2266 ; assert(uses_file(File, Src, '<not_found>')) 2267 ). 2268process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2276open_include_file(Path, In, [Ref]) :- 2277 once(xref_input(_, Parent)), 2278 stream_property(Parent, encoding(Enc)), 2279 '$push_input_context'(xref_include), 2280 catch(( prolog:xref_open_source(Path, In) 2281 -> catch(set_stream(In, encoding(Enc)), 2282 error(_,_), true) % deal with non-file input 2283 ; include_encoding(Enc, Options), 2284 open(Path, read, In, Options) 2285 ), E, 2286 ( '$pop_input_context', throw(E))), 2287 catch(( peek_char(In, #) % Deal with #! script 2288 -> skip(In, 10) 2289 ; true 2290 ), E, 2291 ( close_include(In, []), throw(E))), 2292 asserta(xref_input(Path, In), Ref). 2293 2294include_encoding(wchar_t, []) :- !. 2295include_encoding(Enc, [encoding(Enc)]). 2296 2297 2298close_include(In, Refs) :- 2299 maplist(erase, Refs), 2300 close(In, [force(true)]), 2301 '$pop_input_context'.
2307process_foreign(Spec, Src) :- 2308 ground(Spec), 2309 current_foreign_library(Spec, Defined), 2310 !, 2311 ( xmodule(Module, Src) 2312 -> true 2313 ; Module = user 2314 ), 2315 process_foreign_defined(Defined, Module, Src). 2316process_foreign(_, _). 2317 2318process_foreign_defined([], _, _). 2319process_foreign_defined([H|T], M, Src) :- 2320 ( H = M:Head 2321 -> assert_foreign(Src, Head) 2322 ; assert_foreign(Src, H) 2323 ), 2324 process_foreign_defined(T, M, Src). 2325 2326 2327 /******************************* 2328 * CHR SUPPORT * 2329 *******************************/ 2330 2331/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2332This part of the file supports CHR. Our choice is between making special 2333hooks to make CHR expansion work and then handle the (complex) expanded 2334code or process the CHR source directly. The latter looks simpler, 2335though I don't like the idea of adding support for libraries to this 2336module. A file is supposed to be a CHR file if it uses a 2337use_module(library(chr) or contains a :- constraint/1 directive. As an 2338extra bonus we get the source-locations right :-) 2339- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2340 2341process_chr(@(_Name, Rule), Src) :- 2342 mode(chr, Src), 2343 process_chr(Rule, Src). 2344process_chr(pragma(Rule, _Pragma), Src) :- 2345 mode(chr, Src), 2346 process_chr(Rule, Src). 2347process_chr(<=>(Head, Body), Src) :- 2348 mode(chr, Src), 2349 chr_head(Head, Src, H), 2350 chr_body(Body, H, Src). 2351process_chr(==>(Head, Body), Src) :- 2352 mode(chr, Src), 2353 chr_head(Head, H, Src), 2354 chr_body(Body, H, Src). 2355process_chr((:- chr_constraint(_)), Src) :- 2356 ( mode(chr, Src) 2357 -> true 2358 ; assert(mode(chr, Src)) 2359 ). 2360 2361chr_head(X, _, _) :- 2362 var(X), 2363 !. % Illegal. Warn? 2364chr_head(\(A,B), Src, H) :- 2365 chr_head(A, Src, H), 2366 process_body(B, H, Src). 2367chr_head((H0,B), Src, H) :- 2368 chr_defined(H0, Src, H), 2369 process_body(B, H, Src). 2370chr_head(H0, Src, H) :- 2371 chr_defined(H0, Src, H). 2372 2373chr_defined(X, _, _) :- 2374 var(X), 2375 !. 2376chr_defined(#(C,_Id), Src, C) :- 2377 !, 2378 assert_constraint(Src, C). 2379chr_defined(A, Src, A) :- 2380 assert_constraint(Src, A). 2381 2382chr_body(X, From, Src) :- 2383 var(X), 2384 !, 2385 process_body(X, From, Src). 2386chr_body('|'(Guard, Goals), H, Src) :- 2387 !, 2388 chr_body(Guard, H, Src), 2389 chr_body(Goals, H, Src). 2390chr_body(G, From, Src) :- 2391 process_body(G, From, Src). 2392 2393assert_constraint(_, Head) :- 2394 var(Head), 2395 !. 2396assert_constraint(Src, Head) :- 2397 constraint(Head, Src, _), 2398 !. 2399assert_constraint(Src, Head) :- 2400 generalise_term(Head, Term), 2401 current_source_line(Line), 2402 assert(constraint(Term, Src, Line)). 2403 2404 2405 /******************************** 2406 * PHASE 1 ASSERTIONS * 2407 ********************************/
2414assert_called(_, _, Var, _) :- 2415 var(Var), 2416 !. 2417assert_called(Src, From, Goal, Line) :- 2418 var(From), 2419 !, 2420 assert_called(Src, '<unknown>', Goal, Line). 2421assert_called(_, _, Goal, _) :- 2422 expand_hide_called(Goal), 2423 !. 2424assert_called(Src, Origin, M:G, Line) :- 2425 !, 2426 ( atom(M), 2427 callable(G) 2428 -> current_condition(Cond), 2429 ( xmodule(M, Src) % explicit call to own module 2430 -> assert_called(Src, Origin, G, Line) 2431 ; called(M:G, Src, Origin, Cond, Line) % already registered 2432 -> true 2433 ; hide_called(M:G, Src) % not interesting (now) 2434 -> true 2435 ; generalise(Origin, OTerm), 2436 generalise(G, GTerm) 2437 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2438 ; true 2439 ) 2440 ; true % call to variable module 2441 ). 2442assert_called(Src, _, Goal, _) :- 2443 ( xmodule(M, Src) 2444 -> M \== system 2445 ; M = user 2446 ), 2447 hide_called(M:Goal, Src), 2448 !. 2449assert_called(Src, Origin, Goal, Line) :- 2450 current_condition(Cond), 2451 ( called(Goal, Src, Origin, Cond, Line) 2452 -> true 2453 ; generalise(Origin, OTerm), 2454 generalise(Goal, Term) 2455 -> assert(called(Term, Src, OTerm, Cond, Line)) 2456 ; true 2457 ).
2465expand_hide_called(pce_principal:send_implementation(_, _, _)). 2466expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2467expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2468expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2469 2470assert_defined(Src, Goal) :- 2471 defined(Goal, Src, _), 2472 !. 2473assert_defined(Src, Goal) :- 2474 generalise(Goal, Term), 2475 current_source_line(Line), 2476 assert(defined(Term, Src, Line)). 2477 2478assert_foreign(Src, Goal) :- 2479 foreign(Goal, Src, _), 2480 !. 2481assert_foreign(Src, Goal) :- 2482 generalise(Goal, Term), 2483 current_source_line(Line), 2484 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2496assert_import(_, [], _, _, _) :- !. 2497assert_import(Src, [H|T], Export, From, Reexport) :- 2498 !, 2499 assert_import(Src, H, Export, From, Reexport), 2500 assert_import(Src, T, Export, From, Reexport). 2501assert_import(Src, except(Except), Export, From, Reexport) :- 2502 !, 2503 is_list(Export), 2504 !, 2505 except(Except, Export, Import), 2506 assert_import(Src, Import, _All, From, Reexport). 2507assert_import(Src, Import as Name, Export, From, Reexport) :- 2508 !, 2509 pi_to_head(Import, Term0), 2510 rename_goal(Term0, Name, Term), 2511 ( in_export_list(Term0, Export) 2512 -> assert(imported(Term, Src, From)), 2513 assert_reexport(Reexport, Src, Term) 2514 ; current_source_line(Line), 2515 assert_called(Src, '<directive>'(Line), Term0, Line) 2516 ). 2517assert_import(Src, Import, Export, From, Reexport) :- 2518 pi_to_head(Import, Term), 2519 !, 2520 ( in_export_list(Term, Export) 2521 -> assert(imported(Term, Src, From)), 2522 assert_reexport(Reexport, Src, Term) 2523 ; current_source_line(Line), 2524 assert_called(Src, '<directive>'(Line), Term, Line) 2525 ). 2526assert_import(Src, op(P,T,N), _, _, _) :- 2527 xref_push_op(Src, P,T,N). 2528 2529in_export_list(_Head, Export) :- 2530 var(Export), 2531 !. 2532in_export_list(Head, Export) :- 2533 member(PI, Export), 2534 pi_to_head(PI, Head). 2535 2536assert_reexport(false, _, _) :- !. 2537assert_reexport(true, Src, Term) :- 2538 assert(exported(Term, Src)).
2544process_import(M:PI, Src) :- 2545 pi_to_head(PI, Head), 2546 !, 2547 ( atom(M), 2548 current_module(M), 2549 module_property(M, file(From)) 2550 -> true 2551 ; From = '<unknown>' 2552 ), 2553 assert(imported(Head, Src, From)). 2554process_import(_, _).
2563assert_xmodule_callable([], _, _, _). 2564assert_xmodule_callable([PI|T], M, Src, From) :- 2565 ( pi_to_head(M:PI, Head) 2566 -> assert(imported(Head, Src, From)) 2567 ; true 2568 ), 2569 assert_xmodule_callable(T, M, Src, From).
2576assert_op(Src, op(P,T,M:N)) :-
2577 ( '$current_source_module'(M)
2578 -> Name = N
2579 ; Name = M:N
2580 ),
2581 ( xop(Src, op(P,T,Name))
2582 -> true
2583 ; assert(xop(Src, op(P,T,Name)))
2584 ).2591assert_module(Src, Module) :- 2592 xmodule(Module, Src), 2593 !. 2594assert_module(Src, Module) :- 2595 '$set_source_module'(Module), 2596 assert(xmodule(Module, Src)), 2597 ( module_property(Module, class(system)) 2598 -> retractall(xoption(Src, register_called(_))), 2599 assert(xoption(Src, register_called(all))) 2600 ; true 2601 ). 2602 2603assert_module_export(_, []) :- !. 2604assert_module_export(Src, [H|T]) :- 2605 !, 2606 assert_module_export(Src, H), 2607 assert_module_export(Src, T). 2608assert_module_export(Src, PI) :- 2609 pi_to_head(PI, Term), 2610 !, 2611 assert(exported(Term, Src)). 2612assert_module_export(Src, op(P, A, N)) :- 2613 xref_push_op(Src, P, A, N).
2619assert_module3([], _) :- !. 2620assert_module3([H|T], Src) :- 2621 !, 2622 assert_module3(H, Src), 2623 assert_module3(T, Src). 2624assert_module3(Option, Src) :- 2625 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2634process_predicates(Closure, Preds, Src) :- 2635 is_list(Preds), 2636 !, 2637 process_predicate_list(Preds, Closure, Src). 2638process_predicates(Closure, as(Preds, _Options), Src) :- 2639 !, 2640 process_predicates(Closure, Preds, Src). 2641process_predicates(Closure, Preds, Src) :- 2642 process_predicate_comma(Preds, Closure, Src). 2643 2644process_predicate_list([], _, _). 2645process_predicate_list([H|T], Closure, Src) :- 2646 ( nonvar(H) 2647 -> call(Closure, H, Src) 2648 ; true 2649 ), 2650 process_predicate_list(T, Closure, Src). 2651 2652process_predicate_comma(Var, _, _) :- 2653 var(Var), 2654 !. 2655process_predicate_comma(M:(A,B), Closure, Src) :- 2656 !, 2657 process_predicate_comma(M:A, Closure, Src), 2658 process_predicate_comma(M:B, Closure, Src). 2659process_predicate_comma((A,B), Closure, Src) :- 2660 !, 2661 process_predicate_comma(A, Closure, Src), 2662 process_predicate_comma(B, Closure, Src). 2663process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2664 !, 2665 process_predicate_comma(Spec, Closure, Src). 2666process_predicate_comma(A, Closure, Src) :- 2667 call(Closure, A, Src). 2668 2669 2670assert_dynamic(PI, Src) :- 2671 pi_to_head(PI, Term), 2672 ( thread_local(Term, Src, _) % dynamic after thread_local has 2673 -> true % no effect 2674 ; current_source_line(Line), 2675 assert(dynamic(Term, Src, Line)) 2676 ). 2677 2678assert_thread_local(PI, Src) :- 2679 pi_to_head(PI, Term), 2680 current_source_line(Line), 2681 assert(thread_local(Term, Src, Line)). 2682 2683assert_multifile(PI, Src) :- % :- multifile(Spec) 2684 pi_to_head(PI, Term), 2685 current_source_line(Line), 2686 assert(multifile(Term, Src, Line)). 2687 2688assert_public(PI, Src) :- % :- public(Spec) 2689 pi_to_head(PI, Term), 2690 current_source_line(Line), 2691 assert_called(Src, '<public>'(Line), Term, Line), 2692 assert(public(Term, Src, Line)). 2693 2694assert_export(PI, Src) :- % :- export(Spec) 2695 pi_to_head(PI, Term), 2696 !, 2697 assert(exported(Term, Src)).
2704pi_to_head(Var, _) :- 2705 var(Var), !, fail. 2706pi_to_head(M:PI, M:Term) :- 2707 !, 2708 pi_to_head(PI, Term). 2709pi_to_head(Name/Arity, Term) :- 2710 functor(Term, Name, Arity). 2711pi_to_head(Name//DCGArity, Term) :- 2712 Arity is DCGArity+2, 2713 functor(Term, Name, Arity). 2714 2715 2716assert_used_class(Src, Name) :- 2717 used_class(Name, Src), 2718 !. 2719assert_used_class(Src, Name) :- 2720 assert(used_class(Name, Src)). 2721 2722assert_defined_class(Src, Name, _Meta, _Super, _) :- 2723 defined_class(Name, _, _, Src, _), 2724 !. 2725assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2726assert_defined_class(Src, Name, Meta, Super, Summary) :- 2727 current_source_line(Line), 2728 ( Summary == @(default) 2729 -> Atom = '' 2730 ; is_list(Summary) 2731 -> atom_codes(Atom, Summary) 2732 ; string(Summary) 2733 -> atom_concat(Summary, '', Atom) 2734 ), 2735 assert(defined_class(Name, Super, Atom, Src, Line)), 2736 ( Meta = @(_) 2737 -> true 2738 ; assert_used_class(Src, Meta) 2739 ), 2740 assert_used_class(Src, Super). 2741 2742assert_defined_class(Src, Name, imported_from(_File)) :- 2743 defined_class(Name, _, _, Src, _), 2744 !. 2745assert_defined_class(Src, Name, imported_from(File)) :- 2746 assert(defined_class(Name, _, '', Src, file(File))). 2747 2748 2749 /******************************** 2750 * UTILITIES * 2751 ********************************/
2757generalise(Var, Var) :- 2758 var(Var), 2759 !. % error? 2760generalise(pce_principal:send_implementation(Id, _, _), 2761 pce_principal:send_implementation(Id, _, _)) :- 2762 atom(Id), 2763 !. 2764generalise(pce_principal:get_implementation(Id, _, _, _), 2765 pce_principal:get_implementation(Id, _, _, _)) :- 2766 atom(Id), 2767 !. 2768generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2769generalise(Module:Goal0, Module:Goal) :- 2770 atom(Module), 2771 !, 2772 generalise(Goal0, Goal). 2773generalise(Term0, Term) :- 2774 callable(Term0), 2775 generalise_term(Term0, Term). 2776 2777 2778 /******************************* 2779 * SOURCE MANAGEMENT * 2780 *******************************/ 2781 2782/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2783This section of the file contains hookable predicates to reason about 2784sources. The built-in code here can only deal with files. The XPCE 2785library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2786can do cross-referencing on PceEmacs edit buffers. Other examples for 2787hooking can be databases, (HTTP) URIs, etc. 2788- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2789 2790:- multifile 2791 prolog:xref_source_directory/2, % +Source, -Dir 2792 prolog:xref_source_file/3. % +Spec, -Path, +Options
2800xref_source_file(Plain, File, Source) :- 2801 xref_source_file(Plain, File, Source, []). 2802 2803xref_source_file(QSpec, File, Source, Options) :- 2804 nonvar(QSpec), QSpec = _:Spec, 2805 !, 2806 must_be(acyclic, Spec), 2807 xref_source_file(Spec, File, Source, Options). 2808xref_source_file(Spec, File, Source, Options) :- 2809 nonvar(Spec), 2810 prolog:xref_source_file(Spec, File, 2811 [ relative_to(Source) 2812 | Options 2813 ]), 2814 !. 2815xref_source_file(Plain, File, Source, Options) :- 2816 atom(Plain), 2817 \+ is_absolute_file_name(Plain), 2818 ( prolog:xref_source_directory(Source, Dir) 2819 -> true 2820 ; atom(Source), 2821 file_directory_name(Source, Dir) 2822 ), 2823 atomic_list_concat([Dir, /, Plain], Spec0), 2824 absolute_file_name(Spec0, Spec), 2825 do_xref_source_file(Spec, File, Options), 2826 !. 2827xref_source_file(Spec, File, Source, Options) :- 2828 do_xref_source_file(Spec, File, 2829 [ relative_to(Source) 2830 | Options 2831 ]), 2832 !. 2833xref_source_file(_, _, _, Options) :- 2834 option(silent(true), Options), 2835 !, 2836 fail. 2837xref_source_file(Spec, _, Src, _Options) :- 2838 verbose(Src), 2839 print_message(warning, error(existence_error(file, Spec), _)), 2840 fail. 2841 2842do_xref_source_file(Spec, File, Options) :- 2843 nonvar(Spec), 2844 option(file_type(Type), Options, prolog), 2845 absolute_file_name(Spec, File, 2846 [ file_type(Type), 2847 access(read), 2848 file_errors(fail) 2849 ]), 2850 !.
2856canonical_source(Source, Src) :-
2857 ( ground(Source)
2858 -> prolog_canonical_source(Source, Src)
2859 ; Source = Src
2860 ).name()
goals.2867goal_name_arity(Goal, Name, Arity) :- 2868 ( compound(Goal) 2869 -> compound_name_arity(Goal, Name, Arity) 2870 ; atom(Goal) 2871 -> Name = Goal, Arity = 0 2872 ). 2873 2874generalise_term(Specific, General) :- 2875 ( compound(Specific) 2876 -> compound_name_arity(Specific, Name, Arity), 2877 compound_name_arity(General, Name, Arity) 2878 ; General = Specific 2879 ). 2880 2881functor_name(Term, Name) :- 2882 ( compound(Term) 2883 -> compound_name_arity(Term, Name, _) 2884 ; atom(Term) 2885 -> Name = Term 2886 ). 2887 2888rename_goal(Goal0, Name, Goal) :- 2889 ( compound(Goal0) 2890 -> compound_name_arity(Goal0, _, Arity), 2891 compound_name_arity(Goal, Name, Arity) 2892 ; Goal = Name 2893 )
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.