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-2019, 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:- use_module(library(lists), [append/3, append/2, member/2, select/3]). 72:- use_module(library(operators), [push_op/3]). 73:- use_module(library(shlib), [current_foreign_library/2]). 74:- use_module(library(ordsets)). 75:- use_module(library(prolog_source)). 76:- use_module(library(option)). 77:- use_module(library(error)). 78:- use_module(library(apply)). 79:- use_module(library(debug)). 80:- if(exists_source(library(pldoc))). 81:- use_module(library(pldoc), []). % Must be loaded before doc_process 82:- use_module(library(pldoc/doc_process)). 83:- endif. 84:- use_module(library(solution_sequences)). 85:- use_module(library(modules)). 86 87:- predicate_options(xref_source/2, 2, 88 [ silent(boolean), 89 module(atom), 90 register_called(oneof([all,non_iso,non_built_in])), 91 comments(oneof([store,collect,ignore])), 92 process_include(boolean) 93 ]). 94 95 96:- dynamic 97 called/5, % Head, Src, From, Cond, Line 98 (dynamic)/3, % Head, Src, Line 99 (thread_local)/3, % Head, Src, Line 100 (multifile)/3, % Head, Src, Line 101 (public)/3, % Head, Src, Line 102 defined/3, % Head, Src, Line 103 meta_goal/3, % Head, Called, Src 104 foreign/3, % Head, Src, Line 105 constraint/3, % Head, Src, Line 106 imported/3, % Head, Src, From 107 exported/2, % Head, Src 108 xmodule/2, % Module, Src 109 uses_file/3, % Spec, Src, Path 110 xop/2, % Src, Op 111 source/2, % Src, Time 112 used_class/2, % Name, Src 113 defined_class/5, % Name, Super, Summary, Src, Line 114 (mode)/2, % Mode, Src 115 xoption/2, % Src, Option 116 xflag/4, % Name, Value, Src, Line 117 118 module_comment/3, % Src, Title, Comment 119 pred_comment/4, % Head, Src, Summary, Comment 120 pred_comment_link/3, % Head, Src, HeadTo 121 pred_mode/3. % Head, Src, Det 122 123:- create_prolog_flag(xref, false, [type(boolean)]).
160:- predicate_options(xref_source_file/4, 4, 161 [ file_type(oneof([txt,prolog,directory])), 162 silent(boolean) 163 ]). 164:- predicate_options(xref_public_list/3, 3, 165 [ path(-atom), 166 module(-atom), 167 exports(-list(any)), 168 public(-list(any)), 169 meta(-list(any)), 170 silent(boolean) 171 ]). 172 173 174 /******************************* 175 * HOOKS * 176 *******************************/
203:- multifile 204 prolog:called_by/4, % +Goal, +Module, +Context, -Called 205 prolog:called_by/2, % +Goal, -Called 206 prolog:meta_goal/2, % +Goal, -Pattern 207 prolog:hook/1, % +Callable 208 prolog:generated_predicate/1. % :PI 209 210:- meta_predicate 211 prolog:generated_predicate(). 212 213:- dynamic 214 meta_goal/2. 215 216:- meta_predicate 217 process_predicates(, , ). 218 219 /******************************* 220 * BUILT-INS * 221 *******************************/
register_called.229hide_called(Callable, Src) :- 230 xoption(Src, register_called(Which)), 231 !, 232 mode_hide_called(Which, Callable). 233hide_called(Callable, _) :- 234 mode_hide_called(non_built_in, Callable). 235 236mode_hide_called(all, _) :- !, fail. 237mode_hide_called(non_iso, _:Goal) :- 238 goal_name_arity(Goal, Name, Arity), 239 current_predicate(system:Name/Arity), 240 predicate_property(system:Goal, iso). 241mode_hide_called(non_built_in, _:Goal) :- 242 goal_name_arity(Goal, Name, Arity), 243 current_predicate(system:Name/Arity), 244 predicate_property(system:Goal, built_in). 245mode_hide_called(non_built_in, M:Goal) :- 246 goal_name_arity(Goal, Name, Arity), 247 current_predicate(M:Name/Arity), 248 predicate_property(M:Goal, built_in).
254system_predicate(Goal) :- 255 goal_name_arity(Goal, Name, Arity), 256 current_predicate(system:Name/Arity), % avoid autoloading 257 predicate_property(system:Goal, built_in), 258 !. 259 260 261 /******************************** 262 * TOPLEVEL * 263 ********************************/ 264 265verbose(Src) :- 266 \+ xoption(Src, silent(true)). 267 268:- thread_local 269 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).297xref_source(Source) :- 298 xref_source(Source, []). 299 300xref_source(Source, Options) :- 301 prolog_canonical_source(Source, Src), 302 ( last_modified(Source, Modified) 303 -> ( source(Src, Modified) 304 -> true 305 ; xref_clean(Src), 306 assert(source(Src, Modified)), 307 do_xref(Src, Options) 308 ) 309 ; xref_clean(Src), 310 get_time(Now), 311 assert(source(Src, Now)), 312 do_xref(Src, Options) 313 ). 314 315do_xref(Src, Options) :- 316 must_be(list, Options), 317 setup_call_cleanup( 318 xref_setup(Src, In, Options, State), 319 collect(Src, Src, In, Options), 320 xref_cleanup(State)). 321 322last_modified(Source, Modified) :- 323 prolog:xref_source_time(Source, Modified), 324 !. 325last_modified(Source, Modified) :- 326 atom(Source), 327 \+ is_global_url(Source), 328 exists_file(Source), 329 time_file(Source, Modified). 330 331is_global_url(File) :- 332 sub_atom(File, B, _, _, '://'), 333 !, 334 B > 1, 335 sub_atom(File, 0, B, _, Scheme), 336 atom_codes(Scheme, Codes), 337 maplist(between(0'a, 0'z), Codes). 338 339xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :- 340 maplist(assert_option(Src), Options), 341 assert_default_options(Src), 342 current_prolog_flag(emulated_dialect, Dialect), 343 prolog_open_source(Src, In), 344 set_initial_mode(In, Options), 345 asserta(xref_input(Src, In), SRef), 346 set_xref(Xref), 347 ( verbose(Src) 348 -> HRefs = [] 349 ; asserta(user:thread_message_hook(_,_,_), Ref), 350 HRefs = [Ref] 351 ). 352 353assert_option(_, Var) :- 354 var(Var), 355 !, 356 instantiation_error(Var). 357assert_option(Src, silent(Boolean)) :- 358 !, 359 must_be(boolean, Boolean), 360 assert(xoption(Src, silent(Boolean))). 361assert_option(Src, register_called(Which)) :- 362 !, 363 must_be(oneof([all,non_iso,non_built_in]), Which), 364 assert(xoption(Src, register_called(Which))). 365assert_option(Src, comments(CommentHandling)) :- 366 !, 367 must_be(oneof([store,collect,ignore]), CommentHandling), 368 assert(xoption(Src, comments(CommentHandling))). 369assert_option(Src, module(Module)) :- 370 !, 371 must_be(atom, Module), 372 assert(xoption(Src, module(Module))). 373assert_option(Src, process_include(Boolean)) :- 374 !, 375 must_be(boolean, Boolean), 376 assert(xoption(Src, process_include(Boolean))). 377 378assert_default_options(Src) :- 379 ( xref_option_default(Opt), 380 generalise_term(Opt, Gen), 381 ( xoption(Src, Gen) 382 -> true 383 ; assertz(xoption(Src, Opt)) 384 ), 385 fail 386 ; true 387 ). 388 389xref_option_default(silent(false)). 390xref_option_default(register_called(non_built_in)). 391xref_option_default(comments(collect)). 392xref_option_default(process_include(true)).
398xref_cleanup(state(In, Dialect, Xref, Refs)) :- 399 prolog_close_source(In), 400 set_prolog_flag(emulated_dialect, Dialect), 401 set_prolog_flag(xref, Xref), 402 maplist(erase, Refs). 403 404set_xref(Xref) :- 405 current_prolog_flag(xref, Xref), 406 set_prolog_flag(xref, true).
415set_initial_mode(_Stream, Options) :- 416 option(module(Module), Options), 417 !, 418 '$set_source_module'(Module). 419set_initial_mode(Stream, _) :- 420 stream_property(Stream, file_name(Path)), 421 source_file_property(Path, load_context(M, _, Opts)), 422 !, 423 '$set_source_module'(M), 424 ( option(dialect(Dialect), Opts) 425 -> expects_dialect(Dialect) 426 ; true 427 ). 428set_initial_mode(_, _) :- 429 '$set_source_module'(user).
435xref_input_stream(Stream) :-
436 xref_input(_, Var),
437 !,
438 Stream = Var.445xref_push_op(Src, P, T, N0) :- 446 '$current_source_module'(M0), 447 strip_module(M0:N0, M, N), 448 ( is_list(N), 449 N \== [] 450 -> maplist(push_op(Src, P, T, M), N) 451 ; push_op(Src, P, T, M, N) 452 ). 453 454push_op(Src, P, T, M0, N0) :- 455 strip_module(M0:N0, M, N), 456 Name = M:N, 457 valid_op(op(P,T,Name)), 458 push_op(P, T, Name), 459 assert_op(Src, op(P,T,Name)), 460 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 461 462valid_op(op(P,T,M:N)) :- 463 atom(M), 464 valid_op_name(N), 465 integer(P), 466 between(0, 1200, P), 467 atom(T), 468 op_type(T). 469 470valid_op_name(N) :- 471 atom(N), 472 !. 473valid_op_name(N) :- 474 N == []. 475 476op_type(xf). 477op_type(yf). 478op_type(fx). 479op_type(fy). 480op_type(xfx). 481op_type(xfy). 482op_type(yfx).
488xref_set_prolog_flag(Flag, Value, Src, Line) :- 489 atom(Flag), 490 !, 491 assertz(xflag(Flag, Value, Src, Line)). 492xref_set_prolog_flag(_, _, _, _).
498xref_clean(Source) :- 499 prolog_canonical_source(Source, Src), 500 retractall(called(_, Src, _Origin, _Cond, _Line)), 501 retractall(dynamic(_, Src, Line)), 502 retractall(multifile(_, Src, Line)), 503 retractall(public(_, Src, Line)), 504 retractall(defined(_, Src, Line)), 505 retractall(meta_goal(_, _, Src)), 506 retractall(foreign(_, Src, Line)), 507 retractall(constraint(_, Src, Line)), 508 retractall(imported(_, Src, _From)), 509 retractall(exported(_, Src)), 510 retractall(uses_file(_, Src, _)), 511 retractall(xmodule(_, Src)), 512 retractall(xop(Src, _)), 513 retractall(xoption(Src, _)), 514 retractall(xflag(_Name, _Value, Src, Line)), 515 retractall(source(Src, _)), 516 retractall(used_class(_, Src)), 517 retractall(defined_class(_, _, _, Src, _)), 518 retractall(mode(_, Src)), 519 retractall(module_comment(Src, _, _)), 520 retractall(pred_comment(_, Src, _, _)), 521 retractall(pred_comment_link(_, Src, _)), 522 retractall(pred_mode(_, Src, _)). 523 524 525 /******************************* 526 * READ RESULTS * 527 *******************************/
533xref_current_source(Source) :-
534 source(Source, _Time).
541xref_done(Source, Time) :-
542 prolog_canonical_source(Source, Src),
543 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.
565xref_called(Source, Called, By) :- 566 xref_called(Source, Called, By, _). 567 568xref_called(Source, Called, By, Cond) :- 569 canonical_source(Source, Src), 570 distinct(Called-By, called(Called, Src, By, Cond, _)). 571 572xref_called(Source, Called, By, Cond, Line) :- 573 canonical_source(Source, Src), 574 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)595xref_defined(Source, Called, How) :- 596 nonvar(Source), 597 !, 598 canonical_source(Source, Src), 599 xref_defined2(How, Src, Called). 600xref_defined(Source, Called, How) :- 601 xref_defined2(How, Src, Called), 602 canonical_source(Source, Src). 603 604xref_defined2(dynamic(Line), Src, Called) :- 605 dynamic(Called, Src, Line). 606xref_defined2(thread_local(Line), Src, Called) :- 607 thread_local(Called, Src, Line). 608xref_defined2(multifile(Line), Src, Called) :- 609 multifile(Called, Src, Line). 610xref_defined2(public(Line), Src, Called) :- 611 public(Called, Src, Line). 612xref_defined2(local(Line), Src, Called) :- 613 defined(Called, Src, Line). 614xref_defined2(foreign(Line), Src, Called) :- 615 foreign(Called, Src, Line). 616xref_defined2(constraint(Line), Src, Called) :- 617 constraint(Called, Src, Line). 618xref_defined2(imported(From), Src, Called) :- 619 imported(Called, Src, From).
627xref_definition_line(local(Line), Line). 628xref_definition_line(dynamic(Line), Line). 629xref_definition_line(thread_local(Line), Line). 630xref_definition_line(multifile(Line), Line). 631xref_definition_line(public(Line), Line). 632xref_definition_line(constraint(Line), Line). 633xref_definition_line(foreign(Line), Line).
640xref_exported(Source, Called) :-
641 prolog_canonical_source(Source, Src),
642 exported(Called, Src).648xref_module(Source, Module) :- 649 nonvar(Source), 650 !, 651 prolog_canonical_source(Source, Src), 652 xmodule(Module, Src). 653xref_module(Source, Module) :- 654 xmodule(Module, Src), 655 prolog_canonical_source(Source, Src).
665xref_uses_file(Source, Spec, Path) :-
666 prolog_canonical_source(Source, Src),
667 uses_file(Spec, Src, Path).
677xref_op(Source, Op) :-
678 prolog_canonical_source(Source, Src),
679 xop(Src, Op).687xref_prolog_flag(Source, Flag, Value, Line) :- 688 prolog_canonical_source(Source, Src), 689 xflag(Flag, Value, Src, Line). 690 691xref_built_in(Head) :- 692 system_predicate(Head). 693 694xref_used_class(Source, Class) :- 695 prolog_canonical_source(Source, Src), 696 used_class(Class, Src). 697 698xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 699 prolog_canonical_source(Source, Src), 700 defined_class(Class, Super, Summary, Src, Line), 701 integer(Line), 702 !. 703xref_defined_class(Source, Class, file(File)) :- 704 prolog_canonical_source(Source, Src), 705 defined_class(Class, _, _, Src, file(File)). 706 707:- thread_local 708 current_cond/1, 709 source_line/1. 710 711current_source_line(Line) :- 712 source_line(Var), 713 !, 714 Line = Var.
722collect(Src, File, In, Options) :- 723 ( Src == File 724 -> SrcSpec = Line 725 ; SrcSpec = (File:Line) 726 ), 727 option(comments(CommentHandling), Options, collect), 728 ( CommentHandling == ignore 729 -> CommentOptions = [], 730 Comments = [] 731 ; CommentHandling == store 732 -> CommentOptions = [ process_comment(true) ], 733 Comments = [] 734 ; CommentOptions = [ comments(Comments) ] 735 ), 736 repeat, 737 catch(prolog_read_source_term( 738 In, Term, Expanded, 739 [ term_position(TermPos) 740 | CommentOptions 741 ]), 742 E, report_syntax_error(E, Src, [])), 743 update_condition(Term), 744 stream_position_data(line_count, TermPos, Line), 745 setup_call_cleanup( 746 asserta(source_line(SrcSpec), Ref), 747 catch(process(Expanded, Comments, TermPos, Src, EOF), 748 E, print_message(error, E)), 749 erase(Ref)), 750 EOF == true, 751 !. 752 753report_syntax_error(E, _, _) :- 754 fatal_error(E), 755 throw(E). 756report_syntax_error(_, _, Options) :- 757 option(silent(true), Options), 758 !, 759 fail. 760report_syntax_error(E, Src, _Options) :- 761 ( verbose(Src) 762 -> print_message(error, E) 763 ; true 764 ), 765 fail. 766 767fatal_error(time_limit_exceeded). 768fatal_error(error(resource_error(_),_)).
774update_condition((:-Directive)) :- 775 !, 776 update_cond(Directive). 777update_condition(_). 778 779update_cond(if(Cond)) :- 780 !, 781 asserta(current_cond(Cond)). 782update_cond(else) :- 783 retract(current_cond(C0)), 784 !, 785 assert(current_cond(\+C0)). 786update_cond(elif(Cond)) :- 787 retract(current_cond(C0)), 788 !, 789 assert(current_cond((\+C0,Cond))). 790update_cond(endif) :- 791 retract(current_cond(_)), 792 !. 793update_cond(_).
800current_condition(Condition) :- 801 \+ current_cond(_), 802 !, 803 Condition = true. 804current_condition(Condition) :- 805 findall(C, current_cond(C), List), 806 list_to_conj(List, Condition). 807 808list_to_conj([], true). 809list_to_conj([C], C) :- !. 810list_to_conj([H|T], (H,C)) :- 811 list_to_conj(T, C). 812 813 814 /******************************* 815 * PROCESS * 816 *******************************/
828process(Expanded, Comments, TermPos, Src, EOF) :- 829 is_list(Expanded), % term_expansion into list. 830 !, 831 ( member(Term, Expanded), 832 process(Term, Src), 833 Term == end_of_file 834 -> EOF = true 835 ; EOF = false 836 ), 837 xref_comments(Comments, TermPos, Src). 838process(end_of_file, _, _, _, true) :- 839 !. 840process(Term, Comments, TermPos, Src, false) :- 841 process(Term, Src), 842 xref_comments(Comments, TermPos, Src).
846process(Var, _) :- 847 var(Var), 848 !. % Warn? 849process(end_of_file, _) :- !. 850process((:- Directive), Src) :- 851 !, 852 process_directive(Directive, Src), 853 !. 854process((?- Directive), Src) :- 855 !, 856 process_directive(Directive, Src), 857 !. 858process((Head :- Body), Src) :- 859 !, 860 assert_defined(Src, Head), 861 process_body(Body, Head, Src). 862process('$source_location'(_File, _Line):Clause, Src) :- 863 !, 864 process(Clause, Src). 865process(Term, Src) :- 866 process_chr(Term, Src), 867 !. 868process(M:(Head :- Body), Src) :- 869 !, 870 process((M:Head :- M:Body), Src). 871process(Head, Src) :- 872 assert_defined(Src, Head). 873 874 875 /******************************* 876 * COMMENTS * 877 *******************************/
881xref_comments([], _Pos, _Src). 882:- if(current_predicate(parse_comment/3)). 883xref_comments([Pos-Comment|T], TermPos, Src) :- 884 ( Pos @> TermPos % comments inside term 885 -> true 886 ; stream_position_data(line_count, Pos, Line), 887 FilePos = Src:Line, 888 ( parse_comment(Comment, FilePos, Parsed) 889 -> assert_comments(Parsed, Src) 890 ; true 891 ), 892 xref_comments(T, TermPos, Src) 893 ). 894 895assert_comments([], _). 896assert_comments([H|T], Src) :- 897 assert_comment(H, Src), 898 assert_comments(T, Src). 899 900assert_comment(section(_Id, Title, Comment), Src) :- 901 assertz(module_comment(Src, Title, Comment)). 902assert_comment(predicate(PI, Summary, Comment), Src) :- 903 pi_to_head(PI, Src, Head), 904 assertz(pred_comment(Head, Src, Summary, Comment)). 905assert_comment(link(PI, PITo), Src) :- 906 pi_to_head(PI, Src, Head), 907 pi_to_head(PITo, Src, HeadTo), 908 assertz(pred_comment_link(Head, Src, HeadTo)). 909assert_comment(mode(Head, Det), Src) :- 910 assertz(pred_mode(Head, Src, Det)). 911 912pi_to_head(PI, Src, Head) :- 913 pi_to_head(PI, Head0), 914 ( Head0 = _:_ 915 -> strip_module(Head0, M, Plain), 916 ( xmodule(M, Src) 917 -> Head = Plain 918 ; Head = M:Plain 919 ) 920 ; Head = Head0 921 ). 922:- endif.
928xref_comment(Source, Title, Comment) :-
929 canonical_source(Source, Src),
930 module_comment(Src, Title, Comment).
936xref_comment(Source, Head, Summary, Comment) :-
937 canonical_source(Source, Src),
938 ( pred_comment(Head, Src, Summary, Comment)
939 ; pred_comment_link(Head, Src, HeadTo),
940 pred_comment(HeadTo, Src, Summary, Comment)
941 ).
948xref_mode(Source, Mode, Det) :-
949 canonical_source(Source, Src),
950 pred_mode(Mode, Src, Det).957xref_option(Source, Option) :- 958 canonical_source(Source, Src), 959 xoption(Src, Option). 960 961 962 /******************************** 963 * DIRECTIVES * 964 ********************************/ 965 966process_directive(Var, _) :- 967 var(Var), 968 !. % error, but that isn't our business 969process_directive(Dir, _Src) :- 970 debug(xref(directive), 'Processing :- ~q', [Dir]), 971 fail. 972process_directive((A,B), Src) :- % TBD: what about other control 973 !, 974 process_directive(A, Src), % structures? 975 process_directive(B, Src). 976process_directive(List, Src) :- 977 is_list(List), 978 !, 979 process_directive(consult(List), Src). 980process_directive(use_module(File, Import), Src) :- 981 process_use_module2(File, Import, Src, false). 982process_directive(expects_dialect(Dialect), Src) :- 983 process_directive(use_module(library(dialect/Dialect)), Src), 984 expects_dialect(Dialect). 985process_directive(reexport(File, Import), Src) :- 986 process_use_module2(File, Import, Src, true). 987process_directive(reexport(Modules), Src) :- 988 process_use_module(Modules, Src, true). 989process_directive(use_module(Modules), Src) :- 990 process_use_module(Modules, Src, false). 991process_directive(consult(Modules), Src) :- 992 process_use_module(Modules, Src, false). 993process_directive(ensure_loaded(Modules), Src) :- 994 process_use_module(Modules, Src, false). 995process_directive(load_files(Files, _Options), Src) :- 996 process_use_module(Files, Src, false). 997process_directive(include(Files), Src) :- 998 process_include(Files, Src). 999process_directive(dynamic(Dynamic), Src) :- 1000 process_predicates(assert_dynamic, Dynamic, Src). 1001process_directive(dynamic(Dynamic, _Options), Src) :- 1002 process_predicates(assert_dynamic, Dynamic, Src). 1003process_directive(thread_local(Dynamic), Src) :- 1004 process_predicates(assert_thread_local, Dynamic, Src). 1005process_directive(multifile(Dynamic), Src) :- 1006 process_predicates(assert_multifile, Dynamic, Src). 1007process_directive(public(Public), Src) :- 1008 process_predicates(assert_public, Public, Src). 1009process_directive(export(Export), Src) :- 1010 process_predicates(assert_export, Export, Src). 1011process_directive(import(Import), Src) :- 1012 process_import(Import, Src). 1013process_directive(module(Module, Export), Src) :- 1014 assert_module(Src, Module), 1015 assert_module_export(Src, Export). 1016process_directive(module(Module, Export, Import), Src) :- 1017 assert_module(Src, Module), 1018 assert_module_export(Src, Export), 1019 assert_module3(Import, Src). 1020process_directive('$set_source_module'(system), Src) :- 1021 assert_module(Src, system). % hack for handling boot/init.pl 1022process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1023 assert_defined_class(Src, Name, Meta, Super, Doc). 1024process_directive(pce_autoload(Name, From), Src) :- 1025 assert_defined_class(Src, Name, imported_from(From)). 1026 1027process_directive(op(P, A, N), Src) :- 1028 xref_push_op(Src, P, A, N). 1029process_directive(set_prolog_flag(Flag, Value), Src) :- 1030 ( Flag == character_escapes 1031 -> set_prolog_flag(character_escapes, Value) 1032 ; true 1033 ), 1034 current_source_line(Line), 1035 xref_set_prolog_flag(Flag, Value, Src, Line). 1036process_directive(style_check(X), _) :- 1037 style_check(X). 1038process_directive(encoding(Enc), _) :- 1039 ( xref_input_stream(Stream) 1040 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1041 ; true % can this happen? 1042 ). 1043process_directive(pce_expansion:push_compile_operators, _) :- 1044 '$current_source_module'(SM), 1045 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1046process_directive(pce_expansion:pop_compile_operators, _) :- 1047 call(pce_expansion:pop_compile_operators). 1048process_directive(meta_predicate(Meta), Src) :- 1049 process_meta_predicate(Meta, Src). 1050process_directive(arithmetic_function(FSpec), Src) :- 1051 arith_callable(FSpec, Goal), 1052 !, 1053 current_source_line(Line), 1054 assert_called(Src, '<directive>'(Line), Goal, Line). 1055process_directive(format_predicate(_, Goal), Src) :- 1056 !, 1057 current_source_line(Line), 1058 assert_called(Src, '<directive>'(Line), Goal, Line). 1059process_directive(if(Cond), Src) :- 1060 !, 1061 current_source_line(Line), 1062 assert_called(Src, '<directive>'(Line), Cond, Line). 1063process_directive(elif(Cond), Src) :- 1064 !, 1065 current_source_line(Line), 1066 assert_called(Src, '<directive>'(Line), Cond, Line). 1067process_directive(else, _) :- !. 1068process_directive(endif, _) :- !. 1069process_directive(Goal, Src) :- 1070 current_source_line(Line), 1071 process_body(Goal, '<directive>'(Line), Src).
1077process_meta_predicate((A,B), Src) :- 1078 !, 1079 process_meta_predicate(A, Src), 1080 process_meta_predicate(B, Src). 1081process_meta_predicate(Decl, Src) :- 1082 process_meta_head(Src, Decl). 1083 1084process_meta_head(Src, Decl) :- % swapped arguments for maplist 1085 compound(Decl), 1086 compound_name_arity(Decl, Name, Arity), 1087 compound_name_arity(Head, Name, Arity), 1088 meta_args(1, Arity, Decl, Head, Meta), 1089 ( ( prolog:meta_goal(Head, _) 1090 ; prolog:called_by(Head, _, _, _) 1091 ; prolog:called_by(Head, _) 1092 ; meta_goal(Head, _) 1093 ) 1094 -> true 1095 ; assert(meta_goal(Head, Meta, Src)) 1096 ). 1097 1098meta_args(I, Arity, _, _, []) :- 1099 I > Arity, 1100 !. 1101meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1102 arg(I, Decl, 0), 1103 !, 1104 arg(I, Head, H), 1105 I2 is I + 1, 1106 meta_args(I2, Arity, Decl, Head, T). 1107meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1108 arg(I, Decl, ^), 1109 !, 1110 arg(I, Head, EH), 1111 setof_goal(EH, H), 1112 I2 is I + 1, 1113 meta_args(I2, Arity, Decl, Head, T). 1114meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1115 arg(I, Decl, //), 1116 !, 1117 arg(I, Head, H), 1118 I2 is I + 1, 1119 meta_args(I2, Arity, Decl, Head, T). 1120meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1121 arg(I, Decl, A), 1122 integer(A), A > 0, 1123 !, 1124 arg(I, Head, H), 1125 I2 is I + 1, 1126 meta_args(I2, Arity, Decl, Head, T). 1127meta_args(I, Arity, Decl, Head, Meta) :- 1128 I2 is I + 1, 1129 meta_args(I2, Arity, Decl, Head, Meta). 1130 1131 1132 /******************************** 1133 * BODY * 1134 ********************************/
1143xref_meta(Source, Head, Called) :-
1144 canonical_source(Source, Src),
1145 xref_meta_src(Head, Called, Src).1160xref_meta_src(Head, Called, Src) :- 1161 meta_goal(Head, Called, Src), 1162 !. 1163xref_meta_src(Head, Called, _) :- 1164 xref_meta(Head, Called), 1165 !. 1166xref_meta_src(Head, Called, _) :- 1167 compound(Head), 1168 compound_name_arity(Head, Name, Arity), 1169 apply_pred(Name), 1170 Arity > 5, 1171 !, 1172 Extra is Arity - 1, 1173 arg(1, Head, G), 1174 Called = [G+Extra]. 1175 1176apply_pred(call). % built-in 1177apply_pred(maplist). % library(apply_macros) 1178 1179xref_meta((A, B), [A, B]). 1180xref_meta((A; B), [A, B]). 1181xref_meta((A| B), [A, B]). 1182xref_meta((A -> B), [A, B]). 1183xref_meta((A *-> B), [A, B]). 1184xref_meta(findall(_V,G,_L), [G]). 1185xref_meta(findall(_V,G,_L,_T), [G]). 1186xref_meta(findnsols(_N,_V,G,_L), [G]). 1187xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1188xref_meta(setof(_V, EG, _L), [G]) :- 1189 setof_goal(EG, G). 1190xref_meta(bagof(_V, EG, _L), [G]) :- 1191 setof_goal(EG, G). 1192xref_meta(forall(A, B), [A, B]). 1193xref_meta(maplist(G,_), [G+1]). 1194xref_meta(maplist(G,_,_), [G+2]). 1195xref_meta(maplist(G,_,_,_), [G+3]). 1196xref_meta(maplist(G,_,_,_,_), [G+4]). 1197xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1198xref_meta(map_assoc(G, _), [G+1]). 1199xref_meta(map_assoc(G, _, _), [G+2]). 1200xref_meta(checklist(G, _L), [G+1]). 1201xref_meta(sublist(G, _, _), [G+1]). 1202xref_meta(include(G, _, _), [G+1]). 1203xref_meta(exclude(G, _, _), [G+1]). 1204xref_meta(partition(G, _, _, _, _), [G+2]). 1205xref_meta(partition(G, _, _, _),[G+1]). 1206xref_meta(call(G), [G]). 1207xref_meta(call(G, _), [G+1]). 1208xref_meta(call(G, _, _), [G+2]). 1209xref_meta(call(G, _, _, _), [G+3]). 1210xref_meta(call(G, _, _, _, _), [G+4]). 1211xref_meta(not(G), [G]). 1212xref_meta(notrace(G), [G]). 1213xref_meta(\+(G), [G]). 1214xref_meta(ignore(G), [G]). 1215xref_meta(once(G), [G]). 1216xref_meta(initialization(G), [G]). 1217xref_meta(initialization(G,_), [G]). 1218xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1219xref_meta(clause(G, _), [G]). 1220xref_meta(clause(G, _, _), [G]). 1221xref_meta(phrase(G, _A), [//(G)]). 1222xref_meta(phrase(G, _A, _R), [//(G)]). 1223xref_meta(call_dcg(G, _A, _R), [//(G)]). 1224xref_meta(phrase_from_file(G,_),[//(G)]). 1225xref_meta(catch(A, _, B), [A, B]). 1226xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1227xref_meta(thread_create(A,_,_), [A]). 1228xref_meta(thread_create(A,_), [A]). 1229xref_meta(thread_signal(_,A), [A]). 1230xref_meta(thread_at_exit(A), [A]). 1231xref_meta(thread_initialization(A), [A]). 1232xref_meta(engine_create(_,A,_), [A]). 1233xref_meta(engine_create(_,A,_,_), [A]). 1234xref_meta(predsort(A,_,_), [A+3]). 1235xref_meta(call_cleanup(A, B), [A, B]). 1236xref_meta(call_cleanup(A, _, B),[A, B]). 1237xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1238xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1239xref_meta(call_residue_vars(A,_), [A]). 1240xref_meta(with_mutex(_,A), [A]). 1241xref_meta(assume(G), [G]). % library(debug) 1242xref_meta(assertion(G), [G]). % library(debug) 1243xref_meta(freeze(_, G), [G]). 1244xref_meta(when(C, A), [C, A]). 1245xref_meta(time(G), [G]). % development system 1246xref_meta(profile(G), [G]). 1247xref_meta(at_halt(G), [G]). 1248xref_meta(call_with_time_limit(_, G), [G]). 1249xref_meta(call_with_depth_limit(G, _, _), [G]). 1250xref_meta(call_with_inference_limit(G, _, _), [G]). 1251xref_meta(alarm(_, G, _), [G]). 1252xref_meta(alarm(_, G, _, _), [G]). 1253xref_meta('$add_directive_wic'(G), [G]). 1254xref_meta(with_output_to(_, G), [G]). 1255xref_meta(if(G), [G]). 1256xref_meta(elif(G), [G]). 1257xref_meta(meta_options(G,_,_), [G+1]). 1258xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1259xref_meta(distinct(G), [G]). % library(solution_sequences) 1260xref_meta(distinct(_, G), [G]). 1261xref_meta(order_by(_, G), [G]). 1262xref_meta(limit(_, G), [G]). 1263xref_meta(offset(_, G), [G]). 1264xref_meta(reset(G,_,_), [G]). 1265xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1266xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1267 1268 % XPCE meta-predicates 1269xref_meta(pce_global(_, new(_)), _) :- !, fail. 1270xref_meta(pce_global(_, B), [B+1]). 1271xref_meta(ifmaintainer(G), [G]). % used in manual 1272xref_meta(listen(_, G), [G]). % library(broadcast) 1273xref_meta(listen(_, _, G), [G]). 1274xref_meta(in_pce_thread(G), [G]). 1275 1276xref_meta(G, Meta) :- % call user extensions 1277 prolog:meta_goal(G, Meta). 1278xref_meta(G, Meta) :- % Generated from :- meta_predicate 1279 meta_goal(G, Meta). 1280 1281setof_goal(EG, G) :- 1282 var(EG), !, G = EG. 1283setof_goal(_^EG, G) :- 1284 !, 1285 setof_goal(EG, G). 1286setof_goal(G, G). 1287 1288event_xargs(abort, 0). 1289event_xargs(erase, 1). 1290event_xargs(break, 3). 1291event_xargs(frame_finished, 1). 1292event_xargs(thread_exit, 1). 1293event_xargs(this_thread_exit, 0). 1294event_xargs(PI, 2) :- pi_to_head(PI, _).
1300head_of(Var, _) :- 1301 var(Var), !, fail. 1302head_of((Head :- _), Head). 1303head_of(Head, Head).
1311xref_hook(Hook) :- 1312 prolog:hook(Hook). 1313xref_hook(Hook) :- 1314 hook(Hook). 1315 1316 1317hook(attr_portray_hook(_,_)). 1318hook(attr_unify_hook(_,_)). 1319hook(attribute_goals(_,_,_)). 1320hook(goal_expansion(_,_)). 1321hook(term_expansion(_,_)). 1322hook(resource(_,_,_)). 1323hook('$pred_option'(_,_,_,_)). 1324 1325hook(emacs_prolog_colours:goal_classification(_,_)). 1326hook(emacs_prolog_colours:term_colours(_,_)). 1327hook(emacs_prolog_colours:goal_colours(_,_)). 1328hook(emacs_prolog_colours:style(_,_)). 1329hook(emacs_prolog_colours:identify(_,_)). 1330hook(pce_principal:pce_class(_,_,_,_,_,_)). 1331hook(pce_principal:send_implementation(_,_,_)). 1332hook(pce_principal:get_implementation(_,_,_,_)). 1333hook(pce_principal:pce_lazy_get_method(_,_,_)). 1334hook(pce_principal:pce_lazy_send_method(_,_,_)). 1335hook(pce_principal:pce_uses_template(_,_)). 1336hook(prolog:locate_clauses(_,_)). 1337hook(prolog:message(_,_,_)). 1338hook(prolog:error_message(_,_,_)). 1339hook(prolog:message_location(_,_,_)). 1340hook(prolog:message_context(_,_,_)). 1341hook(prolog:message_line_element(_,_)). 1342hook(prolog:debug_control_hook(_)). 1343hook(prolog:help_hook(_)). 1344hook(prolog:show_profile_hook(_,_)). 1345hook(prolog:general_exception(_,_)). 1346hook(prolog:predicate_summary(_,_)). 1347hook(prolog:residual_goals(_,_)). 1348hook(prolog_edit:load). 1349hook(prolog_edit:locate(_,_,_)). 1350hook(shlib:unload_all_foreign_libraries). 1351hook(system:'$foreign_registered'(_, _)). 1352hook(predicate_options:option_decl(_,_,_)). 1353hook(user:exception(_,_,_)). 1354hook(user:file_search_path(_,_)). 1355hook(user:library_directory(_)). 1356hook(user:message_hook(_,_,_)). 1357hook(user:portray(_)). 1358hook(user:prolog_clause_name(_,_)). 1359hook(user:prolog_list_goal(_)). 1360hook(user:prolog_predicate_name(_,_)). 1361hook(user:prolog_trace_interception(_,_,_,_)). 1362hook(user:prolog_exception_hook(_,_,_,_)). 1363hook(sandbox:safe_primitive(_)). 1364hook(sandbox:safe_meta_predicate(_)). 1365hook(sandbox:safe_meta(_,_)). 1366hook(sandbox:safe_global_variable(_)). 1367hook(sandbox:safe_directive(_)).
1374arith_callable(Var, _) :- 1375 var(Var), !, fail. 1376arith_callable(Module:Spec, Module:Goal) :- 1377 !, 1378 arith_callable(Spec, Goal). 1379arith_callable(Name/Arity, Goal) :- 1380 PredArity is Arity + 1, 1381 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1392process_body(Body, Origin, Src) :-
1393 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1394 true).true if there was a
partial evalation inside Goal that has bound variables.1401process_goal(Var, _, _, _) :- 1402 var(Var), 1403 !. 1404process_goal(Goal, Origin, Src, P) :- 1405 Goal = (_,_), % problems 1406 !, 1407 phrase(conjunction(Goal), Goals), 1408 process_conjunction(Goals, Origin, Src, P). 1409process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1410 Goal = (_;_), % problems 1411 !, 1412 phrase(disjunction(Goal), Goals), 1413 forall(member(G, Goals), 1414 process_body(G, Origin, Src)). 1415process_goal(Goal, Origin, Src, P) :- 1416 ( ( xmodule(M, Src) 1417 -> true 1418 ; M = user 1419 ), 1420 ( predicate_property(M:Goal, imported_from(IM)) 1421 -> true 1422 ; IM = M 1423 ), 1424 prolog:called_by(Goal, IM, M, Called) 1425 ; prolog:called_by(Goal, Called) 1426 ), 1427 !, 1428 must_be(list, Called), 1429 current_source_line(Here), 1430 assert_called(Src, Origin, Goal, Here), 1431 process_called_list(Called, Origin, Src, P). 1432process_goal(Goal, Origin, Src, _) :- 1433 process_xpce_goal(Goal, Origin, Src), 1434 !. 1435process_goal(load_foreign_library(File), _Origin, Src, _) :- 1436 process_foreign(File, Src). 1437process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1438 process_foreign(File, Src). 1439process_goal(use_foreign_library(File), _Origin, Src, _) :- 1440 process_foreign(File, Src). 1441process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1442 process_foreign(File, Src). 1443process_goal(Goal, Origin, Src, P) :- 1444 xref_meta_src(Goal, Metas, Src), 1445 !, 1446 current_source_line(Here), 1447 assert_called(Src, Origin, Goal, Here), 1448 process_called_list(Metas, Origin, Src, P). 1449process_goal(Goal, Origin, Src, _) :- 1450 asserting_goal(Goal, Rule), 1451 !, 1452 current_source_line(Here), 1453 assert_called(Src, Origin, Goal, Here), 1454 process_assert(Rule, Origin, Src). 1455process_goal(Goal, Origin, Src, P) :- 1456 partial_evaluate(Goal, P), 1457 current_source_line(Here), 1458 assert_called(Src, Origin, Goal, Here). 1459 1460disjunction(Var) --> {var(Var), !}, [Var]. 1461disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1462disjunction(G) --> [G]. 1463 1464conjunction(Var) --> {var(Var), !}, [Var]. 1465conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1466conjunction(G) --> [G]. 1467 (RVars, T) :- 1469 term_variables(T, TVars0), 1470 sort(TVars0, TVars), 1471 ord_intersect(RVars, TVars). 1472 1473process_conjunction([], _, _, _). 1474process_conjunction([Disj|Rest], Origin, Src, P) :- 1475 nonvar(Disj), 1476 Disj = (_;_), 1477 Rest \== [], 1478 !, 1479 phrase(disjunction(Disj), Goals), 1480 term_variables(Rest, RVars0), 1481 sort(RVars0, RVars), 1482 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1483 forall(member(G, NonSHaring), 1484 process_body(G, Origin, Src)), 1485 ( Sharing == [] 1486 -> true 1487 ; maplist(term_variables, Sharing, GVars0), 1488 append(GVars0, GVars1), 1489 sort(GVars1, GVars), 1490 ord_intersection(GVars, RVars, SVars), 1491 VT =.. [v|SVars], 1492 findall(VT, 1493 ( member(G, Sharing), 1494 process_goal(G, Origin, Src, PS), 1495 PS == true 1496 ), 1497 Alts0), 1498 ( Alts0 == [] 1499 -> true 1500 ; ( true 1501 ; P = true, 1502 sort(Alts0, Alts1), 1503 variants(Alts1, 10, Alts), 1504 member(VT, Alts) 1505 ) 1506 ) 1507 ), 1508 process_conjunction(Rest, Origin, Src, P). 1509process_conjunction([H|T], Origin, Src, P) :- 1510 process_goal(H, Origin, Src, P), 1511 process_conjunction(T, Origin, Src, P). 1512 1513 1514process_called_list([], _, _, _). 1515process_called_list([H|T], Origin, Src, P) :- 1516 process_meta(H, Origin, Src, P), 1517 process_called_list(T, Origin, Src, P). 1518 1519process_meta(A+N, Origin, Src, P) :- 1520 !, 1521 ( extend(A, N, AX) 1522 -> process_goal(AX, Origin, Src, P) 1523 ; true 1524 ). 1525process_meta(//(A), Origin, Src, P) :- 1526 !, 1527 process_dcg_goal(A, Origin, Src, P). 1528process_meta(G, Origin, Src, P) :- 1529 process_goal(G, Origin, Src, P).
1536process_dcg_goal(Var, _, _, _) :- 1537 var(Var), 1538 !. 1539process_dcg_goal((A,B), Origin, Src, P) :- 1540 !, 1541 process_dcg_goal(A, Origin, Src, P), 1542 process_dcg_goal(B, Origin, Src, P). 1543process_dcg_goal((A;B), Origin, Src, P) :- 1544 !, 1545 process_dcg_goal(A, Origin, Src, P), 1546 process_dcg_goal(B, Origin, Src, P). 1547process_dcg_goal((A|B), Origin, Src, P) :- 1548 !, 1549 process_dcg_goal(A, Origin, Src, P), 1550 process_dcg_goal(B, Origin, Src, P). 1551process_dcg_goal((A->B), Origin, Src, P) :- 1552 !, 1553 process_dcg_goal(A, Origin, Src, P), 1554 process_dcg_goal(B, Origin, Src, P). 1555process_dcg_goal((A*->B), Origin, Src, P) :- 1556 !, 1557 process_dcg_goal(A, Origin, Src, P), 1558 process_dcg_goal(B, Origin, Src, P). 1559process_dcg_goal({Goal}, Origin, Src, P) :- 1560 !, 1561 process_goal(Goal, Origin, Src, P). 1562process_dcg_goal(List, _Origin, _Src, _) :- 1563 is_list(List), 1564 !. % terminal 1565process_dcg_goal(List, _Origin, _Src, _) :- 1566 string(List), 1567 !. % terminal 1568process_dcg_goal(Callable, Origin, Src, P) :- 1569 extend(Callable, 2, Goal), 1570 !, 1571 process_goal(Goal, Origin, Src, P). 1572process_dcg_goal(_, _, _, _). 1573 1574 1575extend(Var, _, _) :- 1576 var(Var), !, fail. 1577extend(M:G, N, M:GX) :- 1578 !, 1579 callable(G), 1580 extend(G, N, GX). 1581extend(G, N, GX) :- 1582 ( compound(G) 1583 -> compound_name_arguments(G, Name, Args), 1584 length(Rest, N), 1585 append(Args, Rest, NArgs), 1586 compound_name_arguments(GX, Name, NArgs) 1587 ; atom(G) 1588 -> length(NArgs, N), 1589 compound_name_arguments(GX, G, NArgs) 1590 ). 1591 1592asserting_goal(assert(Rule), Rule). 1593asserting_goal(asserta(Rule), Rule). 1594asserting_goal(assertz(Rule), Rule). 1595asserting_goal(assert(Rule,_), Rule). 1596asserting_goal(asserta(Rule,_), Rule). 1597asserting_goal(assertz(Rule,_), Rule). 1598 1599process_assert(0, _, _) :- !. % catch variables 1600process_assert((_:-Body), Origin, Src) :- 1601 !, 1602 process_body(Body, Origin, Src). 1603process_assert(_, _, _).
1607variants([], _, []). 1608variants([H|T], Max, List) :- 1609 variants(T, H, Max, List). 1610 1611variants([], H, _, [H]). 1612variants(_, _, 0, []) :- !. 1613variants([H|T], V, Max, List) :- 1614 ( H =@= V 1615 -> variants(T, V, Max, List) 1616 ; List = [V|List2], 1617 Max1 is Max-1, 1618 variants(T, H, Max1, List2) 1619 ).
T = hello(X),
findall(T, T, List),
1633partial_evaluate(Goal, P) :- 1634 eval(Goal), 1635 !, 1636 P = true. 1637partial_evaluate(_, _). 1638 1639eval(X = Y) :- 1640 unify_with_occurs_check(X, Y). 1641 1642 1643 /******************************* 1644 * XPCE STUFF * 1645 *******************************/ 1646 1647pce_goal(new(_,_), new(-, new)). 1648pce_goal(send(_,_), send(arg, msg)). 1649pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1650pce_goal(get(_,_,_), get(arg, msg, -)). 1651pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1652pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1653pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1654 1655process_xpce_goal(G, Origin, Src) :- 1656 pce_goal(G, Process), 1657 !, 1658 current_source_line(Here), 1659 assert_called(Src, Origin, G, Here), 1660 ( arg(I, Process, How), 1661 arg(I, G, Term), 1662 process_xpce_arg(How, Term, Origin, Src), 1663 fail 1664 ; true 1665 ). 1666 1667process_xpce_arg(new, Term, Origin, Src) :- 1668 callable(Term), 1669 process_new(Term, Origin, Src). 1670process_xpce_arg(arg, Term, Origin, Src) :- 1671 compound(Term), 1672 process_new(Term, Origin, Src). 1673process_xpce_arg(msg, Term, Origin, Src) :- 1674 compound(Term), 1675 ( arg(_, Term, Arg), 1676 process_xpce_arg(arg, Arg, Origin, Src), 1677 fail 1678 ; true 1679 ). 1680 1681process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1682process_new(Term, Origin, Src) :- 1683 assert_new(Src, Origin, Term), 1684 ( compound(Term), 1685 arg(_, Term, Arg), 1686 process_xpce_arg(arg, Arg, Origin, Src), 1687 fail 1688 ; true 1689 ). 1690 1691assert_new(_, _, Term) :- 1692 \+ callable(Term), 1693 !. 1694assert_new(Src, Origin, Control) :- 1695 functor_name(Control, Class), 1696 pce_control_class(Class), 1697 !, 1698 forall(arg(_, Control, Arg), 1699 assert_new(Src, Origin, Arg)). 1700assert_new(Src, Origin, Term) :- 1701 compound(Term), 1702 arg(1, Term, Prolog), 1703 Prolog == @(prolog), 1704 ( Term =.. [message, _, Selector | T], 1705 atom(Selector) 1706 -> Called =.. [Selector|T], 1707 process_body(Called, Origin, Src) 1708 ; Term =.. [?, _, Selector | T], 1709 atom(Selector) 1710 -> append(T, [_R], T2), 1711 Called =.. [Selector|T2], 1712 process_body(Called, Origin, Src) 1713 ), 1714 fail. 1715assert_new(_, _, @(_)) :- !. 1716assert_new(Src, _, Term) :- 1717 functor_name(Term, Name), 1718 assert_used_class(Src, Name). 1719 1720 1721pce_control_class(and). 1722pce_control_class(or). 1723pce_control_class(if). 1724pce_control_class(not). 1725 1726 1727 /******************************** 1728 * INCLUDED MODULES * 1729 ********************************/
1733process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1734process_use_module([], _, _) :- !. 1735process_use_module([H|T], Src, Reexport) :- 1736 !, 1737 process_use_module(H, Src, Reexport), 1738 process_use_module(T, Src, Reexport). 1739process_use_module(library(pce), Src, Reexport) :- % bit special 1740 !, 1741 xref_public_list(library(pce), Path, Exports, Src), 1742 forall(member(Import, Exports), 1743 process_pce_import(Import, Src, Path, Reexport)). 1744process_use_module(File, Src, Reexport) :- 1745 ( xoption(Src, silent(Silent)) 1746 -> Extra = [silent(Silent)] 1747 ; Extra = [silent(true)] 1748 ), 1749 ( xref_public_list(File, Src, 1750 [ path(Path), 1751 module(M), 1752 exports(Exports), 1753 public(Public), 1754 meta(Meta) 1755 | Extra 1756 ]) 1757 -> assert(uses_file(File, Src, Path)), 1758 assert_import(Src, Exports, _, Path, Reexport), 1759 assert_xmodule_callable(Exports, M, Src, Path), 1760 assert_xmodule_callable(Public, M, Src, Path), 1761 maplist(process_meta_head(Src), Meta), 1762 ( File = library(chr) % hacky 1763 -> assert(mode(chr, Src)) 1764 ; true 1765 ) 1766 ; assert(uses_file(File, Src, '<not_found>')) 1767 ). 1768 1769process_pce_import(Name/Arity, Src, Path, Reexport) :- 1770 atom(Name), 1771 integer(Arity), 1772 !, 1773 functor(Term, Name, Arity), 1774 ( \+ system_predicate(Term), 1775 \+ Term = pce_error(_) % hack!? 1776 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1777 ; true 1778 ). 1779process_pce_import(op(P,T,N), Src, _, _) :- 1780 xref_push_op(Src, P, T, N).
1786process_use_module2(File, Import, Src, Reexport) :-
1787 ( xref_source_file(File, Path, Src)
1788 -> assert(uses_file(File, Src, Path)),
1789 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1790 -> assert_import(Src, Import, Export, Path, Reexport),
1791 forall(( member(Head, Meta),
1792 imported(Head, _, Path)
1793 ),
1794 process_meta_head(Src, Head))
1795 ; true
1796 )
1797 ; assert(uses_file(File, Src, '<not_found>'))
1798 ).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.
1829xref_public_list(File, Src, Options) :-
1830 option(path(Path), Options, _),
1831 option(module(Module), Options, _),
1832 option(exports(Exports), Options, _),
1833 option(public(Public), Options, _),
1834 option(meta(Meta), Options, _),
1835 xref_source_file(File, Path, Src, Options),
1836 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
1858xref_public_list(File, Path, Export, Src) :- 1859 xref_source_file(File, Path, Src), 1860 public_list(Path, _, _, Export, _, []). 1861xref_public_list(File, Path, Module, Export, Meta, Src) :- 1862 xref_source_file(File, Path, Src), 1863 public_list(Path, Module, Meta, Export, _, []). 1864xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 1865 xref_source_file(File, Path, Src), 1866 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.1876:- dynamic public_list_cache/6. 1877:- volatile public_list_cache/6. 1878 1879public_list(Path, Module, Meta, Export, Public, _Options) :- 1880 public_list_cache(Path, Modified, 1881 Module0, Meta0, Export0, Public0), 1882 time_file(Path, ModifiedNow), 1883 ( abs(Modified-ModifiedNow) < 0.0001 1884 -> !, 1885 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 1886 ; retractall(public_list_cache(Path, _, _, _, _, _)), 1887 fail 1888 ). 1889public_list(Path, Module, Meta, Export, Public, Options) :- 1890 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 1891 ( Error = error(_,_), 1892 catch(time_file(Path, Modified), Error, fail) 1893 -> asserta(public_list_cache(Path, Modified, 1894 Module0, Meta0, Export0, Public0)) 1895 ; true 1896 ), 1897 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 1898 1899public_list_nc(Path, Module, Meta, Export, Public, Options) :- 1900 in_temporary_module( 1901 TempModule, 1902 true, 1903 public_list_diff(TempModule, Path, Module, 1904 Meta, [], Export, [], Public, [], Options)). 1905 1906 1907public_list_diff(TempModule, 1908 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 1909 setup_call_cleanup( 1910 public_list_setup(TempModule, Path, In, State), 1911 phrase(read_directives(In, Options, [true]), Directives), 1912 public_list_cleanup(In, State)), 1913 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 1914 1915public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 1916 prolog_open_source(Path, In), 1917 '$set_source_module'(OldM, TempModule), 1918 set_xref(OldXref). 1919 1920public_list_cleanup(In, state(OldM, OldXref)) :- 1921 '$set_source_module'(OldM), 1922 set_prolog_flag(xref, OldXref), 1923 prolog_close_source(In). 1924 1925 1926read_directives(In, Options, State) --> 1927 { repeat, 1928 catch(prolog_read_source_term(In, Term, Expanded, 1929 [ process_comment(true), 1930 syntax_errors(error) 1931 ]), 1932 E, report_syntax_error(E, -, Options)) 1933 -> nonvar(Term), 1934 Term = (:-_) 1935 }, 1936 !, 1937 terms(Expanded, State, State1), 1938 read_directives(In, Options, State1). 1939read_directives(_, _, _) --> []. 1940 1941terms(Var, State, State) --> { var(Var) }, !. 1942terms([H|T], State0, State) --> 1943 !, 1944 terms(H, State0, State1), 1945 terms(T, State1, State). 1946terms((:-if(Cond)), State0, [True|State0]) --> 1947 !, 1948 { eval_cond(Cond, True) }. 1949terms((:-elif(Cond)), [True0|State], [True|State]) --> 1950 !, 1951 { eval_cond(Cond, True1), 1952 elif(True0, True1, True) 1953 }. 1954terms((:-else), [True0|State], [True|State]) --> 1955 !, 1956 { negate(True0, True) }. 1957terms((:-endif), [_|State], State) --> !. 1958terms(H, State, State) --> 1959 ( {State = [true|_]} 1960 -> [H] 1961 ; [] 1962 ). 1963 1964eval_cond(Cond, true) :- 1965 catch(Cond, _, fail), 1966 !. 1967eval_cond(_, false). 1968 1969elif(true, _, else_false) :- !. 1970elif(false, true, true) :- !. 1971elif(True, _, True). 1972 1973negate(true, false). 1974negate(false, true). 1975negate(else_false, else_false). 1976 1977public_list([(:- module(Module, Export0))|Decls], Path, 1978 Module, Meta, MT, Export, Rest, Public, PT) :- 1979 !, 1980 append(Export0, Reexport, Export), 1981 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 1982public_list([(:- encoding(_))|Decls], Path, 1983 Module, Meta, MT, Export, Rest, Public, PT) :- 1984 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 1985 1986public_list_([], _, Meta, Meta, Export, Export, Public, Public). 1987public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 1988 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 1989 !, 1990 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 1991public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 1992 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 1993 1994public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 1995 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 1996public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 1997 public_from_import(Import, Spec, Path, Reexport, Rest). 1998public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 1999 phrase(meta_decls(Decl), Meta, MT). 2000public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2001 phrase(public_decls(Decl), Public, PT).
2007reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2008reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2009 !, 2010 xref_source_file(H, Path, Src), 2011 public_list(Path, _Module, Meta0, Export0, Public0, []), 2012 append(Meta0, MT1, Meta), 2013 append(Export0, ET1, Export), 2014 append(Public0, PT1, Public), 2015 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2016reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2017 xref_source_file(Spec, Path, Src), 2018 public_list(Path, _Module, Meta0, Export0, Public0, []), 2019 append(Meta0, MT, Meta), 2020 append(Export0, ET, Export), 2021 append(Public0, PT, Public). 2022 2023public_from_import(except(Map), Path, Src, Export, Rest) :- 2024 !, 2025 xref_public_list(Path, _, AllExports, Src), 2026 except(Map, AllExports, NewExports), 2027 append(NewExports, Rest, Export). 2028public_from_import(Import, _, _, Export, Rest) :- 2029 import_name_map(Import, Export, Rest).
2034except([], Exports, Exports). 2035except([PI0 as NewName|Map], Exports0, Exports) :- 2036 !, 2037 canonical_pi(PI0, PI), 2038 map_as(Exports0, PI, NewName, Exports1), 2039 except(Map, Exports1, Exports). 2040except([PI0|Map], Exports0, Exports) :- 2041 canonical_pi(PI0, PI), 2042 select(PI2, Exports0, Exports1), 2043 same_pi(PI, PI2), 2044 !, 2045 except(Map, Exports1, Exports). 2046 2047 2048map_as([PI|T], Repl, As, [PI2|T]) :- 2049 same_pi(Repl, PI), 2050 !, 2051 pi_as(PI, As, PI2). 2052map_as([H|T0], Repl, As, [H|T]) :- 2053 map_as(T0, Repl, As, T). 2054 2055pi_as(_/Arity, Name, Name/Arity). 2056pi_as(_//Arity, Name, Name//Arity). 2057 2058import_name_map([], L, L). 2059import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2060 !, 2061 import_name_map(T0, T, Tail). 2062import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2063 !, 2064 import_name_map(T0, T, Tail). 2065import_name_map([H|T0], [H|T], Tail) :- 2066 import_name_map(T0, T, Tail). 2067 2068canonical_pi(Name//Arity0, PI) :- 2069 integer(Arity0), 2070 !, 2071 PI = Name/Arity, 2072 Arity is Arity0 + 2. 2073canonical_pi(PI, PI). 2074 2075same_pi(Canonical, PI2) :- 2076 canonical_pi(PI2, Canonical). 2077 2078meta_decls(Var) --> 2079 { var(Var) }, 2080 !. 2081meta_decls((A,B)) --> 2082 !, 2083 meta_decls(A), 2084 meta_decls(B). 2085meta_decls(A) --> 2086 [A]. 2087 2088public_decls(Var) --> 2089 { var(Var) }, 2090 !. 2091public_decls((A,B)) --> 2092 !, 2093 public_decls(A), 2094 public_decls(B). 2095public_decls(A) --> 2096 [A]. 2097 2098 /******************************* 2099 * INCLUDE * 2100 *******************************/ 2101 2102process_include([], _) :- !. 2103process_include([H|T], Src) :- 2104 !, 2105 process_include(H, Src), 2106 process_include(T, Src). 2107process_include(File, Src) :- 2108 callable(File), 2109 !, 2110 ( once(xref_input(ParentSrc, _)), 2111 xref_source_file(File, Path, ParentSrc) 2112 -> ( ( uses_file(_, Src, Path) 2113 ; Path == Src 2114 ) 2115 -> true 2116 ; assert(uses_file(File, Src, Path)), 2117 ( xoption(Src, process_include(true)) 2118 -> findall(O, xoption(Src, O), Options), 2119 setup_call_cleanup( 2120 open_include_file(Path, In, Refs), 2121 collect(Src, Path, In, Options), 2122 close_include(In, Refs)) 2123 ; true 2124 ) 2125 ) 2126 ; assert(uses_file(File, Src, '<not_found>')) 2127 ). 2128process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2136open_include_file(Path, In, [Ref]) :- 2137 once(xref_input(_, Parent)), 2138 stream_property(Parent, encoding(Enc)), 2139 '$push_input_context'(xref_include), 2140 catch(( prolog:xref_open_source(Path, In) 2141 -> set_stream(In, encoding(Enc)) 2142 ; include_encoding(Enc, Options), 2143 open(Path, read, In, Options) 2144 ), E, 2145 ( '$pop_input_context', throw(E))), 2146 catch(( peek_char(In, #) % Deal with #! script 2147 -> skip(In, 10) 2148 ; true 2149 ), E, 2150 ( close_include(In, []), throw(E))), 2151 asserta(xref_input(Path, In), Ref). 2152 2153include_encoding(wchar_t, []) :- !. 2154include_encoding(Enc, [encoding(Enc)]). 2155 2156 2157close_include(In, Refs) :- 2158 maplist(erase, Refs), 2159 close(In, [force(true)]), 2160 '$pop_input_context'.
2166process_foreign(Spec, Src) :- 2167 ground(Spec), 2168 current_foreign_library(Spec, Defined), 2169 !, 2170 ( xmodule(Module, Src) 2171 -> true 2172 ; Module = user 2173 ), 2174 process_foreign_defined(Defined, Module, Src). 2175process_foreign(_, _). 2176 2177process_foreign_defined([], _, _). 2178process_foreign_defined([H|T], M, Src) :- 2179 ( H = M:Head 2180 -> assert_foreign(Src, Head) 2181 ; assert_foreign(Src, H) 2182 ), 2183 process_foreign_defined(T, M, Src). 2184 2185 2186 /******************************* 2187 * CHR SUPPORT * 2188 *******************************/ 2189 2190/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2191This part of the file supports CHR. Our choice is between making special 2192hooks to make CHR expansion work and then handle the (complex) expanded 2193code or process the CHR source directly. The latter looks simpler, 2194though I don't like the idea of adding support for libraries to this 2195module. A file is supposed to be a CHR file if it uses a 2196use_module(library(chr) or contains a :- constraint/1 directive. As an 2197extra bonus we get the source-locations right :-) 2198- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2199 2200process_chr(@(_Name, Rule), Src) :- 2201 mode(chr, Src), 2202 process_chr(Rule, Src). 2203process_chr(pragma(Rule, _Pragma), Src) :- 2204 mode(chr, Src), 2205 process_chr(Rule, Src). 2206process_chr(<=>(Head, Body), Src) :- 2207 mode(chr, Src), 2208 chr_head(Head, Src, H), 2209 chr_body(Body, H, Src). 2210process_chr(==>(Head, Body), Src) :- 2211 mode(chr, Src), 2212 chr_head(Head, H, Src), 2213 chr_body(Body, H, Src). 2214process_chr((:- chr_constraint(_)), Src) :- 2215 ( mode(chr, Src) 2216 -> true 2217 ; assert(mode(chr, Src)) 2218 ). 2219 2220chr_head(X, _, _) :- 2221 var(X), 2222 !. % Illegal. Warn? 2223chr_head(\(A,B), Src, H) :- 2224 chr_head(A, Src, H), 2225 process_body(B, H, Src). 2226chr_head((H0,B), Src, H) :- 2227 chr_defined(H0, Src, H), 2228 process_body(B, H, Src). 2229chr_head(H0, Src, H) :- 2230 chr_defined(H0, Src, H). 2231 2232chr_defined(X, _, _) :- 2233 var(X), 2234 !. 2235chr_defined(#(C,_Id), Src, C) :- 2236 !, 2237 assert_constraint(Src, C). 2238chr_defined(A, Src, A) :- 2239 assert_constraint(Src, A). 2240 2241chr_body(X, From, Src) :- 2242 var(X), 2243 !, 2244 process_body(X, From, Src). 2245chr_body('|'(Guard, Goals), H, Src) :- 2246 !, 2247 chr_body(Guard, H, Src), 2248 chr_body(Goals, H, Src). 2249chr_body(G, From, Src) :- 2250 process_body(G, From, Src). 2251 2252assert_constraint(_, Head) :- 2253 var(Head), 2254 !. 2255assert_constraint(Src, Head) :- 2256 constraint(Head, Src, _), 2257 !. 2258assert_constraint(Src, Head) :- 2259 generalise_term(Head, Term), 2260 current_source_line(Line), 2261 assert(constraint(Term, Src, Line)). 2262 2263 2264 /******************************** 2265 * PHASE 1 ASSERTIONS * 2266 ********************************/
2273assert_called(_, _, Var, _) :- 2274 var(Var), 2275 !. 2276assert_called(Src, From, Goal, Line) :- 2277 var(From), 2278 !, 2279 assert_called(Src, '<unknown>', Goal, Line). 2280assert_called(_, _, Goal, _) :- 2281 expand_hide_called(Goal), 2282 !. 2283assert_called(Src, Origin, M:G, Line) :- 2284 !, 2285 ( atom(M), 2286 callable(G) 2287 -> current_condition(Cond), 2288 ( xmodule(M, Src) % explicit call to own module 2289 -> assert_called(Src, Origin, G, Line) 2290 ; called(M:G, Src, Origin, Cond, Line) % already registered 2291 -> true 2292 ; hide_called(M:G, Src) % not interesting (now) 2293 -> true 2294 ; generalise(Origin, OTerm), 2295 generalise(G, GTerm) 2296 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2297 ; true 2298 ) 2299 ; true % call to variable module 2300 ). 2301assert_called(Src, _, Goal, _) :- 2302 ( xmodule(M, Src) 2303 -> M \== system 2304 ; M = user 2305 ), 2306 hide_called(M:Goal, Src), 2307 !. 2308assert_called(Src, Origin, Goal, Line) :- 2309 current_condition(Cond), 2310 ( called(Goal, Src, Origin, Cond, Line) 2311 -> true 2312 ; generalise(Origin, OTerm), 2313 generalise(Goal, Term) 2314 -> assert(called(Term, Src, OTerm, Cond, Line)) 2315 ; true 2316 ).
2324expand_hide_called(pce_principal:send_implementation(_, _, _)). 2325expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2326expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2327expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2328 2329assert_defined(Src, Goal) :- 2330 defined(Goal, Src, _), 2331 !. 2332assert_defined(Src, Goal) :- 2333 generalise(Goal, Term), 2334 current_source_line(Line), 2335 assert(defined(Term, Src, Line)). 2336 2337assert_foreign(Src, Goal) :- 2338 foreign(Goal, Src, _), 2339 !. 2340assert_foreign(Src, Goal) :- 2341 generalise(Goal, Term), 2342 current_source_line(Line), 2343 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2355assert_import(_, [], _, _, _) :- !. 2356assert_import(Src, [H|T], Export, From, Reexport) :- 2357 !, 2358 assert_import(Src, H, Export, From, Reexport), 2359 assert_import(Src, T, Export, From, Reexport). 2360assert_import(Src, except(Except), Export, From, Reexport) :- 2361 !, 2362 is_list(Export), 2363 !, 2364 except(Except, Export, Import), 2365 assert_import(Src, Import, _All, From, Reexport). 2366assert_import(Src, Import as Name, Export, From, Reexport) :- 2367 !, 2368 pi_to_head(Import, Term0), 2369 rename_goal(Term0, Name, Term), 2370 ( in_export_list(Term0, Export) 2371 -> assert(imported(Term, Src, From)), 2372 assert_reexport(Reexport, Src, Term) 2373 ; current_source_line(Line), 2374 assert_called(Src, '<directive>'(Line), Term0, Line) 2375 ). 2376assert_import(Src, Import, Export, From, Reexport) :- 2377 pi_to_head(Import, Term), 2378 !, 2379 ( in_export_list(Term, Export) 2380 -> assert(imported(Term, Src, From)), 2381 assert_reexport(Reexport, Src, Term) 2382 ; current_source_line(Line), 2383 assert_called(Src, '<directive>'(Line), Term, Line) 2384 ). 2385assert_import(Src, op(P,T,N), _, _, _) :- 2386 xref_push_op(Src, P,T,N). 2387 2388in_export_list(_Head, Export) :- 2389 var(Export), 2390 !. 2391in_export_list(Head, Export) :- 2392 member(PI, Export), 2393 pi_to_head(PI, Head). 2394 2395assert_reexport(false, _, _) :- !. 2396assert_reexport(true, Src, Term) :- 2397 assert(exported(Term, Src)).
2403process_import(M:PI, Src) :- 2404 pi_to_head(PI, Head), 2405 !, 2406 ( atom(M), 2407 current_module(M), 2408 module_property(M, file(From)) 2409 -> true 2410 ; From = '<unknown>' 2411 ), 2412 assert(imported(Head, Src, From)). 2413process_import(_, _).
2422assert_xmodule_callable([], _, _, _). 2423assert_xmodule_callable([PI|T], M, Src, From) :- 2424 ( pi_to_head(M:PI, Head) 2425 -> assert(imported(Head, Src, From)) 2426 ; true 2427 ), 2428 assert_xmodule_callable(T, M, Src, From).
2435assert_op(Src, op(P,T,M:N)) :-
2436 ( '$current_source_module'(M)
2437 -> Name = N
2438 ; Name = M:N
2439 ),
2440 ( xop(Src, op(P,T,Name))
2441 -> true
2442 ; assert(xop(Src, op(P,T,Name)))
2443 ).2450assert_module(Src, Module) :- 2451 xmodule(Module, Src), 2452 !. 2453assert_module(Src, Module) :- 2454 '$set_source_module'(Module), 2455 assert(xmodule(Module, Src)), 2456 ( module_property(Module, class(system)) 2457 -> retractall(xoption(Src, register_called(_))), 2458 assert(xoption(Src, register_called(all))) 2459 ; true 2460 ). 2461 2462assert_module_export(_, []) :- !. 2463assert_module_export(Src, [H|T]) :- 2464 !, 2465 assert_module_export(Src, H), 2466 assert_module_export(Src, T). 2467assert_module_export(Src, PI) :- 2468 pi_to_head(PI, Term), 2469 !, 2470 assert(exported(Term, Src)). 2471assert_module_export(Src, op(P, A, N)) :- 2472 xref_push_op(Src, P, A, N).
2478assert_module3([], _) :- !. 2479assert_module3([H|T], Src) :- 2480 !, 2481 assert_module3(H, Src), 2482 assert_module3(T, Src). 2483assert_module3(Option, Src) :- 2484 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2493process_predicates(Closure, Preds, Src) :- 2494 is_list(Preds), 2495 !, 2496 process_predicate_list(Preds, Closure, Src). 2497process_predicates(Closure, as(Preds, _Options), Src) :- 2498 !, 2499 process_predicates(Closure, Preds, Src). 2500process_predicates(Closure, Preds, Src) :- 2501 process_predicate_comma(Preds, Closure, Src). 2502 2503process_predicate_list([], _, _). 2504process_predicate_list([H|T], Closure, Src) :- 2505 ( nonvar(H) 2506 -> call(Closure, H, Src) 2507 ; true 2508 ), 2509 process_predicate_list(T, Closure, Src). 2510 2511process_predicate_comma(Var, _, _) :- 2512 var(Var), 2513 !. 2514process_predicate_comma(M:(A,B), Closure, Src) :- 2515 !, 2516 process_predicate_comma(M:A, Closure, Src), 2517 process_predicate_comma(M:B, Closure, Src). 2518process_predicate_comma((A,B), Closure, Src) :- 2519 !, 2520 process_predicate_comma(A, Closure, Src), 2521 process_predicate_comma(B, Closure, Src). 2522process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2523 !, 2524 process_predicate_comma(Spec, Closure, Src). 2525process_predicate_comma(A, Closure, Src) :- 2526 call(Closure, A, Src). 2527 2528 2529assert_dynamic(PI, Src) :- 2530 pi_to_head(PI, Term), 2531 ( thread_local(Term, Src, _) % dynamic after thread_local has 2532 -> true % no effect 2533 ; current_source_line(Line), 2534 assert(dynamic(Term, Src, Line)) 2535 ). 2536 2537assert_thread_local(PI, Src) :- 2538 pi_to_head(PI, Term), 2539 current_source_line(Line), 2540 assert(thread_local(Term, Src, Line)). 2541 2542assert_multifile(PI, Src) :- % :- multifile(Spec) 2543 pi_to_head(PI, Term), 2544 current_source_line(Line), 2545 assert(multifile(Term, Src, Line)). 2546 2547assert_public(PI, Src) :- % :- public(Spec) 2548 pi_to_head(PI, Term), 2549 current_source_line(Line), 2550 assert_called(Src, '<public>'(Line), Term, Line), 2551 assert(public(Term, Src, Line)). 2552 2553assert_export(PI, Src) :- % :- export(Spec) 2554 pi_to_head(PI, Term), 2555 !, 2556 assert(exported(Term, Src)).
2563pi_to_head(Var, _) :- 2564 var(Var), !, fail. 2565pi_to_head(M:PI, M:Term) :- 2566 !, 2567 pi_to_head(PI, Term). 2568pi_to_head(Name/Arity, Term) :- 2569 functor(Term, Name, Arity). 2570pi_to_head(Name//DCGArity, Term) :- 2571 Arity is DCGArity+2, 2572 functor(Term, Name, Arity). 2573 2574 2575assert_used_class(Src, Name) :- 2576 used_class(Name, Src), 2577 !. 2578assert_used_class(Src, Name) :- 2579 assert(used_class(Name, Src)). 2580 2581assert_defined_class(Src, Name, _Meta, _Super, _) :- 2582 defined_class(Name, _, _, Src, _), 2583 !. 2584assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2585assert_defined_class(Src, Name, Meta, Super, Summary) :- 2586 current_source_line(Line), 2587 ( Summary == @(default) 2588 -> Atom = '' 2589 ; is_list(Summary) 2590 -> atom_codes(Atom, Summary) 2591 ; string(Summary) 2592 -> atom_concat(Summary, '', Atom) 2593 ), 2594 assert(defined_class(Name, Super, Atom, Src, Line)), 2595 ( Meta = @(_) 2596 -> true 2597 ; assert_used_class(Src, Meta) 2598 ), 2599 assert_used_class(Src, Super). 2600 2601assert_defined_class(Src, Name, imported_from(_File)) :- 2602 defined_class(Name, _, _, Src, _), 2603 !. 2604assert_defined_class(Src, Name, imported_from(File)) :- 2605 assert(defined_class(Name, _, '', Src, file(File))). 2606 2607 2608 /******************************** 2609 * UTILITIES * 2610 ********************************/
2616generalise(Var, Var) :- 2617 var(Var), 2618 !. % error? 2619generalise(pce_principal:send_implementation(Id, _, _), 2620 pce_principal:send_implementation(Id, _, _)) :- 2621 atom(Id), 2622 !. 2623generalise(pce_principal:get_implementation(Id, _, _, _), 2624 pce_principal:get_implementation(Id, _, _, _)) :- 2625 atom(Id), 2626 !. 2627generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2628generalise(Module:Goal0, Module:Goal) :- 2629 atom(Module), 2630 !, 2631 generalise(Goal0, Goal). 2632generalise(Term0, Term) :- 2633 callable(Term0), 2634 generalise_term(Term0, Term). 2635 2636 2637 /******************************* 2638 * SOURCE MANAGEMENT * 2639 *******************************/ 2640 2641/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2642This section of the file contains hookable predicates to reason about 2643sources. The built-in code here can only deal with files. The XPCE 2644library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2645can do cross-referencing on PceEmacs edit buffers. Other examples for 2646hooking can be databases, (HTTP) URIs, etc. 2647- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2648 2649:- multifile 2650 prolog:xref_source_directory/2, % +Source, -Dir 2651 prolog:xref_source_file/3. % +Spec, -Path, +Options
2659xref_source_file(Plain, File, Source) :- 2660 xref_source_file(Plain, File, Source, []). 2661 2662xref_source_file(QSpec, File, Source, Options) :- 2663 nonvar(QSpec), QSpec = _:Spec, 2664 !, 2665 must_be(acyclic, Spec), 2666 xref_source_file(Spec, File, Source, Options). 2667xref_source_file(Spec, File, Source, Options) :- 2668 nonvar(Spec), 2669 prolog:xref_source_file(Spec, File, 2670 [ relative_to(Source) 2671 | Options 2672 ]), 2673 !. 2674xref_source_file(Plain, File, Source, Options) :- 2675 atom(Plain), 2676 \+ is_absolute_file_name(Plain), 2677 ( prolog:xref_source_directory(Source, Dir) 2678 -> true 2679 ; atom(Source), 2680 file_directory_name(Source, Dir) 2681 ), 2682 atomic_list_concat([Dir, /, Plain], Spec0), 2683 absolute_file_name(Spec0, Spec), 2684 do_xref_source_file(Spec, File, Options), 2685 !. 2686xref_source_file(Spec, File, Source, Options) :- 2687 do_xref_source_file(Spec, File, 2688 [ relative_to(Source) 2689 | Options 2690 ]), 2691 !. 2692xref_source_file(_, _, _, Options) :- 2693 option(silent(true), Options), 2694 !, 2695 fail. 2696xref_source_file(Spec, _, Src, _Options) :- 2697 verbose(Src), 2698 print_message(warning, error(existence_error(file, Spec), _)), 2699 fail. 2700 2701do_xref_source_file(Spec, File, Options) :- 2702 nonvar(Spec), 2703 option(file_type(Type), Options, prolog), 2704 absolute_file_name(Spec, File, 2705 [ file_type(Type), 2706 access(read), 2707 file_errors(fail) 2708 ]), 2709 !.
2715canonical_source(Source, Src) :-
2716 ( ground(Source)
2717 -> prolog_canonical_source(Source, Src)
2718 ; Source = Src
2719 ).name()
goals.2726goal_name_arity(Goal, Name, Arity) :- 2727 ( compound(Goal) 2728 -> compound_name_arity(Goal, Name, Arity) 2729 ; atom(Goal) 2730 -> Name = Goal, Arity = 0 2731 ). 2732 2733generalise_term(Specific, General) :- 2734 ( compound(Specific) 2735 -> compound_name_arity(Specific, Name, Arity), 2736 compound_name_arity(General, Name, Arity) 2737 ; General = Specific 2738 ). 2739 2740functor_name(Term, Name) :- 2741 ( compound(Term) 2742 -> compound_name_arity(Term, Name, _) 2743 ; atom(Term) 2744 -> Name = Term 2745 ). 2746 2747rename_goal(Goal0, Name, Goal) :- 2748 ( compound(Goal0) 2749 -> compound_name_arity(Goal0, _, Arity), 2750 compound_name_arity(Goal, Name, Arity) 2751 ; Goal = Name 2752 )
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.