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((Left => Body), Src) :- 881 !, 882 ( nonvar(Left), 883 Left = (Head, Guard) 884 -> assert_defined(Src, Head), 885 process_body(Guard, Head, Src), 886 process_body(Body, Head, Src) 887 ; assert_defined(Src, Left), 888 process_body(Body, Left, Src) 889 ). 890process(?=>(Head, Body), Src) :- 891 !, 892 assert_defined(Src, Head), 893 process_body(Body, Head, Src). 894process('$source_location'(_File, _Line):Clause, Src) :- 895 !, 896 process(Clause, Src). 897process(Term, Src) :- 898 process_chr(Term, Src), 899 !. 900process(M:(Head :- Body), Src) :- 901 !, 902 process((M:Head :- M:Body), Src). 903process(Head, Src) :- 904 assert_defined(Src, Head). 905 906 907 /******************************* 908 * COMMENTS * 909 *******************************/
913xref_comments([], _Pos, _Src). 914:- if(current_predicate(parse_comment/3)). 915xref_comments([Pos-Comment|T], TermPos, Src) :- 916 ( Pos @> TermPos % comments inside term 917 -> true 918 ; stream_position_data(line_count, Pos, Line), 919 FilePos = Src:Line, 920 ( parse_comment(Comment, FilePos, Parsed) 921 -> assert_comments(Parsed, Src) 922 ; true 923 ), 924 xref_comments(T, TermPos, Src) 925 ). 926 927assert_comments([], _). 928assert_comments([H|T], Src) :- 929 assert_comment(H, Src), 930 assert_comments(T, Src). 931 932assert_comment(section(_Id, Title, Comment), Src) :- 933 assertz(module_comment(Src, Title, Comment)). 934assert_comment(predicate(PI, Summary, Comment), Src) :- 935 pi_to_head(PI, Src, Head), 936 assertz(pred_comment(Head, Src, Summary, Comment)). 937assert_comment(link(PI, PITo), Src) :- 938 pi_to_head(PI, Src, Head), 939 pi_to_head(PITo, Src, HeadTo), 940 assertz(pred_comment_link(Head, Src, HeadTo)). 941assert_comment(mode(Head, Det), Src) :- 942 assertz(pred_mode(Head, Src, Det)). 943 944pi_to_head(PI, Src, Head) :- 945 pi_to_head(PI, Head0), 946 ( Head0 = _:_ 947 -> strip_module(Head0, M, Plain), 948 ( xmodule(M, Src) 949 -> Head = Plain 950 ; Head = M:Plain 951 ) 952 ; Head = Head0 953 ). 954:- endif.
960xref_comment(Source, Title, Comment) :-
961 canonical_source(Source, Src),
962 module_comment(Src, Title, Comment).
968xref_comment(Source, Head, Summary, Comment) :-
969 canonical_source(Source, Src),
970 ( pred_comment(Head, Src, Summary, Comment)
971 ; pred_comment_link(Head, Src, HeadTo),
972 pred_comment(HeadTo, Src, Summary, Comment)
973 ).
980xref_mode(Source, Mode, Det) :-
981 canonical_source(Source, Src),
982 pred_mode(Mode, Src, Det).989xref_option(Source, Option) :- 990 canonical_source(Source, Src), 991 xoption(Src, Option). 992 993 994 /******************************** 995 * DIRECTIVES * 996 ********************************/ 997 998process_directive(Var, _) :- 999 var(Var), 1000 !. % error, but that isn't our business 1001process_directive(Dir, _Src) :- 1002 debug(xref(directive), 'Processing :- ~q', [Dir]), 1003 fail. 1004process_directive((A,B), Src) :- % TBD: what about other control 1005 !, 1006 process_directive(A, Src), % structures? 1007 process_directive(B, Src). 1008process_directive(List, Src) :- 1009 is_list(List), 1010 !, 1011 process_directive(consult(List), Src). 1012process_directive(use_module(File, Import), Src) :- 1013 process_use_module2(File, Import, Src, false). 1014process_directive(autoload(File, Import), Src) :- 1015 process_use_module2(File, Import, Src, false). 1016process_directive(require(Import), Src) :- 1017 process_requires(Import, Src). 1018process_directive(expects_dialect(Dialect), Src) :- 1019 process_directive(use_module(library(dialect/Dialect)), Src), 1020 expects_dialect(Dialect). 1021process_directive(reexport(File, Import), Src) :- 1022 process_use_module2(File, Import, Src, true). 1023process_directive(reexport(Modules), Src) :- 1024 process_use_module(Modules, Src, true). 1025process_directive(autoload(Modules), Src) :- 1026 process_use_module(Modules, Src, false). 1027process_directive(use_module(Modules), Src) :- 1028 process_use_module(Modules, Src, false). 1029process_directive(consult(Modules), Src) :- 1030 process_use_module(Modules, Src, false). 1031process_directive(ensure_loaded(Modules), Src) :- 1032 process_use_module(Modules, Src, false). 1033process_directive(load_files(Files, _Options), Src) :- 1034 process_use_module(Files, Src, false). 1035process_directive(include(Files), Src) :- 1036 process_include(Files, Src). 1037process_directive(dynamic(Dynamic), Src) :- 1038 process_predicates(assert_dynamic, Dynamic, Src). 1039process_directive(dynamic(Dynamic, _Options), Src) :- 1040 process_predicates(assert_dynamic, Dynamic, Src). 1041process_directive(thread_local(Dynamic), Src) :- 1042 process_predicates(assert_thread_local, Dynamic, Src). 1043process_directive(multifile(Dynamic), Src) :- 1044 process_predicates(assert_multifile, Dynamic, Src). 1045process_directive(public(Public), Src) :- 1046 process_predicates(assert_public, Public, Src). 1047process_directive(export(Export), Src) :- 1048 process_predicates(assert_export, Export, Src). 1049process_directive(import(Import), Src) :- 1050 process_import(Import, Src). 1051process_directive(module(Module, Export), Src) :- 1052 assert_module(Src, Module), 1053 assert_module_export(Src, Export). 1054process_directive(module(Module, Export, Import), Src) :- 1055 assert_module(Src, Module), 1056 assert_module_export(Src, Export), 1057 assert_module3(Import, Src). 1058process_directive('$set_source_module'(system), Src) :- 1059 assert_module(Src, system). % hack for handling boot/init.pl 1060process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1061 assert_defined_class(Src, Name, Meta, Super, Doc). 1062process_directive(pce_autoload(Name, From), Src) :- 1063 assert_defined_class(Src, Name, imported_from(From)). 1064 1065process_directive(op(P, A, N), Src) :- 1066 xref_push_op(Src, P, A, N). 1067process_directive(set_prolog_flag(Flag, Value), Src) :- 1068 ( Flag == character_escapes 1069 -> set_prolog_flag(character_escapes, Value) 1070 ; true 1071 ), 1072 current_source_line(Line), 1073 xref_set_prolog_flag(Flag, Value, Src, Line). 1074process_directive(style_check(X), _) :- 1075 style_check(X). 1076process_directive(encoding(Enc), _) :- 1077 ( xref_input_stream(Stream) 1078 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1079 ; true % can this happen? 1080 ). 1081process_directive(pce_expansion:push_compile_operators, _) :- 1082 '$current_source_module'(SM), 1083 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1084process_directive(pce_expansion:pop_compile_operators, _) :- 1085 call(pce_expansion:pop_compile_operators). 1086process_directive(meta_predicate(Meta), Src) :- 1087 process_meta_predicate(Meta, Src). 1088process_directive(arithmetic_function(FSpec), Src) :- 1089 arith_callable(FSpec, Goal), 1090 !, 1091 current_source_line(Line), 1092 assert_called(Src, '<directive>'(Line), Goal, Line). 1093process_directive(format_predicate(_, Goal), Src) :- 1094 !, 1095 current_source_line(Line), 1096 assert_called(Src, '<directive>'(Line), Goal, Line). 1097process_directive(if(Cond), Src) :- 1098 !, 1099 current_source_line(Line), 1100 assert_called(Src, '<directive>'(Line), Cond, Line). 1101process_directive(elif(Cond), Src) :- 1102 !, 1103 current_source_line(Line), 1104 assert_called(Src, '<directive>'(Line), Cond, Line). 1105process_directive(else, _) :- !. 1106process_directive(endif, _) :- !. 1107process_directive(Goal, Src) :- 1108 current_source_line(Line), 1109 process_body(Goal, '<directive>'(Line), Src).
1115process_meta_predicate((A,B), Src) :- 1116 !, 1117 process_meta_predicate(A, Src), 1118 process_meta_predicate(B, Src). 1119process_meta_predicate(Decl, Src) :- 1120 process_meta_head(Src, Decl). 1121 1122process_meta_head(Src, Decl) :- % swapped arguments for maplist 1123 compound(Decl), 1124 compound_name_arity(Decl, Name, Arity), 1125 compound_name_arity(Head, Name, Arity), 1126 meta_args(1, Arity, Decl, Head, Meta), 1127 ( ( prolog:meta_goal(Head, _) 1128 ; prolog:called_by(Head, _, _, _) 1129 ; prolog:called_by(Head, _) 1130 ; meta_goal(Head, _) 1131 ) 1132 -> true 1133 ; assert(meta_goal(Head, Meta, Src)) 1134 ). 1135 1136meta_args(I, Arity, _, _, []) :- 1137 I > Arity, 1138 !. 1139meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1140 arg(I, Decl, 0), 1141 !, 1142 arg(I, Head, H), 1143 I2 is I + 1, 1144 meta_args(I2, Arity, Decl, Head, T). 1145meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1146 arg(I, Decl, ^), 1147 !, 1148 arg(I, Head, EH), 1149 setof_goal(EH, H), 1150 I2 is I + 1, 1151 meta_args(I2, Arity, Decl, Head, T). 1152meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1153 arg(I, Decl, //), 1154 !, 1155 arg(I, Head, H), 1156 I2 is I + 1, 1157 meta_args(I2, Arity, Decl, Head, T). 1158meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1159 arg(I, Decl, A), 1160 integer(A), A > 0, 1161 !, 1162 arg(I, Head, H), 1163 I2 is I + 1, 1164 meta_args(I2, Arity, Decl, Head, T). 1165meta_args(I, Arity, Decl, Head, Meta) :- 1166 I2 is I + 1, 1167 meta_args(I2, Arity, Decl, Head, Meta). 1168 1169 1170 /******************************** 1171 * BODY * 1172 ********************************/
1181xref_meta(Source, Head, Called) :-
1182 canonical_source(Source, Src),
1183 xref_meta_src(Head, Called, Src).1198xref_meta_src(Head, Called, Src) :- 1199 meta_goal(Head, Called, Src), 1200 !. 1201xref_meta_src(Head, Called, _) :- 1202 xref_meta(Head, Called), 1203 !. 1204xref_meta_src(Head, Called, _) :- 1205 compound(Head), 1206 compound_name_arity(Head, Name, Arity), 1207 apply_pred(Name), 1208 Arity > 5, 1209 !, 1210 Extra is Arity - 1, 1211 arg(1, Head, G), 1212 Called = [G+Extra]. 1213xref_meta_src(Head, Called, _) :- 1214 predicate_property(user:Head, meta_predicate(Meta)), 1215 !, 1216 Meta =.. [_|Args], 1217 meta_args(Args, 1, Head, Called). 1218 1219meta_args([], _, _, []). 1220meta_args([H0|T0], I, Head, [H|T]) :- 1221 xargs(H0, N), 1222 !, 1223 arg(I, Head, A), 1224 ( N == 0 1225 -> H = A 1226 ; H = (A+N) 1227 ), 1228 I2 is I+1, 1229 meta_args(T0, I2, Head, T). 1230meta_args([_|T0], I, Head, T) :- 1231 I2 is I+1, 1232 meta_args(T0, I2, Head, T). 1233 1234xargs(N, N) :- integer(N), !. 1235xargs(//, 2). 1236xargs(^, 0). 1237 1238apply_pred(call). % built-in 1239apply_pred(maplist). % library(apply_macros) 1240 1241xref_meta((A, B), [A, B]). 1242xref_meta((A; B), [A, B]). 1243xref_meta((A| B), [A, B]). 1244xref_meta((A -> B), [A, B]). 1245xref_meta((A *-> B), [A, B]). 1246xref_meta(findall(_V,G,_L), [G]). 1247xref_meta(findall(_V,G,_L,_T), [G]). 1248xref_meta(findnsols(_N,_V,G,_L), [G]). 1249xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1250xref_meta(setof(_V, EG, _L), [G]) :- 1251 setof_goal(EG, G). 1252xref_meta(bagof(_V, EG, _L), [G]) :- 1253 setof_goal(EG, G). 1254xref_meta(forall(A, B), [A, B]). 1255xref_meta(maplist(G,_), [G+1]). 1256xref_meta(maplist(G,_,_), [G+2]). 1257xref_meta(maplist(G,_,_,_), [G+3]). 1258xref_meta(maplist(G,_,_,_,_), [G+4]). 1259xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1260xref_meta(map_assoc(G, _), [G+1]). 1261xref_meta(map_assoc(G, _, _), [G+2]). 1262xref_meta(checklist(G, _L), [G+1]). 1263xref_meta(sublist(G, _, _), [G+1]). 1264xref_meta(include(G, _, _), [G+1]). 1265xref_meta(exclude(G, _, _), [G+1]). 1266xref_meta(partition(G, _, _, _, _), [G+2]). 1267xref_meta(partition(G, _, _, _),[G+1]). 1268xref_meta(call(G), [G]). 1269xref_meta(call(G, _), [G+1]). 1270xref_meta(call(G, _, _), [G+2]). 1271xref_meta(call(G, _, _, _), [G+3]). 1272xref_meta(call(G, _, _, _, _), [G+4]). 1273xref_meta(not(G), [G]). 1274xref_meta(notrace(G), [G]). 1275xref_meta(\+(G), [G]). 1276xref_meta(ignore(G), [G]). 1277xref_meta(once(G), [G]). 1278xref_meta(initialization(G), [G]). 1279xref_meta(initialization(G,_), [G]). 1280xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1281xref_meta(clause(G, _), [G]). 1282xref_meta(clause(G, _, _), [G]). 1283xref_meta(phrase(G, _A), [//(G)]). 1284xref_meta(phrase(G, _A, _R), [//(G)]). 1285xref_meta(call_dcg(G, _A, _R), [//(G)]). 1286xref_meta(phrase_from_file(G,_),[//(G)]). 1287xref_meta(catch(A, _, B), [A, B]). 1288xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1289xref_meta(thread_create(A,_,_), [A]). 1290xref_meta(thread_create(A,_), [A]). 1291xref_meta(thread_signal(_,A), [A]). 1292xref_meta(thread_idle(A,_), [A]). 1293xref_meta(thread_at_exit(A), [A]). 1294xref_meta(thread_initialization(A), [A]). 1295xref_meta(engine_create(_,A,_), [A]). 1296xref_meta(engine_create(_,A,_,_), [A]). 1297xref_meta(transaction(A), [A]). 1298xref_meta(transaction(A,B,_), [A,B]). 1299xref_meta(snapshot(A), [A]). 1300xref_meta(predsort(A,_,_), [A+3]). 1301xref_meta(call_cleanup(A, B), [A, B]). 1302xref_meta(call_cleanup(A, _, B),[A, B]). 1303xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1304xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1305xref_meta(call_residue_vars(A,_), [A]). 1306xref_meta(with_mutex(_,A), [A]). 1307xref_meta(assume(G), [G]). % library(debug) 1308xref_meta(assertion(G), [G]). % library(debug) 1309xref_meta(freeze(_, G), [G]). 1310xref_meta(when(C, A), [C, A]). 1311xref_meta(time(G), [G]). % development system 1312xref_meta(call_time(G, _), [G]). % development system 1313xref_meta(call_time(G, _, _), [G]). % development system 1314xref_meta(profile(G), [G]). 1315xref_meta(at_halt(G), [G]). 1316xref_meta(call_with_time_limit(_, G), [G]). 1317xref_meta(call_with_depth_limit(G, _, _), [G]). 1318xref_meta(call_with_inference_limit(G, _, _), [G]). 1319xref_meta(alarm(_, G, _), [G]). 1320xref_meta(alarm(_, G, _, _), [G]). 1321xref_meta('$add_directive_wic'(G), [G]). 1322xref_meta(with_output_to(_, G), [G]). 1323xref_meta(if(G), [G]). 1324xref_meta(elif(G), [G]). 1325xref_meta(meta_options(G,_,_), [G+1]). 1326xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1327xref_meta(distinct(G), [G]). % library(solution_sequences) 1328xref_meta(distinct(_, G), [G]). 1329xref_meta(order_by(_, G), [G]). 1330xref_meta(limit(_, G), [G]). 1331xref_meta(offset(_, G), [G]). 1332xref_meta(reset(G,_,_), [G]). 1333xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1334xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1335xref_meta(tnot(G), [G]). 1336xref_meta(not_exists(G), [G]). 1337xref_meta(with_tty_raw(G), [G]). 1338 1339 % XPCE meta-predicates 1340xref_meta(pce_global(_, new(_)), _) :- !, fail. 1341xref_meta(pce_global(_, B), [B+1]). 1342xref_meta(ifmaintainer(G), [G]). % used in manual 1343xref_meta(listen(_, G), [G]). % library(broadcast) 1344xref_meta(listen(_, _, G), [G]). 1345xref_meta(in_pce_thread(G), [G]). 1346 1347xref_meta(G, Meta) :- % call user extensions 1348 prolog:meta_goal(G, Meta). 1349xref_meta(G, Meta) :- % Generated from :- meta_predicate 1350 meta_goal(G, Meta). 1351 1352setof_goal(EG, G) :- 1353 var(EG), !, G = EG. 1354setof_goal(_^EG, G) :- 1355 !, 1356 setof_goal(EG, G). 1357setof_goal(G, G). 1358 1359event_xargs(abort, 0). 1360event_xargs(erase, 1). 1361event_xargs(break, 3). 1362event_xargs(frame_finished, 1). 1363event_xargs(thread_exit, 1). 1364event_xargs(this_thread_exit, 0). 1365event_xargs(PI, 2) :- pi_to_head(PI, _).
1371head_of(Var, _) :- 1372 var(Var), !, fail. 1373head_of((Head :- _), Head). 1374head_of(Head, Head).
1382xref_hook(Hook) :- 1383 prolog:hook(Hook). 1384xref_hook(Hook) :- 1385 hook(Hook). 1386 1387 1388hook(attr_portray_hook(_,_)). 1389hook(attr_unify_hook(_,_)). 1390hook(attribute_goals(_,_,_)). 1391hook(goal_expansion(_,_)). 1392hook(term_expansion(_,_)). 1393hook(resource(_,_,_)). 1394hook('$pred_option'(_,_,_,_)). 1395 1396hook(emacs_prolog_colours:goal_classification(_,_)). 1397hook(emacs_prolog_colours:term_colours(_,_)). 1398hook(emacs_prolog_colours:goal_colours(_,_)). 1399hook(emacs_prolog_colours:style(_,_)). 1400hook(emacs_prolog_colours:identify(_,_)). 1401hook(pce_principal:pce_class(_,_,_,_,_,_)). 1402hook(pce_principal:send_implementation(_,_,_)). 1403hook(pce_principal:get_implementation(_,_,_,_)). 1404hook(pce_principal:pce_lazy_get_method(_,_,_)). 1405hook(pce_principal:pce_lazy_send_method(_,_,_)). 1406hook(pce_principal:pce_uses_template(_,_)). 1407hook(prolog:locate_clauses(_,_)). 1408hook(prolog:message(_,_,_)). 1409hook(prolog:error_message(_,_,_)). 1410hook(prolog:message_location(_,_,_)). 1411hook(prolog:message_context(_,_,_)). 1412hook(prolog:message_line_element(_,_)). 1413hook(prolog:debug_control_hook(_)). 1414hook(prolog:help_hook(_)). 1415hook(prolog:show_profile_hook(_,_)). 1416hook(prolog:general_exception(_,_)). 1417hook(prolog:predicate_summary(_,_)). 1418hook(prolog:residual_goals(_,_)). 1419hook(prolog_edit:load). 1420hook(prolog_edit:locate(_,_,_)). 1421hook(shlib:unload_all_foreign_libraries). 1422hook(system:'$foreign_registered'(_, _)). 1423hook(predicate_options:option_decl(_,_,_)). 1424hook(user:exception(_,_,_)). 1425hook(user:file_search_path(_,_)). 1426hook(user:library_directory(_)). 1427hook(user:message_hook(_,_,_)). 1428hook(user:portray(_)). 1429hook(user:prolog_clause_name(_,_)). 1430hook(user:prolog_list_goal(_)). 1431hook(user:prolog_predicate_name(_,_)). 1432hook(user:prolog_trace_interception(_,_,_,_)). 1433hook(user:prolog_exception_hook(_,_,_,_)). 1434hook(sandbox:safe_primitive(_)). 1435hook(sandbox:safe_meta_predicate(_)). 1436hook(sandbox:safe_meta(_,_)). 1437hook(sandbox:safe_global_variable(_)). 1438hook(sandbox:safe_directive(_)).
1445arith_callable(Var, _) :- 1446 var(Var), !, fail. 1447arith_callable(Module:Spec, Module:Goal) :- 1448 !, 1449 arith_callable(Spec, Goal). 1450arith_callable(Name/Arity, Goal) :- 1451 PredArity is Arity + 1, 1452 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1463process_body(Body, Origin, Src) :-
1464 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1465 true).true if there was a
partial evalation inside Goal that has bound variables.1472process_goal(Var, _, _, _) :- 1473 var(Var), 1474 !. 1475process_goal(Goal, Origin, Src, P) :- 1476 Goal = (_,_), % problems 1477 !, 1478 phrase(conjunction(Goal), Goals), 1479 process_conjunction(Goals, Origin, Src, P). 1480process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1481 Goal = (_;_), % problems 1482 !, 1483 phrase(disjunction(Goal), Goals), 1484 forall(member(G, Goals), 1485 process_body(G, Origin, Src)). 1486process_goal(Goal, Origin, Src, P) :- 1487 ( ( xmodule(M, Src) 1488 -> true 1489 ; M = user 1490 ), 1491 ( predicate_property(M:Goal, imported_from(IM)) 1492 -> true 1493 ; IM = M 1494 ), 1495 prolog:called_by(Goal, IM, M, Called) 1496 ; prolog:called_by(Goal, Called) 1497 ), 1498 !, 1499 must_be(list, Called), 1500 current_source_line(Here), 1501 assert_called(Src, Origin, Goal, Here), 1502 process_called_list(Called, Origin, Src, P). 1503process_goal(Goal, Origin, Src, _) :- 1504 process_xpce_goal(Goal, Origin, Src), 1505 !. 1506process_goal(load_foreign_library(File), _Origin, Src, _) :- 1507 process_foreign(File, Src). 1508process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1509 process_foreign(File, Src). 1510process_goal(use_foreign_library(File), _Origin, Src, _) :- 1511 process_foreign(File, Src). 1512process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1513 process_foreign(File, Src). 1514process_goal(Goal, Origin, Src, P) :- 1515 xref_meta_src(Goal, Metas, Src), 1516 !, 1517 current_source_line(Here), 1518 assert_called(Src, Origin, Goal, Here), 1519 process_called_list(Metas, Origin, Src, P). 1520process_goal(Goal, Origin, Src, _) :- 1521 asserting_goal(Goal, Rule), 1522 !, 1523 current_source_line(Here), 1524 assert_called(Src, Origin, Goal, Here), 1525 process_assert(Rule, Origin, Src). 1526process_goal(Goal, Origin, Src, P) :- 1527 partial_evaluate(Goal, P), 1528 current_source_line(Here), 1529 assert_called(Src, Origin, Goal, Here). 1530 1531disjunction(Var) --> {var(Var), !}, [Var]. 1532disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1533disjunction(G) --> [G]. 1534 1535conjunction(Var) --> {var(Var), !}, [Var]. 1536conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1537conjunction(G) --> [G]. 1538 (RVars, T) :- 1540 term_variables(T, TVars0), 1541 sort(TVars0, TVars), 1542 ord_intersect(RVars, TVars). 1543 1544process_conjunction([], _, _, _). 1545process_conjunction([Disj|Rest], Origin, Src, P) :- 1546 nonvar(Disj), 1547 Disj = (_;_), 1548 Rest \== [], 1549 !, 1550 phrase(disjunction(Disj), Goals), 1551 term_variables(Rest, RVars0), 1552 sort(RVars0, RVars), 1553 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1554 forall(member(G, NonSHaring), 1555 process_body(G, Origin, Src)), 1556 ( Sharing == [] 1557 -> true 1558 ; maplist(term_variables, Sharing, GVars0), 1559 append(GVars0, GVars1), 1560 sort(GVars1, GVars), 1561 ord_intersection(GVars, RVars, SVars), 1562 VT =.. [v|SVars], 1563 findall(VT, 1564 ( member(G, Sharing), 1565 process_goal(G, Origin, Src, PS), 1566 PS == true 1567 ), 1568 Alts0), 1569 ( Alts0 == [] 1570 -> true 1571 ; ( true 1572 ; P = true, 1573 sort(Alts0, Alts1), 1574 variants(Alts1, 10, Alts), 1575 member(VT, Alts) 1576 ) 1577 ) 1578 ), 1579 process_conjunction(Rest, Origin, Src, P). 1580process_conjunction([H|T], Origin, Src, P) :- 1581 process_goal(H, Origin, Src, P), 1582 process_conjunction(T, Origin, Src, P). 1583 1584 1585process_called_list([], _, _, _). 1586process_called_list([H|T], Origin, Src, P) :- 1587 process_meta(H, Origin, Src, P), 1588 process_called_list(T, Origin, Src, P). 1589 1590process_meta(A+N, Origin, Src, P) :- 1591 !, 1592 ( extend(A, N, AX) 1593 -> process_goal(AX, Origin, Src, P) 1594 ; true 1595 ). 1596process_meta(//(A), Origin, Src, P) :- 1597 !, 1598 process_dcg_goal(A, Origin, Src, P). 1599process_meta(G, Origin, Src, P) :- 1600 process_goal(G, Origin, Src, P).
1607process_dcg_goal(Var, _, _, _) :- 1608 var(Var), 1609 !. 1610process_dcg_goal((A,B), Origin, Src, P) :- 1611 !, 1612 process_dcg_goal(A, Origin, Src, P), 1613 process_dcg_goal(B, Origin, Src, P). 1614process_dcg_goal((A;B), Origin, Src, P) :- 1615 !, 1616 process_dcg_goal(A, Origin, Src, P), 1617 process_dcg_goal(B, Origin, Src, P). 1618process_dcg_goal((A|B), Origin, Src, P) :- 1619 !, 1620 process_dcg_goal(A, Origin, Src, P), 1621 process_dcg_goal(B, Origin, Src, P). 1622process_dcg_goal((A->B), Origin, Src, P) :- 1623 !, 1624 process_dcg_goal(A, Origin, Src, P), 1625 process_dcg_goal(B, Origin, Src, P). 1626process_dcg_goal((A*->B), Origin, Src, P) :- 1627 !, 1628 process_dcg_goal(A, Origin, Src, P), 1629 process_dcg_goal(B, Origin, Src, P). 1630process_dcg_goal({Goal}, Origin, Src, P) :- 1631 !, 1632 process_goal(Goal, Origin, Src, P). 1633process_dcg_goal(List, _Origin, _Src, _) :- 1634 is_list(List), 1635 !. % terminal 1636process_dcg_goal(List, _Origin, _Src, _) :- 1637 string(List), 1638 !. % terminal 1639process_dcg_goal(Callable, Origin, Src, P) :- 1640 extend(Callable, 2, Goal), 1641 !, 1642 process_goal(Goal, Origin, Src, P). 1643process_dcg_goal(_, _, _, _). 1644 1645 1646extend(Var, _, _) :- 1647 var(Var), !, fail. 1648extend(M:G, N, M:GX) :- 1649 !, 1650 callable(G), 1651 extend(G, N, GX). 1652extend(G, N, GX) :- 1653 ( compound(G) 1654 -> compound_name_arguments(G, Name, Args), 1655 length(Rest, N), 1656 append(Args, Rest, NArgs), 1657 compound_name_arguments(GX, Name, NArgs) 1658 ; atom(G) 1659 -> length(NArgs, N), 1660 compound_name_arguments(GX, G, NArgs) 1661 ). 1662 1663asserting_goal(assert(Rule), Rule). 1664asserting_goal(asserta(Rule), Rule). 1665asserting_goal(assertz(Rule), Rule). 1666asserting_goal(assert(Rule,_), Rule). 1667asserting_goal(asserta(Rule,_), Rule). 1668asserting_goal(assertz(Rule,_), Rule). 1669 1670process_assert(0, _, _) :- !. % catch variables 1671process_assert((_:-Body), Origin, Src) :- 1672 !, 1673 process_body(Body, Origin, Src). 1674process_assert(_, _, _).
1678variants([], _, []). 1679variants([H|T], Max, List) :- 1680 variants(T, H, Max, List). 1681 1682variants([], H, _, [H]). 1683variants(_, _, 0, []) :- !. 1684variants([H|T], V, Max, List) :- 1685 ( H =@= V 1686 -> variants(T, V, Max, List) 1687 ; List = [V|List2], 1688 Max1 is Max-1, 1689 variants(T, H, Max1, List2) 1690 ).
T = hello(X),
findall(T, T, List),
1704partial_evaluate(Goal, P) :- 1705 eval(Goal), 1706 !, 1707 P = true. 1708partial_evaluate(_, _). 1709 1710eval(X = Y) :- 1711 unify_with_occurs_check(X, Y). 1712 1713 1714 /******************************* 1715 * XPCE STUFF * 1716 *******************************/ 1717 1718pce_goal(new(_,_), new(-, new)). 1719pce_goal(send(_,_), send(arg, msg)). 1720pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1721pce_goal(get(_,_,_), get(arg, msg, -)). 1722pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1723pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1724pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1725 1726process_xpce_goal(G, Origin, Src) :- 1727 pce_goal(G, Process), 1728 !, 1729 current_source_line(Here), 1730 assert_called(Src, Origin, G, Here), 1731 ( arg(I, Process, How), 1732 arg(I, G, Term), 1733 process_xpce_arg(How, Term, Origin, Src), 1734 fail 1735 ; true 1736 ). 1737 1738process_xpce_arg(new, Term, Origin, Src) :- 1739 callable(Term), 1740 process_new(Term, Origin, Src). 1741process_xpce_arg(arg, Term, Origin, Src) :- 1742 compound(Term), 1743 process_new(Term, Origin, Src). 1744process_xpce_arg(msg, Term, Origin, Src) :- 1745 compound(Term), 1746 ( arg(_, Term, Arg), 1747 process_xpce_arg(arg, Arg, Origin, Src), 1748 fail 1749 ; true 1750 ). 1751 1752process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1753process_new(Term, Origin, Src) :- 1754 assert_new(Src, Origin, Term), 1755 ( compound(Term), 1756 arg(_, Term, Arg), 1757 process_xpce_arg(arg, Arg, Origin, Src), 1758 fail 1759 ; true 1760 ). 1761 1762assert_new(_, _, Term) :- 1763 \+ callable(Term), 1764 !. 1765assert_new(Src, Origin, Control) :- 1766 functor_name(Control, Class), 1767 pce_control_class(Class), 1768 !, 1769 forall(arg(_, Control, Arg), 1770 assert_new(Src, Origin, Arg)). 1771assert_new(Src, Origin, Term) :- 1772 compound(Term), 1773 arg(1, Term, Prolog), 1774 Prolog == @(prolog), 1775 ( Term =.. [message, _, Selector | T], 1776 atom(Selector) 1777 -> Called =.. [Selector|T], 1778 process_body(Called, Origin, Src) 1779 ; Term =.. [?, _, Selector | T], 1780 atom(Selector) 1781 -> append(T, [_R], T2), 1782 Called =.. [Selector|T2], 1783 process_body(Called, Origin, Src) 1784 ), 1785 fail. 1786assert_new(_, _, @(_)) :- !. 1787assert_new(Src, _, Term) :- 1788 functor_name(Term, Name), 1789 assert_used_class(Src, Name). 1790 1791 1792pce_control_class(and). 1793pce_control_class(or). 1794pce_control_class(if). 1795pce_control_class(not). 1796 1797 1798 /******************************** 1799 * INCLUDED MODULES * 1800 ********************************/
1804process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1805process_use_module([], _, _) :- !. 1806process_use_module([H|T], Src, Reexport) :- 1807 !, 1808 process_use_module(H, Src, Reexport), 1809 process_use_module(T, Src, Reexport). 1810process_use_module(library(pce), Src, Reexport) :- % bit special 1811 !, 1812 xref_public_list(library(pce), Path, Exports, Src), 1813 forall(member(Import, Exports), 1814 process_pce_import(Import, Src, Path, Reexport)). 1815process_use_module(File, Src, Reexport) :- 1816 load_module_if_needed(File), 1817 ( xoption(Src, silent(Silent)) 1818 -> Extra = [silent(Silent)] 1819 ; Extra = [silent(true)] 1820 ), 1821 ( xref_public_list(File, Src, 1822 [ path(Path), 1823 module(M), 1824 exports(Exports), 1825 public(Public), 1826 meta(Meta) 1827 | Extra 1828 ]) 1829 -> assert(uses_file(File, Src, Path)), 1830 assert_import(Src, Exports, _, Path, Reexport), 1831 assert_xmodule_callable(Exports, M, Src, Path), 1832 assert_xmodule_callable(Public, M, Src, Path), 1833 maplist(process_meta_head(Src), Meta), 1834 ( File = library(chr) % hacky 1835 -> assert(mode(chr, Src)) 1836 ; true 1837 ) 1838 ; assert(uses_file(File, Src, '<not_found>')) 1839 ). 1840 1841process_pce_import(Name/Arity, Src, Path, Reexport) :- 1842 atom(Name), 1843 integer(Arity), 1844 !, 1845 functor(Term, Name, Arity), 1846 ( \+ system_predicate(Term), 1847 \+ Term = pce_error(_) % hack!? 1848 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1849 ; true 1850 ). 1851process_pce_import(op(P,T,N), Src, _, _) :- 1852 xref_push_op(Src, P, T, N).
1858process_use_module2(File, Import, Src, Reexport) :-
1859 load_module_if_needed(File),
1860 ( xref_source_file(File, Path, Src)
1861 -> assert(uses_file(File, Src, Path)),
1862 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1863 -> assert_import(Src, Import, Export, Path, Reexport),
1864 forall(( member(Head, Meta),
1865 imported(Head, _, Path)
1866 ),
1867 process_meta_head(Src, Head))
1868 ; true
1869 )
1870 ; assert(uses_file(File, Src, '<not_found>'))
1871 ).1880load_module_if_needed(File) :- 1881 prolog:no_autoload_module(File), 1882 !, 1883 use_module(File, []). 1884load_module_if_needed(_). 1885 1886prologno_autoload_module(library(apply_macros)). 1887prologno_autoload_module(library(arithmetic)). 1888prologno_autoload_module(library(record)). 1889prologno_autoload_module(library(persistency)). 1890prologno_autoload_module(library(pldoc)). 1891prologno_autoload_module(library(settings)). 1892prologno_autoload_module(library(debug)). 1893prologno_autoload_module(library(plunit)).
1898process_requires(Import, Src) :- 1899 is_list(Import), 1900 !, 1901 require_list(Import, Src). 1902process_requires(Var, _Src) :- 1903 var(Var), 1904 !. 1905process_requires((A,B), Src) :- 1906 !, 1907 process_requires(A, Src), 1908 process_requires(B, Src). 1909process_requires(PI, Src) :- 1910 requires(PI, Src). 1911 1912require_list([], _). 1913require_list([H|T], Src) :- 1914 requires(H, Src), 1915 require_list(T, Src). 1916 1917requires(PI, _Src) :- 1918 '$pi_head'(PI, Head), 1919 '$get_predicate_attribute'(system:Head, defined, 1), 1920 !. 1921requires(PI, Src) :- 1922 '$pi_head'(PI, Head), 1923 '$pi_head'(Name/Arity, Head), 1924 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1925 ( imported(Head, Src, Library) 1926 -> true 1927 ; assertz(imported(Head, Src, Library)) 1928 ).
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.
1959xref_public_list(File, Src, Options) :-
1960 option(path(Path), Options, _),
1961 option(module(Module), Options, _),
1962 option(exports(Exports), Options, _),
1963 option(public(Public), Options, _),
1964 option(meta(Meta), Options, _),
1965 xref_source_file(File, Path, Src, Options),
1966 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
1988xref_public_list(File, Path, Export, Src) :- 1989 xref_source_file(File, Path, Src), 1990 public_list(Path, _, _, Export, _, []). 1991xref_public_list(File, Path, Module, Export, Meta, Src) :- 1992 xref_source_file(File, Path, Src), 1993 public_list(Path, Module, Meta, Export, _, []). 1994xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 1995 xref_source_file(File, Path, Src), 1996 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2006:- dynamic public_list_cache/6. 2007:- volatile public_list_cache/6. 2008 2009public_list(Path, Module, Meta, Export, Public, _Options) :- 2010 public_list_cache(Path, Modified, 2011 Module0, Meta0, Export0, Public0), 2012 time_file(Path, ModifiedNow), 2013 ( abs(Modified-ModifiedNow) < 0.0001 2014 -> !, 2015 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2016 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2017 fail 2018 ). 2019public_list(Path, Module, Meta, Export, Public, Options) :- 2020 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2021 ( Error = error(_,_), 2022 catch(time_file(Path, Modified), Error, fail) 2023 -> asserta(public_list_cache(Path, Modified, 2024 Module0, Meta0, Export0, Public0)) 2025 ; true 2026 ), 2027 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2028 2029public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2030 in_temporary_module( 2031 TempModule, 2032 true, 2033 public_list_diff(TempModule, Path, Module, 2034 Meta, [], Export, [], Public, [], Options)). 2035 2036 2037public_list_diff(TempModule, 2038 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2039 setup_call_cleanup( 2040 public_list_setup(TempModule, Path, In, State), 2041 phrase(read_directives(In, Options, [true]), Directives), 2042 public_list_cleanup(In, State)), 2043 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2044 2045public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2046 prolog_open_source(Path, In), 2047 '$set_source_module'(OldM, TempModule), 2048 set_xref(OldXref). 2049 2050public_list_cleanup(In, state(OldM, OldXref)) :- 2051 '$set_source_module'(OldM), 2052 set_prolog_flag(xref, OldXref), 2053 prolog_close_source(In). 2054 2055 2056read_directives(In, Options, State) --> 2057 { repeat, 2058 catch(prolog_read_source_term(In, Term, Expanded, 2059 [ process_comment(true), 2060 syntax_errors(error) 2061 ]), 2062 E, report_syntax_error(E, -, Options)) 2063 -> nonvar(Term), 2064 Term = (:-_) 2065 }, 2066 !, 2067 terms(Expanded, State, State1), 2068 read_directives(In, Options, State1). 2069read_directives(_, _, _) --> []. 2070 2071terms(Var, State, State) --> { var(Var) }, !. 2072terms([H|T], State0, State) --> 2073 !, 2074 terms(H, State0, State1), 2075 terms(T, State1, State). 2076terms((:-if(Cond)), State0, [True|State0]) --> 2077 !, 2078 { eval_cond(Cond, True) }. 2079terms((:-elif(Cond)), [True0|State], [True|State]) --> 2080 !, 2081 { eval_cond(Cond, True1), 2082 elif(True0, True1, True) 2083 }. 2084terms((:-else), [True0|State], [True|State]) --> 2085 !, 2086 { negate(True0, True) }. 2087terms((:-endif), [_|State], State) --> !. 2088terms(H, State, State) --> 2089 ( {State = [true|_]} 2090 -> [H] 2091 ; [] 2092 ). 2093 2094eval_cond(Cond, true) :- 2095 catch(Cond, _, fail), 2096 !. 2097eval_cond(_, false). 2098 2099elif(true, _, else_false) :- !. 2100elif(false, true, true) :- !. 2101elif(True, _, True). 2102 2103negate(true, false). 2104negate(false, true). 2105negate(else_false, else_false). 2106 2107public_list([(:- module(Module, Export0))|Decls], Path, 2108 Module, Meta, MT, Export, Rest, Public, PT) :- 2109 !, 2110 append(Export0, Reexport, Export), 2111 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2112public_list([(:- encoding(_))|Decls], Path, 2113 Module, Meta, MT, Export, Rest, Public, PT) :- 2114 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2115 2116public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2117public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2118 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2119 !, 2120 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2121public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2122 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2123 2124public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2125 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2126public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2127 public_from_import(Import, Spec, Path, Reexport, Rest). 2128public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2129 phrase(meta_decls(Decl), Meta, MT). 2130public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2131 phrase(public_decls(Decl), Public, PT).
2137reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2138reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2139 !, 2140 xref_source_file(H, Path, Src), 2141 public_list(Path, _Module, Meta0, Export0, Public0, []), 2142 append(Meta0, MT1, Meta), 2143 append(Export0, ET1, Export), 2144 append(Public0, PT1, Public), 2145 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2146reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2147 xref_source_file(Spec, Path, Src), 2148 public_list(Path, _Module, Meta0, Export0, Public0, []), 2149 append(Meta0, MT, Meta), 2150 append(Export0, ET, Export), 2151 append(Public0, PT, Public). 2152 2153public_from_import(except(Map), Path, Src, Export, Rest) :- 2154 !, 2155 xref_public_list(Path, _, AllExports, Src), 2156 except(Map, AllExports, NewExports), 2157 append(NewExports, Rest, Export). 2158public_from_import(Import, _, _, Export, Rest) :- 2159 import_name_map(Import, Export, Rest).
2164except([], Exports, Exports). 2165except([PI0 as NewName|Map], Exports0, Exports) :- 2166 !, 2167 canonical_pi(PI0, PI), 2168 map_as(Exports0, PI, NewName, Exports1), 2169 except(Map, Exports1, Exports). 2170except([PI0|Map], Exports0, Exports) :- 2171 canonical_pi(PI0, PI), 2172 select(PI2, Exports0, Exports1), 2173 same_pi(PI, PI2), 2174 !, 2175 except(Map, Exports1, Exports). 2176 2177 2178map_as([PI|T], Repl, As, [PI2|T]) :- 2179 same_pi(Repl, PI), 2180 !, 2181 pi_as(PI, As, PI2). 2182map_as([H|T0], Repl, As, [H|T]) :- 2183 map_as(T0, Repl, As, T). 2184 2185pi_as(_/Arity, Name, Name/Arity). 2186pi_as(_//Arity, Name, Name//Arity). 2187 2188import_name_map([], L, L). 2189import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2190 !, 2191 import_name_map(T0, T, Tail). 2192import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2193 !, 2194 import_name_map(T0, T, Tail). 2195import_name_map([H|T0], [H|T], Tail) :- 2196 import_name_map(T0, T, Tail). 2197 2198canonical_pi(Name//Arity0, PI) :- 2199 integer(Arity0), 2200 !, 2201 PI = Name/Arity, 2202 Arity is Arity0 + 2. 2203canonical_pi(PI, PI). 2204 2205same_pi(Canonical, PI2) :- 2206 canonical_pi(PI2, Canonical). 2207 2208meta_decls(Var) --> 2209 { var(Var) }, 2210 !. 2211meta_decls((A,B)) --> 2212 !, 2213 meta_decls(A), 2214 meta_decls(B). 2215meta_decls(A) --> 2216 [A]. 2217 2218public_decls(Var) --> 2219 { var(Var) }, 2220 !. 2221public_decls((A,B)) --> 2222 !, 2223 public_decls(A), 2224 public_decls(B). 2225public_decls(A) --> 2226 [A]. 2227 2228 /******************************* 2229 * INCLUDE * 2230 *******************************/ 2231 2232process_include([], _) :- !. 2233process_include([H|T], Src) :- 2234 !, 2235 process_include(H, Src), 2236 process_include(T, Src). 2237process_include(File, Src) :- 2238 callable(File), 2239 !, 2240 ( once(xref_input(ParentSrc, _)), 2241 xref_source_file(File, Path, ParentSrc) 2242 -> ( ( uses_file(_, Src, Path) 2243 ; Path == Src 2244 ) 2245 -> true 2246 ; assert(uses_file(File, Src, Path)), 2247 ( xoption(Src, process_include(true)) 2248 -> findall(O, xoption(Src, O), Options), 2249 setup_call_cleanup( 2250 open_include_file(Path, In, Refs), 2251 collect(Src, Path, In, Options), 2252 close_include(In, Refs)) 2253 ; true 2254 ) 2255 ) 2256 ; assert(uses_file(File, Src, '<not_found>')) 2257 ). 2258process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2266open_include_file(Path, In, [Ref]) :- 2267 once(xref_input(_, Parent)), 2268 stream_property(Parent, encoding(Enc)), 2269 '$push_input_context'(xref_include), 2270 catch(( prolog:xref_open_source(Path, In) 2271 -> catch(set_stream(In, encoding(Enc)), 2272 error(_,_), true) % deal with non-file input 2273 ; include_encoding(Enc, Options), 2274 open(Path, read, In, Options) 2275 ), E, 2276 ( '$pop_input_context', throw(E))), 2277 catch(( peek_char(In, #) % Deal with #! script 2278 -> skip(In, 10) 2279 ; true 2280 ), E, 2281 ( close_include(In, []), throw(E))), 2282 asserta(xref_input(Path, In), Ref). 2283 2284include_encoding(wchar_t, []) :- !. 2285include_encoding(Enc, [encoding(Enc)]). 2286 2287 2288close_include(In, Refs) :- 2289 maplist(erase, Refs), 2290 close(In, [force(true)]), 2291 '$pop_input_context'.
2297process_foreign(Spec, Src) :- 2298 ground(Spec), 2299 current_foreign_library(Spec, Defined), 2300 !, 2301 ( xmodule(Module, Src) 2302 -> true 2303 ; Module = user 2304 ), 2305 process_foreign_defined(Defined, Module, Src). 2306process_foreign(_, _). 2307 2308process_foreign_defined([], _, _). 2309process_foreign_defined([H|T], M, Src) :- 2310 ( H = M:Head 2311 -> assert_foreign(Src, Head) 2312 ; assert_foreign(Src, H) 2313 ), 2314 process_foreign_defined(T, M, Src). 2315 2316 2317 /******************************* 2318 * CHR SUPPORT * 2319 *******************************/ 2320 2321/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2322This part of the file supports CHR. Our choice is between making special 2323hooks to make CHR expansion work and then handle the (complex) expanded 2324code or process the CHR source directly. The latter looks simpler, 2325though I don't like the idea of adding support for libraries to this 2326module. A file is supposed to be a CHR file if it uses a 2327use_module(library(chr) or contains a :- constraint/1 directive. As an 2328extra bonus we get the source-locations right :-) 2329- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2330 2331process_chr(@(_Name, Rule), Src) :- 2332 mode(chr, Src), 2333 process_chr(Rule, Src). 2334process_chr(pragma(Rule, _Pragma), Src) :- 2335 mode(chr, Src), 2336 process_chr(Rule, Src). 2337process_chr(<=>(Head, Body), Src) :- 2338 mode(chr, Src), 2339 chr_head(Head, Src, H), 2340 chr_body(Body, H, Src). 2341process_chr(==>(Head, Body), Src) :- 2342 mode(chr, Src), 2343 chr_head(Head, H, Src), 2344 chr_body(Body, H, Src). 2345process_chr((:- chr_constraint(_)), Src) :- 2346 ( mode(chr, Src) 2347 -> true 2348 ; assert(mode(chr, Src)) 2349 ). 2350 2351chr_head(X, _, _) :- 2352 var(X), 2353 !. % Illegal. Warn? 2354chr_head(\(A,B), Src, H) :- 2355 chr_head(A, Src, H), 2356 process_body(B, H, Src). 2357chr_head((H0,B), Src, H) :- 2358 chr_defined(H0, Src, H), 2359 process_body(B, H, Src). 2360chr_head(H0, Src, H) :- 2361 chr_defined(H0, Src, H). 2362 2363chr_defined(X, _, _) :- 2364 var(X), 2365 !. 2366chr_defined(#(C,_Id), Src, C) :- 2367 !, 2368 assert_constraint(Src, C). 2369chr_defined(A, Src, A) :- 2370 assert_constraint(Src, A). 2371 2372chr_body(X, From, Src) :- 2373 var(X), 2374 !, 2375 process_body(X, From, Src). 2376chr_body('|'(Guard, Goals), H, Src) :- 2377 !, 2378 chr_body(Guard, H, Src), 2379 chr_body(Goals, H, Src). 2380chr_body(G, From, Src) :- 2381 process_body(G, From, Src). 2382 2383assert_constraint(_, Head) :- 2384 var(Head), 2385 !. 2386assert_constraint(Src, Head) :- 2387 constraint(Head, Src, _), 2388 !. 2389assert_constraint(Src, Head) :- 2390 generalise_term(Head, Term), 2391 current_source_line(Line), 2392 assert(constraint(Term, Src, Line)). 2393 2394 2395 /******************************** 2396 * PHASE 1 ASSERTIONS * 2397 ********************************/
2404assert_called(_, _, Var, _) :- 2405 var(Var), 2406 !. 2407assert_called(Src, From, Goal, Line) :- 2408 var(From), 2409 !, 2410 assert_called(Src, '<unknown>', Goal, Line). 2411assert_called(_, _, Goal, _) :- 2412 expand_hide_called(Goal), 2413 !. 2414assert_called(Src, Origin, M:G, Line) :- 2415 !, 2416 ( atom(M), 2417 callable(G) 2418 -> current_condition(Cond), 2419 ( xmodule(M, Src) % explicit call to own module 2420 -> assert_called(Src, Origin, G, Line) 2421 ; called(M:G, Src, Origin, Cond, Line) % already registered 2422 -> true 2423 ; hide_called(M:G, Src) % not interesting (now) 2424 -> true 2425 ; generalise(Origin, OTerm), 2426 generalise(G, GTerm) 2427 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2428 ; true 2429 ) 2430 ; true % call to variable module 2431 ). 2432assert_called(Src, _, Goal, _) :- 2433 ( xmodule(M, Src) 2434 -> M \== system 2435 ; M = user 2436 ), 2437 hide_called(M:Goal, Src), 2438 !. 2439assert_called(Src, Origin, Goal, Line) :- 2440 current_condition(Cond), 2441 ( called(Goal, Src, Origin, Cond, Line) 2442 -> true 2443 ; generalise(Origin, OTerm), 2444 generalise(Goal, Term) 2445 -> assert(called(Term, Src, OTerm, Cond, Line)) 2446 ; true 2447 ).
2455expand_hide_called(pce_principal:send_implementation(_, _, _)). 2456expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2457expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2458expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2459 2460assert_defined(Src, Goal) :- 2461 defined(Goal, Src, _), 2462 !. 2463assert_defined(Src, Goal) :- 2464 generalise(Goal, Term), 2465 current_source_line(Line), 2466 assert(defined(Term, Src, Line)). 2467 2468assert_foreign(Src, Goal) :- 2469 foreign(Goal, Src, _), 2470 !. 2471assert_foreign(Src, Goal) :- 2472 generalise(Goal, Term), 2473 current_source_line(Line), 2474 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2486assert_import(_, [], _, _, _) :- !. 2487assert_import(Src, [H|T], Export, From, Reexport) :- 2488 !, 2489 assert_import(Src, H, Export, From, Reexport), 2490 assert_import(Src, T, Export, From, Reexport). 2491assert_import(Src, except(Except), Export, From, Reexport) :- 2492 !, 2493 is_list(Export), 2494 !, 2495 except(Except, Export, Import), 2496 assert_import(Src, Import, _All, From, Reexport). 2497assert_import(Src, Import as Name, Export, From, Reexport) :- 2498 !, 2499 pi_to_head(Import, Term0), 2500 rename_goal(Term0, Name, Term), 2501 ( in_export_list(Term0, Export) 2502 -> assert(imported(Term, Src, From)), 2503 assert_reexport(Reexport, Src, Term) 2504 ; current_source_line(Line), 2505 assert_called(Src, '<directive>'(Line), Term0, Line) 2506 ). 2507assert_import(Src, Import, Export, From, Reexport) :- 2508 pi_to_head(Import, Term), 2509 !, 2510 ( in_export_list(Term, Export) 2511 -> assert(imported(Term, Src, From)), 2512 assert_reexport(Reexport, Src, Term) 2513 ; current_source_line(Line), 2514 assert_called(Src, '<directive>'(Line), Term, Line) 2515 ). 2516assert_import(Src, op(P,T,N), _, _, _) :- 2517 xref_push_op(Src, P,T,N). 2518 2519in_export_list(_Head, Export) :- 2520 var(Export), 2521 !. 2522in_export_list(Head, Export) :- 2523 member(PI, Export), 2524 pi_to_head(PI, Head). 2525 2526assert_reexport(false, _, _) :- !. 2527assert_reexport(true, Src, Term) :- 2528 assert(exported(Term, Src)).
2534process_import(M:PI, Src) :- 2535 pi_to_head(PI, Head), 2536 !, 2537 ( atom(M), 2538 current_module(M), 2539 module_property(M, file(From)) 2540 -> true 2541 ; From = '<unknown>' 2542 ), 2543 assert(imported(Head, Src, From)). 2544process_import(_, _).
2553assert_xmodule_callable([], _, _, _). 2554assert_xmodule_callable([PI|T], M, Src, From) :- 2555 ( pi_to_head(M:PI, Head) 2556 -> assert(imported(Head, Src, From)) 2557 ; true 2558 ), 2559 assert_xmodule_callable(T, M, Src, From).
2566assert_op(Src, op(P,T,M:N)) :-
2567 ( '$current_source_module'(M)
2568 -> Name = N
2569 ; Name = M:N
2570 ),
2571 ( xop(Src, op(P,T,Name))
2572 -> true
2573 ; assert(xop(Src, op(P,T,Name)))
2574 ).2581assert_module(Src, Module) :- 2582 xmodule(Module, Src), 2583 !. 2584assert_module(Src, Module) :- 2585 '$set_source_module'(Module), 2586 assert(xmodule(Module, Src)), 2587 ( module_property(Module, class(system)) 2588 -> retractall(xoption(Src, register_called(_))), 2589 assert(xoption(Src, register_called(all))) 2590 ; true 2591 ). 2592 2593assert_module_export(_, []) :- !. 2594assert_module_export(Src, [H|T]) :- 2595 !, 2596 assert_module_export(Src, H), 2597 assert_module_export(Src, T). 2598assert_module_export(Src, PI) :- 2599 pi_to_head(PI, Term), 2600 !, 2601 assert(exported(Term, Src)). 2602assert_module_export(Src, op(P, A, N)) :- 2603 xref_push_op(Src, P, A, N).
2609assert_module3([], _) :- !. 2610assert_module3([H|T], Src) :- 2611 !, 2612 assert_module3(H, Src), 2613 assert_module3(T, Src). 2614assert_module3(Option, Src) :- 2615 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2624process_predicates(Closure, Preds, Src) :- 2625 is_list(Preds), 2626 !, 2627 process_predicate_list(Preds, Closure, Src). 2628process_predicates(Closure, as(Preds, _Options), Src) :- 2629 !, 2630 process_predicates(Closure, Preds, Src). 2631process_predicates(Closure, Preds, Src) :- 2632 process_predicate_comma(Preds, Closure, Src). 2633 2634process_predicate_list([], _, _). 2635process_predicate_list([H|T], Closure, Src) :- 2636 ( nonvar(H) 2637 -> call(Closure, H, Src) 2638 ; true 2639 ), 2640 process_predicate_list(T, Closure, Src). 2641 2642process_predicate_comma(Var, _, _) :- 2643 var(Var), 2644 !. 2645process_predicate_comma(M:(A,B), Closure, Src) :- 2646 !, 2647 process_predicate_comma(M:A, Closure, Src), 2648 process_predicate_comma(M:B, Closure, Src). 2649process_predicate_comma((A,B), Closure, Src) :- 2650 !, 2651 process_predicate_comma(A, Closure, Src), 2652 process_predicate_comma(B, Closure, Src). 2653process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2654 !, 2655 process_predicate_comma(Spec, Closure, Src). 2656process_predicate_comma(A, Closure, Src) :- 2657 call(Closure, A, Src). 2658 2659 2660assert_dynamic(PI, Src) :- 2661 pi_to_head(PI, Term), 2662 ( thread_local(Term, Src, _) % dynamic after thread_local has 2663 -> true % no effect 2664 ; current_source_line(Line), 2665 assert(dynamic(Term, Src, Line)) 2666 ). 2667 2668assert_thread_local(PI, Src) :- 2669 pi_to_head(PI, Term), 2670 current_source_line(Line), 2671 assert(thread_local(Term, Src, Line)). 2672 2673assert_multifile(PI, Src) :- % :- multifile(Spec) 2674 pi_to_head(PI, Term), 2675 current_source_line(Line), 2676 assert(multifile(Term, Src, Line)). 2677 2678assert_public(PI, Src) :- % :- public(Spec) 2679 pi_to_head(PI, Term), 2680 current_source_line(Line), 2681 assert_called(Src, '<public>'(Line), Term, Line), 2682 assert(public(Term, Src, Line)). 2683 2684assert_export(PI, Src) :- % :- export(Spec) 2685 pi_to_head(PI, Term), 2686 !, 2687 assert(exported(Term, Src)).
2694pi_to_head(Var, _) :- 2695 var(Var), !, fail. 2696pi_to_head(M:PI, M:Term) :- 2697 !, 2698 pi_to_head(PI, Term). 2699pi_to_head(Name/Arity, Term) :- 2700 functor(Term, Name, Arity). 2701pi_to_head(Name//DCGArity, Term) :- 2702 Arity is DCGArity+2, 2703 functor(Term, Name, Arity). 2704 2705 2706assert_used_class(Src, Name) :- 2707 used_class(Name, Src), 2708 !. 2709assert_used_class(Src, Name) :- 2710 assert(used_class(Name, Src)). 2711 2712assert_defined_class(Src, Name, _Meta, _Super, _) :- 2713 defined_class(Name, _, _, Src, _), 2714 !. 2715assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2716assert_defined_class(Src, Name, Meta, Super, Summary) :- 2717 current_source_line(Line), 2718 ( Summary == @(default) 2719 -> Atom = '' 2720 ; is_list(Summary) 2721 -> atom_codes(Atom, Summary) 2722 ; string(Summary) 2723 -> atom_concat(Summary, '', Atom) 2724 ), 2725 assert(defined_class(Name, Super, Atom, Src, Line)), 2726 ( Meta = @(_) 2727 -> true 2728 ; assert_used_class(Src, Meta) 2729 ), 2730 assert_used_class(Src, Super). 2731 2732assert_defined_class(Src, Name, imported_from(_File)) :- 2733 defined_class(Name, _, _, Src, _), 2734 !. 2735assert_defined_class(Src, Name, imported_from(File)) :- 2736 assert(defined_class(Name, _, '', Src, file(File))). 2737 2738 2739 /******************************** 2740 * UTILITIES * 2741 ********************************/
2747generalise(Var, Var) :- 2748 var(Var), 2749 !. % error? 2750generalise(pce_principal:send_implementation(Id, _, _), 2751 pce_principal:send_implementation(Id, _, _)) :- 2752 atom(Id), 2753 !. 2754generalise(pce_principal:get_implementation(Id, _, _, _), 2755 pce_principal:get_implementation(Id, _, _, _)) :- 2756 atom(Id), 2757 !. 2758generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2759generalise(Module:Goal0, Module:Goal) :- 2760 atom(Module), 2761 !, 2762 generalise(Goal0, Goal). 2763generalise(Term0, Term) :- 2764 callable(Term0), 2765 generalise_term(Term0, Term). 2766 2767 2768 /******************************* 2769 * SOURCE MANAGEMENT * 2770 *******************************/ 2771 2772/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2773This section of the file contains hookable predicates to reason about 2774sources. The built-in code here can only deal with files. The XPCE 2775library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2776can do cross-referencing on PceEmacs edit buffers. Other examples for 2777hooking can be databases, (HTTP) URIs, etc. 2778- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2779 2780:- multifile 2781 prolog:xref_source_directory/2, % +Source, -Dir 2782 prolog:xref_source_file/3. % +Spec, -Path, +Options
2790xref_source_file(Plain, File, Source) :- 2791 xref_source_file(Plain, File, Source, []). 2792 2793xref_source_file(QSpec, File, Source, Options) :- 2794 nonvar(QSpec), QSpec = _:Spec, 2795 !, 2796 must_be(acyclic, Spec), 2797 xref_source_file(Spec, File, Source, Options). 2798xref_source_file(Spec, File, Source, Options) :- 2799 nonvar(Spec), 2800 prolog:xref_source_file(Spec, File, 2801 [ relative_to(Source) 2802 | Options 2803 ]), 2804 !. 2805xref_source_file(Plain, File, Source, Options) :- 2806 atom(Plain), 2807 \+ is_absolute_file_name(Plain), 2808 ( prolog:xref_source_directory(Source, Dir) 2809 -> true 2810 ; atom(Source), 2811 file_directory_name(Source, Dir) 2812 ), 2813 atomic_list_concat([Dir, /, Plain], Spec0), 2814 absolute_file_name(Spec0, Spec), 2815 do_xref_source_file(Spec, File, Options), 2816 !. 2817xref_source_file(Spec, File, Source, Options) :- 2818 do_xref_source_file(Spec, File, 2819 [ relative_to(Source) 2820 | Options 2821 ]), 2822 !. 2823xref_source_file(_, _, _, Options) :- 2824 option(silent(true), Options), 2825 !, 2826 fail. 2827xref_source_file(Spec, _, Src, _Options) :- 2828 verbose(Src), 2829 print_message(warning, error(existence_error(file, Spec), _)), 2830 fail. 2831 2832do_xref_source_file(Spec, File, Options) :- 2833 nonvar(Spec), 2834 option(file_type(Type), Options, prolog), 2835 absolute_file_name(Spec, File, 2836 [ file_type(Type), 2837 access(read), 2838 file_errors(fail) 2839 ]), 2840 !.
2846canonical_source(Source, Src) :-
2847 ( ground(Source)
2848 -> prolog_canonical_source(Source, Src)
2849 ; Source = Src
2850 ).name()
goals.2857goal_name_arity(Goal, Name, Arity) :- 2858 ( compound(Goal) 2859 -> compound_name_arity(Goal, Name, Arity) 2860 ; atom(Goal) 2861 -> Name = Goal, Arity = 0 2862 ). 2863 2864generalise_term(Specific, General) :- 2865 ( compound(Specific) 2866 -> compound_name_arity(Specific, Name, Arity), 2867 compound_name_arity(General, Name, Arity) 2868 ; General = Specific 2869 ). 2870 2871functor_name(Term, Name) :- 2872 ( compound(Term) 2873 -> compound_name_arity(Term, Name, _) 2874 ; atom(Term) 2875 -> Name = Term 2876 ). 2877 2878rename_goal(Goal0, Name, Goal) :- 2879 ( compound(Goal0) 2880 -> compound_name_arity(Goal0, _, Arity), 2881 compound_name_arity(Goal, Name, Arity) 2882 ; Goal = Name 2883 )
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.