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(_,_,_), Ref), 358 HRefs = [Ref] 359 ). 360 361assert_option(_, Var) :- 362 var(Var), 363 !, 364 instantiation_error(Var). 365assert_option(Src, silent(Boolean)) :- 366 !, 367 must_be(boolean, Boolean), 368 assert(xoption(Src, silent(Boolean))). 369assert_option(Src, register_called(Which)) :- 370 !, 371 must_be(oneof([all,non_iso,non_built_in]), Which), 372 assert(xoption(Src, register_called(Which))). 373assert_option(Src, comments(CommentHandling)) :- 374 !, 375 must_be(oneof([store,collect,ignore]), CommentHandling), 376 assert(xoption(Src, comments(CommentHandling))). 377assert_option(Src, module(Module)) :- 378 !, 379 must_be(atom, Module), 380 assert(xoption(Src, module(Module))). 381assert_option(Src, process_include(Boolean)) :- 382 !, 383 must_be(boolean, Boolean), 384 assert(xoption(Src, process_include(Boolean))). 385 386assert_default_options(Src) :- 387 ( xref_option_default(Opt), 388 generalise_term(Opt, Gen), 389 ( xoption(Src, Gen) 390 -> true 391 ; assertz(xoption(Src, Opt)) 392 ), 393 fail 394 ; true 395 ). 396 397xref_option_default(silent(false)). 398xref_option_default(register_called(non_built_in)). 399xref_option_default(comments(collect)). 400xref_option_default(process_include(true)).
406xref_cleanup(state(In, Dialect, Xref, Refs)) :- 407 prolog_close_source(In), 408 set_prolog_flag(emulated_dialect, Dialect), 409 set_prolog_flag(xref, Xref), 410 maplist(erase, Refs). 411 412set_xref(Xref) :- 413 current_prolog_flag(xref, Xref), 414 set_prolog_flag(xref, true).
423set_initial_mode(_Stream, Options) :- 424 option(module(Module), Options), 425 !, 426 '$set_source_module'(Module). 427set_initial_mode(Stream, _) :- 428 stream_property(Stream, file_name(Path)), 429 source_file_property(Path, load_context(M, _, Opts)), 430 !, 431 '$set_source_module'(M), 432 ( option(dialect(Dialect), Opts) 433 -> expects_dialect(Dialect) 434 ; true 435 ). 436set_initial_mode(_, _) :- 437 '$set_source_module'(user).
443xref_input_stream(Stream) :-
444 xref_input(_, Var),
445 !,
446 Stream = Var.453xref_push_op(Src, P, T, N0) :- 454 '$current_source_module'(M0), 455 strip_module(M0:N0, M, N), 456 ( is_list(N), 457 N \== [] 458 -> maplist(push_op(Src, P, T, M), N) 459 ; push_op(Src, P, T, M, N) 460 ). 461 462push_op(Src, P, T, M0, N0) :- 463 strip_module(M0:N0, M, N), 464 Name = M:N, 465 valid_op(op(P,T,Name)), 466 push_op(P, T, Name), 467 assert_op(Src, op(P,T,Name)), 468 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 469 470valid_op(op(P,T,M:N)) :- 471 atom(M), 472 valid_op_name(N), 473 integer(P), 474 between(0, 1200, P), 475 atom(T), 476 op_type(T). 477 478valid_op_name(N) :- 479 atom(N), 480 !. 481valid_op_name(N) :- 482 N == []. 483 484op_type(xf). 485op_type(yf). 486op_type(fx). 487op_type(fy). 488op_type(xfx). 489op_type(xfy). 490op_type(yfx).
496xref_set_prolog_flag(Flag, Value, Src, Line) :- 497 atom(Flag), 498 !, 499 assertz(xflag(Flag, Value, Src, Line)). 500xref_set_prolog_flag(_, _, _, _).
506xref_clean(Source) :- 507 prolog_canonical_source(Source, Src), 508 retractall(called(_, Src, _Origin, _Cond, _Line)), 509 retractall(dynamic(_, Src, Line)), 510 retractall(multifile(_, Src, Line)), 511 retractall(public(_, Src, Line)), 512 retractall(defined(_, Src, Line)), 513 retractall(meta_goal(_, _, Src)), 514 retractall(foreign(_, Src, Line)), 515 retractall(constraint(_, Src, Line)), 516 retractall(imported(_, Src, _From)), 517 retractall(exported(_, Src)), 518 retractall(uses_file(_, Src, _)), 519 retractall(xmodule(_, Src)), 520 retractall(xop(Src, _)), 521 retractall(xoption(Src, _)), 522 retractall(xflag(_Name, _Value, Src, Line)), 523 retractall(source(Src, _)), 524 retractall(used_class(_, Src)), 525 retractall(defined_class(_, _, _, Src, _)), 526 retractall(mode(_, Src)), 527 retractall(module_comment(Src, _, _)), 528 retractall(pred_comment(_, Src, _, _)), 529 retractall(pred_comment_link(_, Src, _)), 530 retractall(pred_mode(_, Src, _)). 531 532 533 /******************************* 534 * READ RESULTS * 535 *******************************/
541xref_current_source(Source) :-
542 source(Source, _Time).
549xref_done(Source, Time) :-
550 prolog_canonical_source(Source, Src),
551 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.
573xref_called(Source, Called, By) :- 574 xref_called(Source, Called, By, _). 575 576xref_called(Source, Called, By, Cond) :- 577 canonical_source(Source, Src), 578 distinct(Called-By, called(Called, Src, By, Cond, _)). 579 580xref_called(Source, Called, By, Cond, Line) :- 581 canonical_source(Source, Src), 582 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)603xref_defined(Source, Called, How) :- 604 nonvar(Source), 605 !, 606 canonical_source(Source, Src), 607 xref_defined2(How, Src, Called). 608xref_defined(Source, Called, How) :- 609 xref_defined2(How, Src, Called), 610 canonical_source(Source, Src). 611 612xref_defined2(dynamic(Line), Src, Called) :- 613 dynamic(Called, Src, Line). 614xref_defined2(thread_local(Line), Src, Called) :- 615 thread_local(Called, Src, Line). 616xref_defined2(multifile(Line), Src, Called) :- 617 multifile(Called, Src, Line). 618xref_defined2(public(Line), Src, Called) :- 619 public(Called, Src, Line). 620xref_defined2(local(Line), Src, Called) :- 621 defined(Called, Src, Line). 622xref_defined2(foreign(Line), Src, Called) :- 623 foreign(Called, Src, Line). 624xref_defined2(constraint(Line), Src, Called) :- 625 constraint(Called, Src, Line). 626xref_defined2(imported(From), Src, Called) :- 627 imported(Called, Src, From).
635xref_definition_line(local(Line), Line). 636xref_definition_line(dynamic(Line), Line). 637xref_definition_line(thread_local(Line), Line). 638xref_definition_line(multifile(Line), Line). 639xref_definition_line(public(Line), Line). 640xref_definition_line(constraint(Line), Line). 641xref_definition_line(foreign(Line), Line).
648xref_exported(Source, Called) :-
649 prolog_canonical_source(Source, Src),
650 exported(Called, Src).656xref_module(Source, Module) :- 657 nonvar(Source), 658 !, 659 prolog_canonical_source(Source, Src), 660 xmodule(Module, Src). 661xref_module(Source, Module) :- 662 xmodule(Module, Src), 663 prolog_canonical_source(Source, Src).
673xref_uses_file(Source, Spec, Path) :-
674 prolog_canonical_source(Source, Src),
675 uses_file(Spec, Src, Path).
685xref_op(Source, Op) :-
686 prolog_canonical_source(Source, Src),
687 xop(Src, Op).695xref_prolog_flag(Source, Flag, Value, Line) :- 696 prolog_canonical_source(Source, Src), 697 xflag(Flag, Value, Src, Line). 698 699xref_built_in(Head) :- 700 system_predicate(Head). 701 702xref_used_class(Source, Class) :- 703 prolog_canonical_source(Source, Src), 704 used_class(Class, Src). 705 706xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 707 prolog_canonical_source(Source, Src), 708 defined_class(Class, Super, Summary, Src, Line), 709 integer(Line), 710 !. 711xref_defined_class(Source, Class, file(File)) :- 712 prolog_canonical_source(Source, Src), 713 defined_class(Class, _, _, Src, file(File)). 714 715:- thread_local 716 current_cond/1, 717 source_line/1. 718 719current_source_line(Line) :- 720 source_line(Var), 721 !, 722 Line = Var.
730collect(Src, File, In, Options) :- 731 ( Src == File 732 -> SrcSpec = Line 733 ; SrcSpec = (File:Line) 734 ), 735 option(comments(CommentHandling), Options, collect), 736 ( CommentHandling == ignore 737 -> CommentOptions = [], 738 Comments = [] 739 ; CommentHandling == store 740 -> CommentOptions = [ process_comment(true) ], 741 Comments = [] 742 ; CommentOptions = [ comments(Comments) ] 743 ), 744 repeat, 745 catch(prolog_read_source_term( 746 In, Term, Expanded, 747 [ term_position(TermPos) 748 | CommentOptions 749 ]), 750 E, report_syntax_error(E, Src, [])), 751 update_condition(Term), 752 stream_position_data(line_count, TermPos, Line), 753 setup_call_cleanup( 754 asserta(source_line(SrcSpec), Ref), 755 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 756 E, print_message(error, E)), 757 erase(Ref)), 758 EOF == true, 759 !. 760 761report_syntax_error(E, _, _) :- 762 fatal_error(E), 763 throw(E). 764report_syntax_error(_, _, Options) :- 765 option(silent(true), Options), 766 !, 767 fail. 768report_syntax_error(E, Src, _Options) :- 769 ( verbose(Src) 770 -> print_message(error, E) 771 ; true 772 ), 773 fail. 774 775fatal_error(time_limit_exceeded). 776fatal_error(error(resource_error(_),_)).
782update_condition((:-Directive)) :- 783 !, 784 update_cond(Directive). 785update_condition(_). 786 787update_cond(if(Cond)) :- 788 !, 789 asserta(current_cond(Cond)). 790update_cond(else) :- 791 retract(current_cond(C0)), 792 !, 793 assert(current_cond(\+C0)). 794update_cond(elif(Cond)) :- 795 retract(current_cond(C0)), 796 !, 797 assert(current_cond((\+C0,Cond))). 798update_cond(endif) :- 799 retract(current_cond(_)), 800 !. 801update_cond(_).
808current_condition(Condition) :- 809 \+ current_cond(_), 810 !, 811 Condition = true. 812current_condition(Condition) :- 813 findall(C, current_cond(C), List), 814 list_to_conj(List, Condition). 815 816list_to_conj([], true). 817list_to_conj([C], C) :- !. 818list_to_conj([H|T], (H,C)) :- 819 list_to_conj(T, C). 820 821 822 /******************************* 823 * PROCESS * 824 *******************************/
836process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 837 is_list(Expanded), % term_expansion into list. 838 !, 839 ( member(Term, Expanded), 840 process(Term, Term0, Src), 841 Term == end_of_file 842 -> EOF = true 843 ; EOF = false 844 ), 845 xref_comments(Comments, TermPos, Src). 846process(end_of_file, _, _, _, _, true) :- 847 !. 848process(Term, Comments, Term0, TermPos, Src, false) :- 849 process(Term, Term0, Src), 850 xref_comments(Comments, TermPos, Src).
854process(_, Term0, _) :- 855 ignore_raw_term(Term0), 856 !. 857process(Term, _Term0, Src) :- 858 process(Term, Src). 859 860ignore_raw_term((:- predicate_options(_,_,_))).
864process(Var, _) :- 865 var(Var), 866 !. % Warn? 867process(end_of_file, _) :- !. 868process((:- Directive), Src) :- 869 !, 870 process_directive(Directive, Src), 871 !. 872process((?- Directive), Src) :- 873 !, 874 process_directive(Directive, Src), 875 !. 876process((Head :- Body), Src) :- 877 !, 878 assert_defined(Src, Head), 879 process_body(Body, Head, Src). 880process('$source_location'(_File, _Line):Clause, Src) :- 881 !, 882 process(Clause, Src). 883process(Term, Src) :- 884 process_chr(Term, Src), 885 !. 886process(M:(Head :- Body), Src) :- 887 !, 888 process((M:Head :- M:Body), Src). 889process(Head, Src) :- 890 assert_defined(Src, Head). 891 892 893 /******************************* 894 * COMMENTS * 895 *******************************/
899xref_comments([], _Pos, _Src). 900:- if(current_predicate(parse_comment/3)). 901xref_comments([Pos-Comment|T], TermPos, Src) :- 902 ( Pos @> TermPos % comments inside term 903 -> true 904 ; stream_position_data(line_count, Pos, Line), 905 FilePos = Src:Line, 906 ( parse_comment(Comment, FilePos, Parsed) 907 -> assert_comments(Parsed, Src) 908 ; true 909 ), 910 xref_comments(T, TermPos, Src) 911 ). 912 913assert_comments([], _). 914assert_comments([H|T], Src) :- 915 assert_comment(H, Src), 916 assert_comments(T, Src). 917 918assert_comment(section(_Id, Title, Comment), Src) :- 919 assertz(module_comment(Src, Title, Comment)). 920assert_comment(predicate(PI, Summary, Comment), Src) :- 921 pi_to_head(PI, Src, Head), 922 assertz(pred_comment(Head, Src, Summary, Comment)). 923assert_comment(link(PI, PITo), Src) :- 924 pi_to_head(PI, Src, Head), 925 pi_to_head(PITo, Src, HeadTo), 926 assertz(pred_comment_link(Head, Src, HeadTo)). 927assert_comment(mode(Head, Det), Src) :- 928 assertz(pred_mode(Head, Src, Det)). 929 930pi_to_head(PI, Src, Head) :- 931 pi_to_head(PI, Head0), 932 ( Head0 = _:_ 933 -> strip_module(Head0, M, Plain), 934 ( xmodule(M, Src) 935 -> Head = Plain 936 ; Head = M:Plain 937 ) 938 ; Head = Head0 939 ). 940:- endif.
946xref_comment(Source, Title, Comment) :-
947 canonical_source(Source, Src),
948 module_comment(Src, Title, Comment).
954xref_comment(Source, Head, Summary, Comment) :-
955 canonical_source(Source, Src),
956 ( pred_comment(Head, Src, Summary, Comment)
957 ; pred_comment_link(Head, Src, HeadTo),
958 pred_comment(HeadTo, Src, Summary, Comment)
959 ).
966xref_mode(Source, Mode, Det) :-
967 canonical_source(Source, Src),
968 pred_mode(Mode, Src, Det).975xref_option(Source, Option) :- 976 canonical_source(Source, Src), 977 xoption(Src, Option). 978 979 980 /******************************** 981 * DIRECTIVES * 982 ********************************/ 983 984process_directive(Var, _) :- 985 var(Var), 986 !. % error, but that isn't our business 987process_directive(Dir, _Src) :- 988 debug(xref(directive), 'Processing :- ~q', [Dir]), 989 fail. 990process_directive((A,B), Src) :- % TBD: what about other control 991 !, 992 process_directive(A, Src), % structures? 993 process_directive(B, Src). 994process_directive(List, Src) :- 995 is_list(List), 996 !, 997 process_directive(consult(List), Src). 998process_directive(use_module(File, Import), Src) :- 999 process_use_module2(File, Import, Src, false). 1000process_directive(autoload(File, Import), Src) :- 1001 process_use_module2(File, Import, Src, false). 1002process_directive(require(Import), Src) :- 1003 process_requires(Import, Src). 1004process_directive(expects_dialect(Dialect), Src) :- 1005 process_directive(use_module(library(dialect/Dialect)), Src), 1006 expects_dialect(Dialect). 1007process_directive(reexport(File, Import), Src) :- 1008 process_use_module2(File, Import, Src, true). 1009process_directive(reexport(Modules), Src) :- 1010 process_use_module(Modules, Src, true). 1011process_directive(autoload(Modules), Src) :- 1012 process_use_module(Modules, Src, false). 1013process_directive(use_module(Modules), Src) :- 1014 process_use_module(Modules, Src, false). 1015process_directive(consult(Modules), Src) :- 1016 process_use_module(Modules, Src, false). 1017process_directive(ensure_loaded(Modules), Src) :- 1018 process_use_module(Modules, Src, false). 1019process_directive(load_files(Files, _Options), Src) :- 1020 process_use_module(Files, Src, false). 1021process_directive(include(Files), Src) :- 1022 process_include(Files, Src). 1023process_directive(dynamic(Dynamic), Src) :- 1024 process_predicates(assert_dynamic, Dynamic, Src). 1025process_directive(dynamic(Dynamic, _Options), Src) :- 1026 process_predicates(assert_dynamic, Dynamic, Src). 1027process_directive(thread_local(Dynamic), Src) :- 1028 process_predicates(assert_thread_local, Dynamic, Src). 1029process_directive(multifile(Dynamic), Src) :- 1030 process_predicates(assert_multifile, Dynamic, Src). 1031process_directive(public(Public), Src) :- 1032 process_predicates(assert_public, Public, Src). 1033process_directive(export(Export), Src) :- 1034 process_predicates(assert_export, Export, Src). 1035process_directive(import(Import), Src) :- 1036 process_import(Import, Src). 1037process_directive(module(Module, Export), Src) :- 1038 assert_module(Src, Module), 1039 assert_module_export(Src, Export). 1040process_directive(module(Module, Export, Import), Src) :- 1041 assert_module(Src, Module), 1042 assert_module_export(Src, Export), 1043 assert_module3(Import, Src). 1044process_directive('$set_source_module'(system), Src) :- 1045 assert_module(Src, system). % hack for handling boot/init.pl 1046process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1047 assert_defined_class(Src, Name, Meta, Super, Doc). 1048process_directive(pce_autoload(Name, From), Src) :- 1049 assert_defined_class(Src, Name, imported_from(From)). 1050 1051process_directive(op(P, A, N), Src) :- 1052 xref_push_op(Src, P, A, N). 1053process_directive(set_prolog_flag(Flag, Value), Src) :- 1054 ( Flag == character_escapes 1055 -> set_prolog_flag(character_escapes, Value) 1056 ; true 1057 ), 1058 current_source_line(Line), 1059 xref_set_prolog_flag(Flag, Value, Src, Line). 1060process_directive(style_check(X), _) :- 1061 style_check(X). 1062process_directive(encoding(Enc), _) :- 1063 ( xref_input_stream(Stream) 1064 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1065 ; true % can this happen? 1066 ). 1067process_directive(pce_expansion:push_compile_operators, _) :- 1068 '$current_source_module'(SM), 1069 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1070process_directive(pce_expansion:pop_compile_operators, _) :- 1071 call(pce_expansion:pop_compile_operators). 1072process_directive(meta_predicate(Meta), Src) :- 1073 process_meta_predicate(Meta, Src). 1074process_directive(arithmetic_function(FSpec), Src) :- 1075 arith_callable(FSpec, Goal), 1076 !, 1077 current_source_line(Line), 1078 assert_called(Src, '<directive>'(Line), Goal, Line). 1079process_directive(format_predicate(_, Goal), Src) :- 1080 !, 1081 current_source_line(Line), 1082 assert_called(Src, '<directive>'(Line), Goal, Line). 1083process_directive(if(Cond), Src) :- 1084 !, 1085 current_source_line(Line), 1086 assert_called(Src, '<directive>'(Line), Cond, Line). 1087process_directive(elif(Cond), Src) :- 1088 !, 1089 current_source_line(Line), 1090 assert_called(Src, '<directive>'(Line), Cond, Line). 1091process_directive(else, _) :- !. 1092process_directive(endif, _) :- !. 1093process_directive(Goal, Src) :- 1094 current_source_line(Line), 1095 process_body(Goal, '<directive>'(Line), Src).
1101process_meta_predicate((A,B), Src) :- 1102 !, 1103 process_meta_predicate(A, Src), 1104 process_meta_predicate(B, Src). 1105process_meta_predicate(Decl, Src) :- 1106 process_meta_head(Src, Decl). 1107 1108process_meta_head(Src, Decl) :- % swapped arguments for maplist 1109 compound(Decl), 1110 compound_name_arity(Decl, Name, Arity), 1111 compound_name_arity(Head, Name, Arity), 1112 meta_args(1, Arity, Decl, Head, Meta), 1113 ( ( prolog:meta_goal(Head, _) 1114 ; prolog:called_by(Head, _, _, _) 1115 ; prolog:called_by(Head, _) 1116 ; meta_goal(Head, _) 1117 ) 1118 -> true 1119 ; assert(meta_goal(Head, Meta, Src)) 1120 ). 1121 1122meta_args(I, Arity, _, _, []) :- 1123 I > Arity, 1124 !. 1125meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1126 arg(I, Decl, 0), 1127 !, 1128 arg(I, Head, H), 1129 I2 is I + 1, 1130 meta_args(I2, Arity, Decl, Head, T). 1131meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1132 arg(I, Decl, ^), 1133 !, 1134 arg(I, Head, EH), 1135 setof_goal(EH, H), 1136 I2 is I + 1, 1137 meta_args(I2, Arity, Decl, Head, T). 1138meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1139 arg(I, Decl, //), 1140 !, 1141 arg(I, Head, H), 1142 I2 is I + 1, 1143 meta_args(I2, Arity, Decl, Head, T). 1144meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1145 arg(I, Decl, A), 1146 integer(A), A > 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, Meta) :- 1152 I2 is I + 1, 1153 meta_args(I2, Arity, Decl, Head, Meta). 1154 1155 1156 /******************************** 1157 * BODY * 1158 ********************************/
1167xref_meta(Source, Head, Called) :-
1168 canonical_source(Source, Src),
1169 xref_meta_src(Head, Called, Src).1184xref_meta_src(Head, Called, Src) :- 1185 meta_goal(Head, Called, Src), 1186 !. 1187xref_meta_src(Head, Called, _) :- 1188 xref_meta(Head, Called), 1189 !. 1190xref_meta_src(Head, Called, _) :- 1191 compound(Head), 1192 compound_name_arity(Head, Name, Arity), 1193 apply_pred(Name), 1194 Arity > 5, 1195 !, 1196 Extra is Arity - 1, 1197 arg(1, Head, G), 1198 Called = [G+Extra]. 1199xref_meta_src(Head, Called, _) :- 1200 predicate_property(user:Head, meta_predicate(Meta)), 1201 !, 1202 Meta =.. [_|Args], 1203 meta_args(Args, 1, Head, Called). 1204 1205meta_args([], _, _, []). 1206meta_args([H0|T0], I, Head, [H|T]) :- 1207 xargs(H0, N), 1208 !, 1209 arg(I, Head, A), 1210 ( N == 0 1211 -> H = A 1212 ; H = (A+N) 1213 ), 1214 I2 is I+1, 1215 meta_args(T0, I2, Head, T). 1216meta_args([_|T0], I, Head, T) :- 1217 I2 is I+1, 1218 meta_args(T0, I2, Head, T). 1219 1220xargs(N, N) :- integer(N), !. 1221xargs(//, 2). 1222xargs(^, 0). 1223 1224apply_pred(call). % built-in 1225apply_pred(maplist). % library(apply_macros) 1226 1227xref_meta((A, B), [A, B]). 1228xref_meta((A; B), [A, B]). 1229xref_meta((A| B), [A, B]). 1230xref_meta((A -> B), [A, B]). 1231xref_meta((A *-> B), [A, B]). 1232xref_meta(findall(_V,G,_L), [G]). 1233xref_meta(findall(_V,G,_L,_T), [G]). 1234xref_meta(findnsols(_N,_V,G,_L), [G]). 1235xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1236xref_meta(setof(_V, EG, _L), [G]) :- 1237 setof_goal(EG, G). 1238xref_meta(bagof(_V, EG, _L), [G]) :- 1239 setof_goal(EG, G). 1240xref_meta(forall(A, B), [A, B]). 1241xref_meta(maplist(G,_), [G+1]). 1242xref_meta(maplist(G,_,_), [G+2]). 1243xref_meta(maplist(G,_,_,_), [G+3]). 1244xref_meta(maplist(G,_,_,_,_), [G+4]). 1245xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1246xref_meta(map_assoc(G, _), [G+1]). 1247xref_meta(map_assoc(G, _, _), [G+2]). 1248xref_meta(checklist(G, _L), [G+1]). 1249xref_meta(sublist(G, _, _), [G+1]). 1250xref_meta(include(G, _, _), [G+1]). 1251xref_meta(exclude(G, _, _), [G+1]). 1252xref_meta(partition(G, _, _, _, _), [G+2]). 1253xref_meta(partition(G, _, _, _),[G+1]). 1254xref_meta(call(G), [G]). 1255xref_meta(call(G, _), [G+1]). 1256xref_meta(call(G, _, _), [G+2]). 1257xref_meta(call(G, _, _, _), [G+3]). 1258xref_meta(call(G, _, _, _, _), [G+4]). 1259xref_meta(not(G), [G]). 1260xref_meta(notrace(G), [G]). 1261xref_meta(\+(G), [G]). 1262xref_meta(ignore(G), [G]). 1263xref_meta(once(G), [G]). 1264xref_meta(initialization(G), [G]). 1265xref_meta(initialization(G,_), [G]). 1266xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1267xref_meta(clause(G, _), [G]). 1268xref_meta(clause(G, _, _), [G]). 1269xref_meta(phrase(G, _A), [//(G)]). 1270xref_meta(phrase(G, _A, _R), [//(G)]). 1271xref_meta(call_dcg(G, _A, _R), [//(G)]). 1272xref_meta(phrase_from_file(G,_),[//(G)]). 1273xref_meta(catch(A, _, B), [A, B]). 1274xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1275xref_meta(thread_create(A,_,_), [A]). 1276xref_meta(thread_create(A,_), [A]). 1277xref_meta(thread_signal(_,A), [A]). 1278xref_meta(thread_idle(A,_), [A]). 1279xref_meta(thread_at_exit(A), [A]). 1280xref_meta(thread_initialization(A), [A]). 1281xref_meta(engine_create(_,A,_), [A]). 1282xref_meta(engine_create(_,A,_,_), [A]). 1283xref_meta(transaction(A), [A]). 1284xref_meta(transaction(A,B,_), [A,B]). 1285xref_meta(snapshot(A), [A]). 1286xref_meta(predsort(A,_,_), [A+3]). 1287xref_meta(call_cleanup(A, B), [A, B]). 1288xref_meta(call_cleanup(A, _, B),[A, B]). 1289xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1290xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1291xref_meta(call_residue_vars(A,_), [A]). 1292xref_meta(with_mutex(_,A), [A]). 1293xref_meta(assume(G), [G]). % library(debug) 1294xref_meta(assertion(G), [G]). % library(debug) 1295xref_meta(freeze(_, G), [G]). 1296xref_meta(when(C, A), [C, A]). 1297xref_meta(time(G), [G]). % development system 1298xref_meta(call_time(G, _), [G]). % development system 1299xref_meta(call_time(G, _, _), [G]). % development system 1300xref_meta(profile(G), [G]). 1301xref_meta(at_halt(G), [G]). 1302xref_meta(call_with_time_limit(_, G), [G]). 1303xref_meta(call_with_depth_limit(G, _, _), [G]). 1304xref_meta(call_with_inference_limit(G, _, _), [G]). 1305xref_meta(alarm(_, G, _), [G]). 1306xref_meta(alarm(_, G, _, _), [G]). 1307xref_meta('$add_directive_wic'(G), [G]). 1308xref_meta(with_output_to(_, G), [G]). 1309xref_meta(if(G), [G]). 1310xref_meta(elif(G), [G]). 1311xref_meta(meta_options(G,_,_), [G+1]). 1312xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1313xref_meta(distinct(G), [G]). % library(solution_sequences) 1314xref_meta(distinct(_, G), [G]). 1315xref_meta(order_by(_, G), [G]). 1316xref_meta(limit(_, G), [G]). 1317xref_meta(offset(_, G), [G]). 1318xref_meta(reset(G,_,_), [G]). 1319xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1320xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1321xref_meta(tnot(G), [G]). 1322xref_meta(not_exists(G), [G]). 1323xref_meta(with_tty_raw(G), [G]). 1324 1325 % XPCE meta-predicates 1326xref_meta(pce_global(_, new(_)), _) :- !, fail. 1327xref_meta(pce_global(_, B), [B+1]). 1328xref_meta(ifmaintainer(G), [G]). % used in manual 1329xref_meta(listen(_, G), [G]). % library(broadcast) 1330xref_meta(listen(_, _, G), [G]). 1331xref_meta(in_pce_thread(G), [G]). 1332 1333xref_meta(G, Meta) :- % call user extensions 1334 prolog:meta_goal(G, Meta). 1335xref_meta(G, Meta) :- % Generated from :- meta_predicate 1336 meta_goal(G, Meta). 1337 1338setof_goal(EG, G) :- 1339 var(EG), !, G = EG. 1340setof_goal(_^EG, G) :- 1341 !, 1342 setof_goal(EG, G). 1343setof_goal(G, G). 1344 1345event_xargs(abort, 0). 1346event_xargs(erase, 1). 1347event_xargs(break, 3). 1348event_xargs(frame_finished, 1). 1349event_xargs(thread_exit, 1). 1350event_xargs(this_thread_exit, 0). 1351event_xargs(PI, 2) :- pi_to_head(PI, _).
1357head_of(Var, _) :- 1358 var(Var), !, fail. 1359head_of((Head :- _), Head). 1360head_of(Head, Head).
1368xref_hook(Hook) :- 1369 prolog:hook(Hook). 1370xref_hook(Hook) :- 1371 hook(Hook). 1372 1373 1374hook(attr_portray_hook(_,_)). 1375hook(attr_unify_hook(_,_)). 1376hook(attribute_goals(_,_,_)). 1377hook(goal_expansion(_,_)). 1378hook(term_expansion(_,_)). 1379hook(resource(_,_,_)). 1380hook('$pred_option'(_,_,_,_)). 1381 1382hook(emacs_prolog_colours:goal_classification(_,_)). 1383hook(emacs_prolog_colours:term_colours(_,_)). 1384hook(emacs_prolog_colours:goal_colours(_,_)). 1385hook(emacs_prolog_colours:style(_,_)). 1386hook(emacs_prolog_colours:identify(_,_)). 1387hook(pce_principal:pce_class(_,_,_,_,_,_)). 1388hook(pce_principal:send_implementation(_,_,_)). 1389hook(pce_principal:get_implementation(_,_,_,_)). 1390hook(pce_principal:pce_lazy_get_method(_,_,_)). 1391hook(pce_principal:pce_lazy_send_method(_,_,_)). 1392hook(pce_principal:pce_uses_template(_,_)). 1393hook(prolog:locate_clauses(_,_)). 1394hook(prolog:message(_,_,_)). 1395hook(prolog:error_message(_,_,_)). 1396hook(prolog:message_location(_,_,_)). 1397hook(prolog:message_context(_,_,_)). 1398hook(prolog:message_line_element(_,_)). 1399hook(prolog:debug_control_hook(_)). 1400hook(prolog:help_hook(_)). 1401hook(prolog:show_profile_hook(_,_)). 1402hook(prolog:general_exception(_,_)). 1403hook(prolog:predicate_summary(_,_)). 1404hook(prolog:residual_goals(_,_)). 1405hook(prolog_edit:load). 1406hook(prolog_edit:locate(_,_,_)). 1407hook(shlib:unload_all_foreign_libraries). 1408hook(system:'$foreign_registered'(_, _)). 1409hook(predicate_options:option_decl(_,_,_)). 1410hook(user:exception(_,_,_)). 1411hook(user:file_search_path(_,_)). 1412hook(user:library_directory(_)). 1413hook(user:message_hook(_,_,_)). 1414hook(user:portray(_)). 1415hook(user:prolog_clause_name(_,_)). 1416hook(user:prolog_list_goal(_)). 1417hook(user:prolog_predicate_name(_,_)). 1418hook(user:prolog_trace_interception(_,_,_,_)). 1419hook(user:prolog_exception_hook(_,_,_,_)). 1420hook(sandbox:safe_primitive(_)). 1421hook(sandbox:safe_meta_predicate(_)). 1422hook(sandbox:safe_meta(_,_)). 1423hook(sandbox:safe_global_variable(_)). 1424hook(sandbox:safe_directive(_)).
1431arith_callable(Var, _) :- 1432 var(Var), !, fail. 1433arith_callable(Module:Spec, Module:Goal) :- 1434 !, 1435 arith_callable(Spec, Goal). 1436arith_callable(Name/Arity, Goal) :- 1437 PredArity is Arity + 1, 1438 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1449process_body(Body, Origin, Src) :-
1450 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1451 true).true if there was a
partial evalation inside Goal that has bound variables.1458process_goal(Var, _, _, _) :- 1459 var(Var), 1460 !. 1461process_goal(Goal, Origin, Src, P) :- 1462 Goal = (_,_), % problems 1463 !, 1464 phrase(conjunction(Goal), Goals), 1465 process_conjunction(Goals, Origin, Src, P). 1466process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1467 Goal = (_;_), % problems 1468 !, 1469 phrase(disjunction(Goal), Goals), 1470 forall(member(G, Goals), 1471 process_body(G, Origin, Src)). 1472process_goal(Goal, Origin, Src, P) :- 1473 ( ( xmodule(M, Src) 1474 -> true 1475 ; M = user 1476 ), 1477 ( predicate_property(M:Goal, imported_from(IM)) 1478 -> true 1479 ; IM = M 1480 ), 1481 prolog:called_by(Goal, IM, M, Called) 1482 ; prolog:called_by(Goal, Called) 1483 ), 1484 !, 1485 must_be(list, Called), 1486 current_source_line(Here), 1487 assert_called(Src, Origin, Goal, Here), 1488 process_called_list(Called, Origin, Src, P). 1489process_goal(Goal, Origin, Src, _) :- 1490 process_xpce_goal(Goal, Origin, Src), 1491 !. 1492process_goal(load_foreign_library(File), _Origin, Src, _) :- 1493 process_foreign(File, Src). 1494process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1495 process_foreign(File, Src). 1496process_goal(use_foreign_library(File), _Origin, Src, _) :- 1497 process_foreign(File, Src). 1498process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1499 process_foreign(File, Src). 1500process_goal(Goal, Origin, Src, P) :- 1501 xref_meta_src(Goal, Metas, Src), 1502 !, 1503 current_source_line(Here), 1504 assert_called(Src, Origin, Goal, Here), 1505 process_called_list(Metas, Origin, Src, P). 1506process_goal(Goal, Origin, Src, _) :- 1507 asserting_goal(Goal, Rule), 1508 !, 1509 current_source_line(Here), 1510 assert_called(Src, Origin, Goal, Here), 1511 process_assert(Rule, Origin, Src). 1512process_goal(Goal, Origin, Src, P) :- 1513 partial_evaluate(Goal, P), 1514 current_source_line(Here), 1515 assert_called(Src, Origin, Goal, Here). 1516 1517disjunction(Var) --> {var(Var), !}, [Var]. 1518disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1519disjunction(G) --> [G]. 1520 1521conjunction(Var) --> {var(Var), !}, [Var]. 1522conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1523conjunction(G) --> [G]. 1524 (RVars, T) :- 1526 term_variables(T, TVars0), 1527 sort(TVars0, TVars), 1528 ord_intersect(RVars, TVars). 1529 1530process_conjunction([], _, _, _). 1531process_conjunction([Disj|Rest], Origin, Src, P) :- 1532 nonvar(Disj), 1533 Disj = (_;_), 1534 Rest \== [], 1535 !, 1536 phrase(disjunction(Disj), Goals), 1537 term_variables(Rest, RVars0), 1538 sort(RVars0, RVars), 1539 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1540 forall(member(G, NonSHaring), 1541 process_body(G, Origin, Src)), 1542 ( Sharing == [] 1543 -> true 1544 ; maplist(term_variables, Sharing, GVars0), 1545 append(GVars0, GVars1), 1546 sort(GVars1, GVars), 1547 ord_intersection(GVars, RVars, SVars), 1548 VT =.. [v|SVars], 1549 findall(VT, 1550 ( member(G, Sharing), 1551 process_goal(G, Origin, Src, PS), 1552 PS == true 1553 ), 1554 Alts0), 1555 ( Alts0 == [] 1556 -> true 1557 ; ( true 1558 ; P = true, 1559 sort(Alts0, Alts1), 1560 variants(Alts1, 10, Alts), 1561 member(VT, Alts) 1562 ) 1563 ) 1564 ), 1565 process_conjunction(Rest, Origin, Src, P). 1566process_conjunction([H|T], Origin, Src, P) :- 1567 process_goal(H, Origin, Src, P), 1568 process_conjunction(T, Origin, Src, P). 1569 1570 1571process_called_list([], _, _, _). 1572process_called_list([H|T], Origin, Src, P) :- 1573 process_meta(H, Origin, Src, P), 1574 process_called_list(T, Origin, Src, P). 1575 1576process_meta(A+N, Origin, Src, P) :- 1577 !, 1578 ( extend(A, N, AX) 1579 -> process_goal(AX, Origin, Src, P) 1580 ; true 1581 ). 1582process_meta(//(A), Origin, Src, P) :- 1583 !, 1584 process_dcg_goal(A, Origin, Src, P). 1585process_meta(G, Origin, Src, P) :- 1586 process_goal(G, Origin, Src, P).
1593process_dcg_goal(Var, _, _, _) :- 1594 var(Var), 1595 !. 1596process_dcg_goal((A,B), Origin, Src, P) :- 1597 !, 1598 process_dcg_goal(A, Origin, Src, P), 1599 process_dcg_goal(B, Origin, Src, P). 1600process_dcg_goal((A;B), Origin, Src, P) :- 1601 !, 1602 process_dcg_goal(A, Origin, Src, P), 1603 process_dcg_goal(B, Origin, Src, P). 1604process_dcg_goal((A|B), Origin, Src, P) :- 1605 !, 1606 process_dcg_goal(A, Origin, Src, P), 1607 process_dcg_goal(B, Origin, Src, P). 1608process_dcg_goal((A->B), Origin, Src, P) :- 1609 !, 1610 process_dcg_goal(A, Origin, Src, P), 1611 process_dcg_goal(B, Origin, Src, P). 1612process_dcg_goal((A*->B), Origin, Src, P) :- 1613 !, 1614 process_dcg_goal(A, Origin, Src, P), 1615 process_dcg_goal(B, Origin, Src, P). 1616process_dcg_goal({Goal}, Origin, Src, P) :- 1617 !, 1618 process_goal(Goal, Origin, Src, P). 1619process_dcg_goal(List, _Origin, _Src, _) :- 1620 is_list(List), 1621 !. % terminal 1622process_dcg_goal(List, _Origin, _Src, _) :- 1623 string(List), 1624 !. % terminal 1625process_dcg_goal(Callable, Origin, Src, P) :- 1626 extend(Callable, 2, Goal), 1627 !, 1628 process_goal(Goal, Origin, Src, P). 1629process_dcg_goal(_, _, _, _). 1630 1631 1632extend(Var, _, _) :- 1633 var(Var), !, fail. 1634extend(M:G, N, M:GX) :- 1635 !, 1636 callable(G), 1637 extend(G, N, GX). 1638extend(G, N, GX) :- 1639 ( compound(G) 1640 -> compound_name_arguments(G, Name, Args), 1641 length(Rest, N), 1642 append(Args, Rest, NArgs), 1643 compound_name_arguments(GX, Name, NArgs) 1644 ; atom(G) 1645 -> length(NArgs, N), 1646 compound_name_arguments(GX, G, NArgs) 1647 ). 1648 1649asserting_goal(assert(Rule), Rule). 1650asserting_goal(asserta(Rule), Rule). 1651asserting_goal(assertz(Rule), Rule). 1652asserting_goal(assert(Rule,_), Rule). 1653asserting_goal(asserta(Rule,_), Rule). 1654asserting_goal(assertz(Rule,_), Rule). 1655 1656process_assert(0, _, _) :- !. % catch variables 1657process_assert((_:-Body), Origin, Src) :- 1658 !, 1659 process_body(Body, Origin, Src). 1660process_assert(_, _, _).
1664variants([], _, []). 1665variants([H|T], Max, List) :- 1666 variants(T, H, Max, List). 1667 1668variants([], H, _, [H]). 1669variants(_, _, 0, []) :- !. 1670variants([H|T], V, Max, List) :- 1671 ( H =@= V 1672 -> variants(T, V, Max, List) 1673 ; List = [V|List2], 1674 Max1 is Max-1, 1675 variants(T, H, Max1, List2) 1676 ).
T = hello(X),
findall(T, T, List),
1690partial_evaluate(Goal, P) :- 1691 eval(Goal), 1692 !, 1693 P = true. 1694partial_evaluate(_, _). 1695 1696eval(X = Y) :- 1697 unify_with_occurs_check(X, Y). 1698 1699 1700 /******************************* 1701 * XPCE STUFF * 1702 *******************************/ 1703 1704pce_goal(new(_,_), new(-, new)). 1705pce_goal(send(_,_), send(arg, msg)). 1706pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1707pce_goal(get(_,_,_), get(arg, msg, -)). 1708pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1709pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1710pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1711 1712process_xpce_goal(G, Origin, Src) :- 1713 pce_goal(G, Process), 1714 !, 1715 current_source_line(Here), 1716 assert_called(Src, Origin, G, Here), 1717 ( arg(I, Process, How), 1718 arg(I, G, Term), 1719 process_xpce_arg(How, Term, Origin, Src), 1720 fail 1721 ; true 1722 ). 1723 1724process_xpce_arg(new, Term, Origin, Src) :- 1725 callable(Term), 1726 process_new(Term, Origin, Src). 1727process_xpce_arg(arg, Term, Origin, Src) :- 1728 compound(Term), 1729 process_new(Term, Origin, Src). 1730process_xpce_arg(msg, Term, Origin, Src) :- 1731 compound(Term), 1732 ( arg(_, Term, Arg), 1733 process_xpce_arg(arg, Arg, Origin, Src), 1734 fail 1735 ; true 1736 ). 1737 1738process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1739process_new(Term, Origin, Src) :- 1740 assert_new(Src, Origin, Term), 1741 ( compound(Term), 1742 arg(_, Term, Arg), 1743 process_xpce_arg(arg, Arg, Origin, Src), 1744 fail 1745 ; true 1746 ). 1747 1748assert_new(_, _, Term) :- 1749 \+ callable(Term), 1750 !. 1751assert_new(Src, Origin, Control) :- 1752 functor_name(Control, Class), 1753 pce_control_class(Class), 1754 !, 1755 forall(arg(_, Control, Arg), 1756 assert_new(Src, Origin, Arg)). 1757assert_new(Src, Origin, Term) :- 1758 compound(Term), 1759 arg(1, Term, Prolog), 1760 Prolog == @(prolog), 1761 ( Term =.. [message, _, Selector | T], 1762 atom(Selector) 1763 -> Called =.. [Selector|T], 1764 process_body(Called, Origin, Src) 1765 ; Term =.. [?, _, Selector | T], 1766 atom(Selector) 1767 -> append(T, [_R], T2), 1768 Called =.. [Selector|T2], 1769 process_body(Called, Origin, Src) 1770 ), 1771 fail. 1772assert_new(_, _, @(_)) :- !. 1773assert_new(Src, _, Term) :- 1774 functor_name(Term, Name), 1775 assert_used_class(Src, Name). 1776 1777 1778pce_control_class(and). 1779pce_control_class(or). 1780pce_control_class(if). 1781pce_control_class(not). 1782 1783 1784 /******************************** 1785 * INCLUDED MODULES * 1786 ********************************/
1790process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1791process_use_module([], _, _) :- !. 1792process_use_module([H|T], Src, Reexport) :- 1793 !, 1794 process_use_module(H, Src, Reexport), 1795 process_use_module(T, Src, Reexport). 1796process_use_module(library(pce), Src, Reexport) :- % bit special 1797 !, 1798 xref_public_list(library(pce), Path, Exports, Src), 1799 forall(member(Import, Exports), 1800 process_pce_import(Import, Src, Path, Reexport)). 1801process_use_module(File, Src, Reexport) :- 1802 load_module_if_needed(File), 1803 ( xoption(Src, silent(Silent)) 1804 -> Extra = [silent(Silent)] 1805 ; Extra = [silent(true)] 1806 ), 1807 ( xref_public_list(File, Src, 1808 [ path(Path), 1809 module(M), 1810 exports(Exports), 1811 public(Public), 1812 meta(Meta) 1813 | Extra 1814 ]) 1815 -> assert(uses_file(File, Src, Path)), 1816 assert_import(Src, Exports, _, Path, Reexport), 1817 assert_xmodule_callable(Exports, M, Src, Path), 1818 assert_xmodule_callable(Public, M, Src, Path), 1819 maplist(process_meta_head(Src), Meta), 1820 ( File = library(chr) % hacky 1821 -> assert(mode(chr, Src)) 1822 ; true 1823 ) 1824 ; assert(uses_file(File, Src, '<not_found>')) 1825 ). 1826 1827process_pce_import(Name/Arity, Src, Path, Reexport) :- 1828 atom(Name), 1829 integer(Arity), 1830 !, 1831 functor(Term, Name, Arity), 1832 ( \+ system_predicate(Term), 1833 \+ Term = pce_error(_) % hack!? 1834 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1835 ; true 1836 ). 1837process_pce_import(op(P,T,N), Src, _, _) :- 1838 xref_push_op(Src, P, T, N).
1844process_use_module2(File, Import, Src, Reexport) :-
1845 load_module_if_needed(File),
1846 ( xref_source_file(File, Path, Src)
1847 -> assert(uses_file(File, Src, Path)),
1848 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1849 -> assert_import(Src, Import, Export, Path, Reexport),
1850 forall(( member(Head, Meta),
1851 imported(Head, _, Path)
1852 ),
1853 process_meta_head(Src, Head))
1854 ; true
1855 )
1856 ; assert(uses_file(File, Src, '<not_found>'))
1857 ).1866load_module_if_needed(File) :- 1867 prolog:no_autoload_module(File), 1868 !, 1869 use_module(File, []). 1870load_module_if_needed(_). 1871 1872prologno_autoload_module(library(apply_macros)). 1873prologno_autoload_module(library(arithmetic)). 1874prologno_autoload_module(library(record)). 1875prologno_autoload_module(library(persistency)). 1876prologno_autoload_module(library(pldoc)). 1877prologno_autoload_module(library(settings)). 1878prologno_autoload_module(library(debug)). 1879prologno_autoload_module(library(plunit)).
1884process_requires(Import, Src) :- 1885 is_list(Import), 1886 !, 1887 require_list(Import, Src). 1888process_requires(Var, _Src) :- 1889 var(Var), 1890 !. 1891process_requires((A,B), Src) :- 1892 !, 1893 process_requires(A, Src), 1894 process_requires(B, Src). 1895process_requires(PI, Src) :- 1896 requires(PI, Src). 1897 1898require_list([], _). 1899require_list([H|T], Src) :- 1900 requires(H, Src), 1901 require_list(T, Src). 1902 1903requires(PI, _Src) :- 1904 '$pi_head'(PI, Head), 1905 '$get_predicate_attribute'(system:Head, defined, 1), 1906 !. 1907requires(PI, Src) :- 1908 '$pi_head'(PI, Head), 1909 '$pi_head'(Name/Arity, Head), 1910 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1911 ( imported(Head, Src, Library) 1912 -> true 1913 ; assertz(imported(Head, Src, Library)) 1914 ).
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.
1945xref_public_list(File, Src, Options) :-
1946 option(path(Path), Options, _),
1947 option(module(Module), Options, _),
1948 option(exports(Exports), Options, _),
1949 option(public(Public), Options, _),
1950 option(meta(Meta), Options, _),
1951 xref_source_file(File, Path, Src, Options),
1952 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
1974xref_public_list(File, Path, Export, Src) :- 1975 xref_source_file(File, Path, Src), 1976 public_list(Path, _, _, Export, _, []). 1977xref_public_list(File, Path, Module, Export, Meta, Src) :- 1978 xref_source_file(File, Path, Src), 1979 public_list(Path, Module, Meta, Export, _, []). 1980xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 1981 xref_source_file(File, Path, Src), 1982 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.1992:- dynamic public_list_cache/6. 1993:- volatile public_list_cache/6. 1994 1995public_list(Path, Module, Meta, Export, Public, _Options) :- 1996 public_list_cache(Path, Modified, 1997 Module0, Meta0, Export0, Public0), 1998 time_file(Path, ModifiedNow), 1999 ( abs(Modified-ModifiedNow) < 0.0001 2000 -> !, 2001 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2002 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2003 fail 2004 ). 2005public_list(Path, Module, Meta, Export, Public, Options) :- 2006 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2007 ( Error = error(_,_), 2008 catch(time_file(Path, Modified), Error, fail) 2009 -> asserta(public_list_cache(Path, Modified, 2010 Module0, Meta0, Export0, Public0)) 2011 ; true 2012 ), 2013 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2014 2015public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2016 in_temporary_module( 2017 TempModule, 2018 true, 2019 public_list_diff(TempModule, Path, Module, 2020 Meta, [], Export, [], Public, [], Options)). 2021 2022 2023public_list_diff(TempModule, 2024 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2025 setup_call_cleanup( 2026 public_list_setup(TempModule, Path, In, State), 2027 phrase(read_directives(In, Options, [true]), Directives), 2028 public_list_cleanup(In, State)), 2029 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2030 2031public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2032 prolog_open_source(Path, In), 2033 '$set_source_module'(OldM, TempModule), 2034 set_xref(OldXref). 2035 2036public_list_cleanup(In, state(OldM, OldXref)) :- 2037 '$set_source_module'(OldM), 2038 set_prolog_flag(xref, OldXref), 2039 prolog_close_source(In). 2040 2041 2042read_directives(In, Options, State) --> 2043 { repeat, 2044 catch(prolog_read_source_term(In, Term, Expanded, 2045 [ process_comment(true), 2046 syntax_errors(error) 2047 ]), 2048 E, report_syntax_error(E, -, Options)) 2049 -> nonvar(Term), 2050 Term = (:-_) 2051 }, 2052 !, 2053 terms(Expanded, State, State1), 2054 read_directives(In, Options, State1). 2055read_directives(_, _, _) --> []. 2056 2057terms(Var, State, State) --> { var(Var) }, !. 2058terms([H|T], State0, State) --> 2059 !, 2060 terms(H, State0, State1), 2061 terms(T, State1, State). 2062terms((:-if(Cond)), State0, [True|State0]) --> 2063 !, 2064 { eval_cond(Cond, True) }. 2065terms((:-elif(Cond)), [True0|State], [True|State]) --> 2066 !, 2067 { eval_cond(Cond, True1), 2068 elif(True0, True1, True) 2069 }. 2070terms((:-else), [True0|State], [True|State]) --> 2071 !, 2072 { negate(True0, True) }. 2073terms((:-endif), [_|State], State) --> !. 2074terms(H, State, State) --> 2075 ( {State = [true|_]} 2076 -> [H] 2077 ; [] 2078 ). 2079 2080eval_cond(Cond, true) :- 2081 catch(Cond, _, fail), 2082 !. 2083eval_cond(_, false). 2084 2085elif(true, _, else_false) :- !. 2086elif(false, true, true) :- !. 2087elif(True, _, True). 2088 2089negate(true, false). 2090negate(false, true). 2091negate(else_false, else_false). 2092 2093public_list([(:- module(Module, Export0))|Decls], Path, 2094 Module, Meta, MT, Export, Rest, Public, PT) :- 2095 !, 2096 append(Export0, Reexport, Export), 2097 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2098public_list([(:- encoding(_))|Decls], Path, 2099 Module, Meta, MT, Export, Rest, Public, PT) :- 2100 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2101 2102public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2103public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2104 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2105 !, 2106 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2107public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2108 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2109 2110public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2111 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2112public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2113 public_from_import(Import, Spec, Path, Reexport, Rest). 2114public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2115 phrase(meta_decls(Decl), Meta, MT). 2116public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2117 phrase(public_decls(Decl), Public, PT).
2123reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2124reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2125 !, 2126 xref_source_file(H, Path, Src), 2127 public_list(Path, _Module, Meta0, Export0, Public0, []), 2128 append(Meta0, MT1, Meta), 2129 append(Export0, ET1, Export), 2130 append(Public0, PT1, Public), 2131 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2132reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2133 xref_source_file(Spec, Path, Src), 2134 public_list(Path, _Module, Meta0, Export0, Public0, []), 2135 append(Meta0, MT, Meta), 2136 append(Export0, ET, Export), 2137 append(Public0, PT, Public). 2138 2139public_from_import(except(Map), Path, Src, Export, Rest) :- 2140 !, 2141 xref_public_list(Path, _, AllExports, Src), 2142 except(Map, AllExports, NewExports), 2143 append(NewExports, Rest, Export). 2144public_from_import(Import, _, _, Export, Rest) :- 2145 import_name_map(Import, Export, Rest).
2150except([], Exports, Exports). 2151except([PI0 as NewName|Map], Exports0, Exports) :- 2152 !, 2153 canonical_pi(PI0, PI), 2154 map_as(Exports0, PI, NewName, Exports1), 2155 except(Map, Exports1, Exports). 2156except([PI0|Map], Exports0, Exports) :- 2157 canonical_pi(PI0, PI), 2158 select(PI2, Exports0, Exports1), 2159 same_pi(PI, PI2), 2160 !, 2161 except(Map, Exports1, Exports). 2162 2163 2164map_as([PI|T], Repl, As, [PI2|T]) :- 2165 same_pi(Repl, PI), 2166 !, 2167 pi_as(PI, As, PI2). 2168map_as([H|T0], Repl, As, [H|T]) :- 2169 map_as(T0, Repl, As, T). 2170 2171pi_as(_/Arity, Name, Name/Arity). 2172pi_as(_//Arity, Name, Name//Arity). 2173 2174import_name_map([], L, L). 2175import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2176 !, 2177 import_name_map(T0, T, Tail). 2178import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2179 !, 2180 import_name_map(T0, T, Tail). 2181import_name_map([H|T0], [H|T], Tail) :- 2182 import_name_map(T0, T, Tail). 2183 2184canonical_pi(Name//Arity0, PI) :- 2185 integer(Arity0), 2186 !, 2187 PI = Name/Arity, 2188 Arity is Arity0 + 2. 2189canonical_pi(PI, PI). 2190 2191same_pi(Canonical, PI2) :- 2192 canonical_pi(PI2, Canonical). 2193 2194meta_decls(Var) --> 2195 { var(Var) }, 2196 !. 2197meta_decls((A,B)) --> 2198 !, 2199 meta_decls(A), 2200 meta_decls(B). 2201meta_decls(A) --> 2202 [A]. 2203 2204public_decls(Var) --> 2205 { var(Var) }, 2206 !. 2207public_decls((A,B)) --> 2208 !, 2209 public_decls(A), 2210 public_decls(B). 2211public_decls(A) --> 2212 [A]. 2213 2214 /******************************* 2215 * INCLUDE * 2216 *******************************/ 2217 2218process_include([], _) :- !. 2219process_include([H|T], Src) :- 2220 !, 2221 process_include(H, Src), 2222 process_include(T, Src). 2223process_include(File, Src) :- 2224 callable(File), 2225 !, 2226 ( once(xref_input(ParentSrc, _)), 2227 xref_source_file(File, Path, ParentSrc) 2228 -> ( ( uses_file(_, Src, Path) 2229 ; Path == Src 2230 ) 2231 -> true 2232 ; assert(uses_file(File, Src, Path)), 2233 ( xoption(Src, process_include(true)) 2234 -> findall(O, xoption(Src, O), Options), 2235 setup_call_cleanup( 2236 open_include_file(Path, In, Refs), 2237 collect(Src, Path, In, Options), 2238 close_include(In, Refs)) 2239 ; true 2240 ) 2241 ) 2242 ; assert(uses_file(File, Src, '<not_found>')) 2243 ). 2244process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2252open_include_file(Path, In, [Ref]) :- 2253 once(xref_input(_, Parent)), 2254 stream_property(Parent, encoding(Enc)), 2255 '$push_input_context'(xref_include), 2256 catch(( prolog:xref_open_source(Path, In) 2257 -> catch(set_stream(In, encoding(Enc)), 2258 error(_,_), true) % deal with non-file input 2259 ; include_encoding(Enc, Options), 2260 open(Path, read, In, Options) 2261 ), E, 2262 ( '$pop_input_context', throw(E))), 2263 catch(( peek_char(In, #) % Deal with #! script 2264 -> skip(In, 10) 2265 ; true 2266 ), E, 2267 ( close_include(In, []), throw(E))), 2268 asserta(xref_input(Path, In), Ref). 2269 2270include_encoding(wchar_t, []) :- !. 2271include_encoding(Enc, [encoding(Enc)]). 2272 2273 2274close_include(In, Refs) :- 2275 maplist(erase, Refs), 2276 close(In, [force(true)]), 2277 '$pop_input_context'.
2283process_foreign(Spec, Src) :- 2284 ground(Spec), 2285 current_foreign_library(Spec, Defined), 2286 !, 2287 ( xmodule(Module, Src) 2288 -> true 2289 ; Module = user 2290 ), 2291 process_foreign_defined(Defined, Module, Src). 2292process_foreign(_, _). 2293 2294process_foreign_defined([], _, _). 2295process_foreign_defined([H|T], M, Src) :- 2296 ( H = M:Head 2297 -> assert_foreign(Src, Head) 2298 ; assert_foreign(Src, H) 2299 ), 2300 process_foreign_defined(T, M, Src). 2301 2302 2303 /******************************* 2304 * CHR SUPPORT * 2305 *******************************/ 2306 2307/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2308This part of the file supports CHR. Our choice is between making special 2309hooks to make CHR expansion work and then handle the (complex) expanded 2310code or process the CHR source directly. The latter looks simpler, 2311though I don't like the idea of adding support for libraries to this 2312module. A file is supposed to be a CHR file if it uses a 2313use_module(library(chr) or contains a :- constraint/1 directive. As an 2314extra bonus we get the source-locations right :-) 2315- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2316 2317process_chr(@(_Name, Rule), Src) :- 2318 mode(chr, Src), 2319 process_chr(Rule, Src). 2320process_chr(pragma(Rule, _Pragma), Src) :- 2321 mode(chr, Src), 2322 process_chr(Rule, Src). 2323process_chr(<=>(Head, Body), Src) :- 2324 mode(chr, Src), 2325 chr_head(Head, Src, H), 2326 chr_body(Body, H, Src). 2327process_chr(==>(Head, Body), Src) :- 2328 mode(chr, Src), 2329 chr_head(Head, H, Src), 2330 chr_body(Body, H, Src). 2331process_chr((:- chr_constraint(_)), Src) :- 2332 ( mode(chr, Src) 2333 -> true 2334 ; assert(mode(chr, Src)) 2335 ). 2336 2337chr_head(X, _, _) :- 2338 var(X), 2339 !. % Illegal. Warn? 2340chr_head(\(A,B), Src, H) :- 2341 chr_head(A, Src, H), 2342 process_body(B, H, Src). 2343chr_head((H0,B), Src, H) :- 2344 chr_defined(H0, Src, H), 2345 process_body(B, H, Src). 2346chr_head(H0, Src, H) :- 2347 chr_defined(H0, Src, H). 2348 2349chr_defined(X, _, _) :- 2350 var(X), 2351 !. 2352chr_defined(#(C,_Id), Src, C) :- 2353 !, 2354 assert_constraint(Src, C). 2355chr_defined(A, Src, A) :- 2356 assert_constraint(Src, A). 2357 2358chr_body(X, From, Src) :- 2359 var(X), 2360 !, 2361 process_body(X, From, Src). 2362chr_body('|'(Guard, Goals), H, Src) :- 2363 !, 2364 chr_body(Guard, H, Src), 2365 chr_body(Goals, H, Src). 2366chr_body(G, From, Src) :- 2367 process_body(G, From, Src). 2368 2369assert_constraint(_, Head) :- 2370 var(Head), 2371 !. 2372assert_constraint(Src, Head) :- 2373 constraint(Head, Src, _), 2374 !. 2375assert_constraint(Src, Head) :- 2376 generalise_term(Head, Term), 2377 current_source_line(Line), 2378 assert(constraint(Term, Src, Line)). 2379 2380 2381 /******************************** 2382 * PHASE 1 ASSERTIONS * 2383 ********************************/
2390assert_called(_, _, Var, _) :- 2391 var(Var), 2392 !. 2393assert_called(Src, From, Goal, Line) :- 2394 var(From), 2395 !, 2396 assert_called(Src, '<unknown>', Goal, Line). 2397assert_called(_, _, Goal, _) :- 2398 expand_hide_called(Goal), 2399 !. 2400assert_called(Src, Origin, M:G, Line) :- 2401 !, 2402 ( atom(M), 2403 callable(G) 2404 -> current_condition(Cond), 2405 ( xmodule(M, Src) % explicit call to own module 2406 -> assert_called(Src, Origin, G, Line) 2407 ; called(M:G, Src, Origin, Cond, Line) % already registered 2408 -> true 2409 ; hide_called(M:G, Src) % not interesting (now) 2410 -> true 2411 ; generalise(Origin, OTerm), 2412 generalise(G, GTerm) 2413 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2414 ; true 2415 ) 2416 ; true % call to variable module 2417 ). 2418assert_called(Src, _, Goal, _) :- 2419 ( xmodule(M, Src) 2420 -> M \== system 2421 ; M = user 2422 ), 2423 hide_called(M:Goal, Src), 2424 !. 2425assert_called(Src, Origin, Goal, Line) :- 2426 current_condition(Cond), 2427 ( called(Goal, Src, Origin, Cond, Line) 2428 -> true 2429 ; generalise(Origin, OTerm), 2430 generalise(Goal, Term) 2431 -> assert(called(Term, Src, OTerm, Cond, Line)) 2432 ; true 2433 ).
2441expand_hide_called(pce_principal:send_implementation(_, _, _)). 2442expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2443expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2444expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2445 2446assert_defined(Src, Goal) :- 2447 defined(Goal, Src, _), 2448 !. 2449assert_defined(Src, Goal) :- 2450 generalise(Goal, Term), 2451 current_source_line(Line), 2452 assert(defined(Term, Src, Line)). 2453 2454assert_foreign(Src, Goal) :- 2455 foreign(Goal, Src, _), 2456 !. 2457assert_foreign(Src, Goal) :- 2458 generalise(Goal, Term), 2459 current_source_line(Line), 2460 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2472assert_import(_, [], _, _, _) :- !. 2473assert_import(Src, [H|T], Export, From, Reexport) :- 2474 !, 2475 assert_import(Src, H, Export, From, Reexport), 2476 assert_import(Src, T, Export, From, Reexport). 2477assert_import(Src, except(Except), Export, From, Reexport) :- 2478 !, 2479 is_list(Export), 2480 !, 2481 except(Except, Export, Import), 2482 assert_import(Src, Import, _All, From, Reexport). 2483assert_import(Src, Import as Name, Export, From, Reexport) :- 2484 !, 2485 pi_to_head(Import, Term0), 2486 rename_goal(Term0, Name, Term), 2487 ( in_export_list(Term0, Export) 2488 -> assert(imported(Term, Src, From)), 2489 assert_reexport(Reexport, Src, Term) 2490 ; current_source_line(Line), 2491 assert_called(Src, '<directive>'(Line), Term0, Line) 2492 ). 2493assert_import(Src, Import, Export, From, Reexport) :- 2494 pi_to_head(Import, Term), 2495 !, 2496 ( in_export_list(Term, Export) 2497 -> assert(imported(Term, Src, From)), 2498 assert_reexport(Reexport, Src, Term) 2499 ; current_source_line(Line), 2500 assert_called(Src, '<directive>'(Line), Term, Line) 2501 ). 2502assert_import(Src, op(P,T,N), _, _, _) :- 2503 xref_push_op(Src, P,T,N). 2504 2505in_export_list(_Head, Export) :- 2506 var(Export), 2507 !. 2508in_export_list(Head, Export) :- 2509 member(PI, Export), 2510 pi_to_head(PI, Head). 2511 2512assert_reexport(false, _, _) :- !. 2513assert_reexport(true, Src, Term) :- 2514 assert(exported(Term, Src)).
2520process_import(M:PI, Src) :- 2521 pi_to_head(PI, Head), 2522 !, 2523 ( atom(M), 2524 current_module(M), 2525 module_property(M, file(From)) 2526 -> true 2527 ; From = '<unknown>' 2528 ), 2529 assert(imported(Head, Src, From)). 2530process_import(_, _).
2539assert_xmodule_callable([], _, _, _). 2540assert_xmodule_callable([PI|T], M, Src, From) :- 2541 ( pi_to_head(M:PI, Head) 2542 -> assert(imported(Head, Src, From)) 2543 ; true 2544 ), 2545 assert_xmodule_callable(T, M, Src, From).
2552assert_op(Src, op(P,T,M:N)) :-
2553 ( '$current_source_module'(M)
2554 -> Name = N
2555 ; Name = M:N
2556 ),
2557 ( xop(Src, op(P,T,Name))
2558 -> true
2559 ; assert(xop(Src, op(P,T,Name)))
2560 ).2567assert_module(Src, Module) :- 2568 xmodule(Module, Src), 2569 !. 2570assert_module(Src, Module) :- 2571 '$set_source_module'(Module), 2572 assert(xmodule(Module, Src)), 2573 ( module_property(Module, class(system)) 2574 -> retractall(xoption(Src, register_called(_))), 2575 assert(xoption(Src, register_called(all))) 2576 ; true 2577 ). 2578 2579assert_module_export(_, []) :- !. 2580assert_module_export(Src, [H|T]) :- 2581 !, 2582 assert_module_export(Src, H), 2583 assert_module_export(Src, T). 2584assert_module_export(Src, PI) :- 2585 pi_to_head(PI, Term), 2586 !, 2587 assert(exported(Term, Src)). 2588assert_module_export(Src, op(P, A, N)) :- 2589 xref_push_op(Src, P, A, N).
2595assert_module3([], _) :- !. 2596assert_module3([H|T], Src) :- 2597 !, 2598 assert_module3(H, Src), 2599 assert_module3(T, Src). 2600assert_module3(Option, Src) :- 2601 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2610process_predicates(Closure, Preds, Src) :- 2611 is_list(Preds), 2612 !, 2613 process_predicate_list(Preds, Closure, Src). 2614process_predicates(Closure, as(Preds, _Options), Src) :- 2615 !, 2616 process_predicates(Closure, Preds, Src). 2617process_predicates(Closure, Preds, Src) :- 2618 process_predicate_comma(Preds, Closure, Src). 2619 2620process_predicate_list([], _, _). 2621process_predicate_list([H|T], Closure, Src) :- 2622 ( nonvar(H) 2623 -> call(Closure, H, Src) 2624 ; true 2625 ), 2626 process_predicate_list(T, Closure, Src). 2627 2628process_predicate_comma(Var, _, _) :- 2629 var(Var), 2630 !. 2631process_predicate_comma(M:(A,B), Closure, Src) :- 2632 !, 2633 process_predicate_comma(M:A, Closure, Src), 2634 process_predicate_comma(M:B, Closure, Src). 2635process_predicate_comma((A,B), Closure, Src) :- 2636 !, 2637 process_predicate_comma(A, Closure, Src), 2638 process_predicate_comma(B, Closure, Src). 2639process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2640 !, 2641 process_predicate_comma(Spec, Closure, Src). 2642process_predicate_comma(A, Closure, Src) :- 2643 call(Closure, A, Src). 2644 2645 2646assert_dynamic(PI, Src) :- 2647 pi_to_head(PI, Term), 2648 ( thread_local(Term, Src, _) % dynamic after thread_local has 2649 -> true % no effect 2650 ; current_source_line(Line), 2651 assert(dynamic(Term, Src, Line)) 2652 ). 2653 2654assert_thread_local(PI, Src) :- 2655 pi_to_head(PI, Term), 2656 current_source_line(Line), 2657 assert(thread_local(Term, Src, Line)). 2658 2659assert_multifile(PI, Src) :- % :- multifile(Spec) 2660 pi_to_head(PI, Term), 2661 current_source_line(Line), 2662 assert(multifile(Term, Src, Line)). 2663 2664assert_public(PI, Src) :- % :- public(Spec) 2665 pi_to_head(PI, Term), 2666 current_source_line(Line), 2667 assert_called(Src, '<public>'(Line), Term, Line), 2668 assert(public(Term, Src, Line)). 2669 2670assert_export(PI, Src) :- % :- export(Spec) 2671 pi_to_head(PI, Term), 2672 !, 2673 assert(exported(Term, Src)).
2680pi_to_head(Var, _) :- 2681 var(Var), !, fail. 2682pi_to_head(M:PI, M:Term) :- 2683 !, 2684 pi_to_head(PI, Term). 2685pi_to_head(Name/Arity, Term) :- 2686 functor(Term, Name, Arity). 2687pi_to_head(Name//DCGArity, Term) :- 2688 Arity is DCGArity+2, 2689 functor(Term, Name, Arity). 2690 2691 2692assert_used_class(Src, Name) :- 2693 used_class(Name, Src), 2694 !. 2695assert_used_class(Src, Name) :- 2696 assert(used_class(Name, Src)). 2697 2698assert_defined_class(Src, Name, _Meta, _Super, _) :- 2699 defined_class(Name, _, _, Src, _), 2700 !. 2701assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2702assert_defined_class(Src, Name, Meta, Super, Summary) :- 2703 current_source_line(Line), 2704 ( Summary == @(default) 2705 -> Atom = '' 2706 ; is_list(Summary) 2707 -> atom_codes(Atom, Summary) 2708 ; string(Summary) 2709 -> atom_concat(Summary, '', Atom) 2710 ), 2711 assert(defined_class(Name, Super, Atom, Src, Line)), 2712 ( Meta = @(_) 2713 -> true 2714 ; assert_used_class(Src, Meta) 2715 ), 2716 assert_used_class(Src, Super). 2717 2718assert_defined_class(Src, Name, imported_from(_File)) :- 2719 defined_class(Name, _, _, Src, _), 2720 !. 2721assert_defined_class(Src, Name, imported_from(File)) :- 2722 assert(defined_class(Name, _, '', Src, file(File))). 2723 2724 2725 /******************************** 2726 * UTILITIES * 2727 ********************************/
2733generalise(Var, Var) :- 2734 var(Var), 2735 !. % error? 2736generalise(pce_principal:send_implementation(Id, _, _), 2737 pce_principal:send_implementation(Id, _, _)) :- 2738 atom(Id), 2739 !. 2740generalise(pce_principal:get_implementation(Id, _, _, _), 2741 pce_principal:get_implementation(Id, _, _, _)) :- 2742 atom(Id), 2743 !. 2744generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2745generalise(Module:Goal0, Module:Goal) :- 2746 atom(Module), 2747 !, 2748 generalise(Goal0, Goal). 2749generalise(Term0, Term) :- 2750 callable(Term0), 2751 generalise_term(Term0, Term). 2752 2753 2754 /******************************* 2755 * SOURCE MANAGEMENT * 2756 *******************************/ 2757 2758/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2759This section of the file contains hookable predicates to reason about 2760sources. The built-in code here can only deal with files. The XPCE 2761library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2762can do cross-referencing on PceEmacs edit buffers. Other examples for 2763hooking can be databases, (HTTP) URIs, etc. 2764- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2765 2766:- multifile 2767 prolog:xref_source_directory/2, % +Source, -Dir 2768 prolog:xref_source_file/3. % +Spec, -Path, +Options
2776xref_source_file(Plain, File, Source) :- 2777 xref_source_file(Plain, File, Source, []). 2778 2779xref_source_file(QSpec, File, Source, Options) :- 2780 nonvar(QSpec), QSpec = _:Spec, 2781 !, 2782 must_be(acyclic, Spec), 2783 xref_source_file(Spec, File, Source, Options). 2784xref_source_file(Spec, File, Source, Options) :- 2785 nonvar(Spec), 2786 prolog:xref_source_file(Spec, File, 2787 [ relative_to(Source) 2788 | Options 2789 ]), 2790 !. 2791xref_source_file(Plain, File, Source, Options) :- 2792 atom(Plain), 2793 \+ is_absolute_file_name(Plain), 2794 ( prolog:xref_source_directory(Source, Dir) 2795 -> true 2796 ; atom(Source), 2797 file_directory_name(Source, Dir) 2798 ), 2799 atomic_list_concat([Dir, /, Plain], Spec0), 2800 absolute_file_name(Spec0, Spec), 2801 do_xref_source_file(Spec, File, Options), 2802 !. 2803xref_source_file(Spec, File, Source, Options) :- 2804 do_xref_source_file(Spec, File, 2805 [ relative_to(Source) 2806 | Options 2807 ]), 2808 !. 2809xref_source_file(_, _, _, Options) :- 2810 option(silent(true), Options), 2811 !, 2812 fail. 2813xref_source_file(Spec, _, Src, _Options) :- 2814 verbose(Src), 2815 print_message(warning, error(existence_error(file, Spec), _)), 2816 fail. 2817 2818do_xref_source_file(Spec, File, Options) :- 2819 nonvar(Spec), 2820 option(file_type(Type), Options, prolog), 2821 absolute_file_name(Spec, File, 2822 [ file_type(Type), 2823 access(read), 2824 file_errors(fail) 2825 ]), 2826 !.
2832canonical_source(Source, Src) :-
2833 ( ground(Source)
2834 -> prolog_canonical_source(Source, Src)
2835 ; Source = Src
2836 ).name()
goals.2843goal_name_arity(Goal, Name, Arity) :- 2844 ( compound(Goal) 2845 -> compound_name_arity(Goal, Name, Arity) 2846 ; atom(Goal) 2847 -> Name = Goal, Arity = 0 2848 ). 2849 2850generalise_term(Specific, General) :- 2851 ( compound(Specific) 2852 -> compound_name_arity(Specific, Name, Arity), 2853 compound_name_arity(General, Name, Arity) 2854 ; General = Specific 2855 ). 2856 2857functor_name(Term, Name) :- 2858 ( compound(Term) 2859 -> compound_name_arity(Term, Name, _) 2860 ; atom(Term) 2861 -> Name = Term 2862 ). 2863 2864rename_goal(Goal0, Name, Goal) :- 2865 ( compound(Goal0) 2866 -> compound_name_arity(Goal0, _, Arity), 2867 compound_name_arity(Goal, Name, Arity) 2868 ; Goal = Name 2869 )
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.