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]. 1199 1200apply_pred(call). % built-in 1201apply_pred(maplist). % library(apply_macros) 1202 1203xref_meta((A, B), [A, B]). 1204xref_meta((A; B), [A, B]). 1205xref_meta((A| B), [A, B]). 1206xref_meta((A -> B), [A, B]). 1207xref_meta((A *-> B), [A, B]). 1208xref_meta(findall(_V,G,_L), [G]). 1209xref_meta(findall(_V,G,_L,_T), [G]). 1210xref_meta(findnsols(_N,_V,G,_L), [G]). 1211xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1212xref_meta(setof(_V, EG, _L), [G]) :- 1213 setof_goal(EG, G). 1214xref_meta(bagof(_V, EG, _L), [G]) :- 1215 setof_goal(EG, G). 1216xref_meta(forall(A, B), [A, B]). 1217xref_meta(maplist(G,_), [G+1]). 1218xref_meta(maplist(G,_,_), [G+2]). 1219xref_meta(maplist(G,_,_,_), [G+3]). 1220xref_meta(maplist(G,_,_,_,_), [G+4]). 1221xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1222xref_meta(map_assoc(G, _), [G+1]). 1223xref_meta(map_assoc(G, _, _), [G+2]). 1224xref_meta(checklist(G, _L), [G+1]). 1225xref_meta(sublist(G, _, _), [G+1]). 1226xref_meta(include(G, _, _), [G+1]). 1227xref_meta(exclude(G, _, _), [G+1]). 1228xref_meta(partition(G, _, _, _, _), [G+2]). 1229xref_meta(partition(G, _, _, _),[G+1]). 1230xref_meta(call(G), [G]). 1231xref_meta(call(G, _), [G+1]). 1232xref_meta(call(G, _, _), [G+2]). 1233xref_meta(call(G, _, _, _), [G+3]). 1234xref_meta(call(G, _, _, _, _), [G+4]). 1235xref_meta(not(G), [G]). 1236xref_meta(notrace(G), [G]). 1237xref_meta(\+(G), [G]). 1238xref_meta(ignore(G), [G]). 1239xref_meta(once(G), [G]). 1240xref_meta(initialization(G), [G]). 1241xref_meta(initialization(G,_), [G]). 1242xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1243xref_meta(clause(G, _), [G]). 1244xref_meta(clause(G, _, _), [G]). 1245xref_meta(phrase(G, _A), [//(G)]). 1246xref_meta(phrase(G, _A, _R), [//(G)]). 1247xref_meta(call_dcg(G, _A, _R), [//(G)]). 1248xref_meta(phrase_from_file(G,_),[//(G)]). 1249xref_meta(catch(A, _, B), [A, B]). 1250xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1251xref_meta(thread_create(A,_,_), [A]). 1252xref_meta(thread_create(A,_), [A]). 1253xref_meta(thread_signal(_,A), [A]). 1254xref_meta(thread_idle(A,_), [A]). 1255xref_meta(thread_at_exit(A), [A]). 1256xref_meta(thread_initialization(A), [A]). 1257xref_meta(engine_create(_,A,_), [A]). 1258xref_meta(engine_create(_,A,_,_), [A]). 1259xref_meta(predsort(A,_,_), [A+3]). 1260xref_meta(call_cleanup(A, B), [A, B]). 1261xref_meta(call_cleanup(A, _, B),[A, B]). 1262xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1263xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1264xref_meta(call_residue_vars(A,_), [A]). 1265xref_meta(with_mutex(_,A), [A]). 1266xref_meta(assume(G), [G]). % library(debug) 1267xref_meta(assertion(G), [G]). % library(debug) 1268xref_meta(freeze(_, G), [G]). 1269xref_meta(when(C, A), [C, A]). 1270xref_meta(time(G), [G]). % development system 1271xref_meta(profile(G), [G]). 1272xref_meta(at_halt(G), [G]). 1273xref_meta(call_with_time_limit(_, G), [G]). 1274xref_meta(call_with_depth_limit(G, _, _), [G]). 1275xref_meta(call_with_inference_limit(G, _, _), [G]). 1276xref_meta(alarm(_, G, _), [G]). 1277xref_meta(alarm(_, G, _, _), [G]). 1278xref_meta('$add_directive_wic'(G), [G]). 1279xref_meta(with_output_to(_, G), [G]). 1280xref_meta(if(G), [G]). 1281xref_meta(elif(G), [G]). 1282xref_meta(meta_options(G,_,_), [G+1]). 1283xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1284xref_meta(distinct(G), [G]). % library(solution_sequences) 1285xref_meta(distinct(_, G), [G]). 1286xref_meta(order_by(_, G), [G]). 1287xref_meta(limit(_, G), [G]). 1288xref_meta(offset(_, G), [G]). 1289xref_meta(reset(G,_,_), [G]). 1290xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1291xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1292xref_meta(tnot(G), [G]). 1293xref_meta(not_exists(G), [G]). 1294 1295 % XPCE meta-predicates 1296xref_meta(pce_global(_, new(_)), _) :- !, fail. 1297xref_meta(pce_global(_, B), [B+1]). 1298xref_meta(ifmaintainer(G), [G]). % used in manual 1299xref_meta(listen(_, G), [G]). % library(broadcast) 1300xref_meta(listen(_, _, G), [G]). 1301xref_meta(in_pce_thread(G), [G]). 1302 1303xref_meta(G, Meta) :- % call user extensions 1304 prolog:meta_goal(G, Meta). 1305xref_meta(G, Meta) :- % Generated from :- meta_predicate 1306 meta_goal(G, Meta). 1307 1308setof_goal(EG, G) :- 1309 var(EG), !, G = EG. 1310setof_goal(_^EG, G) :- 1311 !, 1312 setof_goal(EG, G). 1313setof_goal(G, G). 1314 1315event_xargs(abort, 0). 1316event_xargs(erase, 1). 1317event_xargs(break, 3). 1318event_xargs(frame_finished, 1). 1319event_xargs(thread_exit, 1). 1320event_xargs(this_thread_exit, 0). 1321event_xargs(PI, 2) :- pi_to_head(PI, _).
1327head_of(Var, _) :- 1328 var(Var), !, fail. 1329head_of((Head :- _), Head). 1330head_of(Head, Head).
1338xref_hook(Hook) :- 1339 prolog:hook(Hook). 1340xref_hook(Hook) :- 1341 hook(Hook). 1342 1343 1344hook(attr_portray_hook(_,_)). 1345hook(attr_unify_hook(_,_)). 1346hook(attribute_goals(_,_,_)). 1347hook(goal_expansion(_,_)). 1348hook(term_expansion(_,_)). 1349hook(resource(_,_,_)). 1350hook('$pred_option'(_,_,_,_)). 1351 1352hook(emacs_prolog_colours:goal_classification(_,_)). 1353hook(emacs_prolog_colours:term_colours(_,_)). 1354hook(emacs_prolog_colours:goal_colours(_,_)). 1355hook(emacs_prolog_colours:style(_,_)). 1356hook(emacs_prolog_colours:identify(_,_)). 1357hook(pce_principal:pce_class(_,_,_,_,_,_)). 1358hook(pce_principal:send_implementation(_,_,_)). 1359hook(pce_principal:get_implementation(_,_,_,_)). 1360hook(pce_principal:pce_lazy_get_method(_,_,_)). 1361hook(pce_principal:pce_lazy_send_method(_,_,_)). 1362hook(pce_principal:pce_uses_template(_,_)). 1363hook(prolog:locate_clauses(_,_)). 1364hook(prolog:message(_,_,_)). 1365hook(prolog:error_message(_,_,_)). 1366hook(prolog:message_location(_,_,_)). 1367hook(prolog:message_context(_,_,_)). 1368hook(prolog:message_line_element(_,_)). 1369hook(prolog:debug_control_hook(_)). 1370hook(prolog:help_hook(_)). 1371hook(prolog:show_profile_hook(_,_)). 1372hook(prolog:general_exception(_,_)). 1373hook(prolog:predicate_summary(_,_)). 1374hook(prolog:residual_goals(_,_)). 1375hook(prolog_edit:load). 1376hook(prolog_edit:locate(_,_,_)). 1377hook(shlib:unload_all_foreign_libraries). 1378hook(system:'$foreign_registered'(_, _)). 1379hook(predicate_options:option_decl(_,_,_)). 1380hook(user:exception(_,_,_)). 1381hook(user:file_search_path(_,_)). 1382hook(user:library_directory(_)). 1383hook(user:message_hook(_,_,_)). 1384hook(user:portray(_)). 1385hook(user:prolog_clause_name(_,_)). 1386hook(user:prolog_list_goal(_)). 1387hook(user:prolog_predicate_name(_,_)). 1388hook(user:prolog_trace_interception(_,_,_,_)). 1389hook(user:prolog_exception_hook(_,_,_,_)). 1390hook(sandbox:safe_primitive(_)). 1391hook(sandbox:safe_meta_predicate(_)). 1392hook(sandbox:safe_meta(_,_)). 1393hook(sandbox:safe_global_variable(_)). 1394hook(sandbox:safe_directive(_)).
1401arith_callable(Var, _) :- 1402 var(Var), !, fail. 1403arith_callable(Module:Spec, Module:Goal) :- 1404 !, 1405 arith_callable(Spec, Goal). 1406arith_callable(Name/Arity, Goal) :- 1407 PredArity is Arity + 1, 1408 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1419process_body(Body, Origin, Src) :-
1420 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1421 true).true if there was a
partial evalation inside Goal that has bound variables.1428process_goal(Var, _, _, _) :- 1429 var(Var), 1430 !. 1431process_goal(Goal, Origin, Src, P) :- 1432 Goal = (_,_), % problems 1433 !, 1434 phrase(conjunction(Goal), Goals), 1435 process_conjunction(Goals, Origin, Src, P). 1436process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1437 Goal = (_;_), % problems 1438 !, 1439 phrase(disjunction(Goal), Goals), 1440 forall(member(G, Goals), 1441 process_body(G, Origin, Src)). 1442process_goal(Goal, Origin, Src, P) :- 1443 ( ( xmodule(M, Src) 1444 -> true 1445 ; M = user 1446 ), 1447 ( predicate_property(M:Goal, imported_from(IM)) 1448 -> true 1449 ; IM = M 1450 ), 1451 prolog:called_by(Goal, IM, M, Called) 1452 ; prolog:called_by(Goal, Called) 1453 ), 1454 !, 1455 must_be(list, Called), 1456 current_source_line(Here), 1457 assert_called(Src, Origin, Goal, Here), 1458 process_called_list(Called, Origin, Src, P). 1459process_goal(Goal, Origin, Src, _) :- 1460 process_xpce_goal(Goal, Origin, Src), 1461 !. 1462process_goal(load_foreign_library(File), _Origin, Src, _) :- 1463 process_foreign(File, Src). 1464process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1465 process_foreign(File, Src). 1466process_goal(use_foreign_library(File), _Origin, Src, _) :- 1467 process_foreign(File, Src). 1468process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1469 process_foreign(File, Src). 1470process_goal(Goal, Origin, Src, P) :- 1471 xref_meta_src(Goal, Metas, Src), 1472 !, 1473 current_source_line(Here), 1474 assert_called(Src, Origin, Goal, Here), 1475 process_called_list(Metas, Origin, Src, P). 1476process_goal(Goal, Origin, Src, _) :- 1477 asserting_goal(Goal, Rule), 1478 !, 1479 current_source_line(Here), 1480 assert_called(Src, Origin, Goal, Here), 1481 process_assert(Rule, Origin, Src). 1482process_goal(Goal, Origin, Src, P) :- 1483 partial_evaluate(Goal, P), 1484 current_source_line(Here), 1485 assert_called(Src, Origin, Goal, Here). 1486 1487disjunction(Var) --> {var(Var), !}, [Var]. 1488disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1489disjunction(G) --> [G]. 1490 1491conjunction(Var) --> {var(Var), !}, [Var]. 1492conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1493conjunction(G) --> [G]. 1494 (RVars, T) :- 1496 term_variables(T, TVars0), 1497 sort(TVars0, TVars), 1498 ord_intersect(RVars, TVars). 1499 1500process_conjunction([], _, _, _). 1501process_conjunction([Disj|Rest], Origin, Src, P) :- 1502 nonvar(Disj), 1503 Disj = (_;_), 1504 Rest \== [], 1505 !, 1506 phrase(disjunction(Disj), Goals), 1507 term_variables(Rest, RVars0), 1508 sort(RVars0, RVars), 1509 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1510 forall(member(G, NonSHaring), 1511 process_body(G, Origin, Src)), 1512 ( Sharing == [] 1513 -> true 1514 ; maplist(term_variables, Sharing, GVars0), 1515 append(GVars0, GVars1), 1516 sort(GVars1, GVars), 1517 ord_intersection(GVars, RVars, SVars), 1518 VT =.. [v|SVars], 1519 findall(VT, 1520 ( member(G, Sharing), 1521 process_goal(G, Origin, Src, PS), 1522 PS == true 1523 ), 1524 Alts0), 1525 ( Alts0 == [] 1526 -> true 1527 ; ( true 1528 ; P = true, 1529 sort(Alts0, Alts1), 1530 variants(Alts1, 10, Alts), 1531 member(VT, Alts) 1532 ) 1533 ) 1534 ), 1535 process_conjunction(Rest, Origin, Src, P). 1536process_conjunction([H|T], Origin, Src, P) :- 1537 process_goal(H, Origin, Src, P), 1538 process_conjunction(T, Origin, Src, P). 1539 1540 1541process_called_list([], _, _, _). 1542process_called_list([H|T], Origin, Src, P) :- 1543 process_meta(H, Origin, Src, P), 1544 process_called_list(T, Origin, Src, P). 1545 1546process_meta(A+N, Origin, Src, P) :- 1547 !, 1548 ( extend(A, N, AX) 1549 -> process_goal(AX, Origin, Src, P) 1550 ; true 1551 ). 1552process_meta(//(A), Origin, Src, P) :- 1553 !, 1554 process_dcg_goal(A, Origin, Src, P). 1555process_meta(G, Origin, Src, P) :- 1556 process_goal(G, Origin, Src, P).
1563process_dcg_goal(Var, _, _, _) :- 1564 var(Var), 1565 !. 1566process_dcg_goal((A,B), Origin, Src, P) :- 1567 !, 1568 process_dcg_goal(A, Origin, Src, P), 1569 process_dcg_goal(B, Origin, Src, P). 1570process_dcg_goal((A;B), Origin, Src, P) :- 1571 !, 1572 process_dcg_goal(A, Origin, Src, P), 1573 process_dcg_goal(B, Origin, Src, P). 1574process_dcg_goal((A|B), Origin, Src, P) :- 1575 !, 1576 process_dcg_goal(A, Origin, Src, P), 1577 process_dcg_goal(B, Origin, Src, P). 1578process_dcg_goal((A->B), Origin, Src, P) :- 1579 !, 1580 process_dcg_goal(A, Origin, Src, P), 1581 process_dcg_goal(B, Origin, Src, P). 1582process_dcg_goal((A*->B), Origin, Src, P) :- 1583 !, 1584 process_dcg_goal(A, Origin, Src, P), 1585 process_dcg_goal(B, Origin, Src, P). 1586process_dcg_goal({Goal}, Origin, Src, P) :- 1587 !, 1588 process_goal(Goal, Origin, Src, P). 1589process_dcg_goal(List, _Origin, _Src, _) :- 1590 is_list(List), 1591 !. % terminal 1592process_dcg_goal(List, _Origin, _Src, _) :- 1593 string(List), 1594 !. % terminal 1595process_dcg_goal(Callable, Origin, Src, P) :- 1596 extend(Callable, 2, Goal), 1597 !, 1598 process_goal(Goal, Origin, Src, P). 1599process_dcg_goal(_, _, _, _). 1600 1601 1602extend(Var, _, _) :- 1603 var(Var), !, fail. 1604extend(M:G, N, M:GX) :- 1605 !, 1606 callable(G), 1607 extend(G, N, GX). 1608extend(G, N, GX) :- 1609 ( compound(G) 1610 -> compound_name_arguments(G, Name, Args), 1611 length(Rest, N), 1612 append(Args, Rest, NArgs), 1613 compound_name_arguments(GX, Name, NArgs) 1614 ; atom(G) 1615 -> length(NArgs, N), 1616 compound_name_arguments(GX, G, NArgs) 1617 ). 1618 1619asserting_goal(assert(Rule), Rule). 1620asserting_goal(asserta(Rule), Rule). 1621asserting_goal(assertz(Rule), Rule). 1622asserting_goal(assert(Rule,_), Rule). 1623asserting_goal(asserta(Rule,_), Rule). 1624asserting_goal(assertz(Rule,_), Rule). 1625 1626process_assert(0, _, _) :- !. % catch variables 1627process_assert((_:-Body), Origin, Src) :- 1628 !, 1629 process_body(Body, Origin, Src). 1630process_assert(_, _, _).
1634variants([], _, []). 1635variants([H|T], Max, List) :- 1636 variants(T, H, Max, List). 1637 1638variants([], H, _, [H]). 1639variants(_, _, 0, []) :- !. 1640variants([H|T], V, Max, List) :- 1641 ( H =@= V 1642 -> variants(T, V, Max, List) 1643 ; List = [V|List2], 1644 Max1 is Max-1, 1645 variants(T, H, Max1, List2) 1646 ).
T = hello(X),
findall(T, T, List),
1660partial_evaluate(Goal, P) :- 1661 eval(Goal), 1662 !, 1663 P = true. 1664partial_evaluate(_, _). 1665 1666eval(X = Y) :- 1667 unify_with_occurs_check(X, Y). 1668 1669 1670 /******************************* 1671 * XPCE STUFF * 1672 *******************************/ 1673 1674pce_goal(new(_,_), new(-, new)). 1675pce_goal(send(_,_), send(arg, msg)). 1676pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1677pce_goal(get(_,_,_), get(arg, msg, -)). 1678pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1679pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1680pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1681 1682process_xpce_goal(G, Origin, Src) :- 1683 pce_goal(G, Process), 1684 !, 1685 current_source_line(Here), 1686 assert_called(Src, Origin, G, Here), 1687 ( arg(I, Process, How), 1688 arg(I, G, Term), 1689 process_xpce_arg(How, Term, Origin, Src), 1690 fail 1691 ; true 1692 ). 1693 1694process_xpce_arg(new, Term, Origin, Src) :- 1695 callable(Term), 1696 process_new(Term, Origin, Src). 1697process_xpce_arg(arg, Term, Origin, Src) :- 1698 compound(Term), 1699 process_new(Term, Origin, Src). 1700process_xpce_arg(msg, Term, Origin, Src) :- 1701 compound(Term), 1702 ( arg(_, Term, Arg), 1703 process_xpce_arg(arg, Arg, Origin, Src), 1704 fail 1705 ; true 1706 ). 1707 1708process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1709process_new(Term, Origin, Src) :- 1710 assert_new(Src, Origin, Term), 1711 ( compound(Term), 1712 arg(_, Term, Arg), 1713 process_xpce_arg(arg, Arg, Origin, Src), 1714 fail 1715 ; true 1716 ). 1717 1718assert_new(_, _, Term) :- 1719 \+ callable(Term), 1720 !. 1721assert_new(Src, Origin, Control) :- 1722 functor_name(Control, Class), 1723 pce_control_class(Class), 1724 !, 1725 forall(arg(_, Control, Arg), 1726 assert_new(Src, Origin, Arg)). 1727assert_new(Src, Origin, Term) :- 1728 compound(Term), 1729 arg(1, Term, Prolog), 1730 Prolog == @(prolog), 1731 ( Term =.. [message, _, Selector | T], 1732 atom(Selector) 1733 -> Called =.. [Selector|T], 1734 process_body(Called, Origin, Src) 1735 ; Term =.. [?, _, Selector | T], 1736 atom(Selector) 1737 -> append(T, [_R], T2), 1738 Called =.. [Selector|T2], 1739 process_body(Called, Origin, Src) 1740 ), 1741 fail. 1742assert_new(_, _, @(_)) :- !. 1743assert_new(Src, _, Term) :- 1744 functor_name(Term, Name), 1745 assert_used_class(Src, Name). 1746 1747 1748pce_control_class(and). 1749pce_control_class(or). 1750pce_control_class(if). 1751pce_control_class(not). 1752 1753 1754 /******************************** 1755 * INCLUDED MODULES * 1756 ********************************/
1760process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1761process_use_module([], _, _) :- !. 1762process_use_module([H|T], Src, Reexport) :- 1763 !, 1764 process_use_module(H, Src, Reexport), 1765 process_use_module(T, Src, Reexport). 1766process_use_module(library(pce), Src, Reexport) :- % bit special 1767 !, 1768 xref_public_list(library(pce), Path, Exports, Src), 1769 forall(member(Import, Exports), 1770 process_pce_import(Import, Src, Path, Reexport)). 1771process_use_module(File, Src, Reexport) :- 1772 load_module_if_needed(File), 1773 ( xoption(Src, silent(Silent)) 1774 -> Extra = [silent(Silent)] 1775 ; Extra = [silent(true)] 1776 ), 1777 ( xref_public_list(File, Src, 1778 [ path(Path), 1779 module(M), 1780 exports(Exports), 1781 public(Public), 1782 meta(Meta) 1783 | Extra 1784 ]) 1785 -> assert(uses_file(File, Src, Path)), 1786 assert_import(Src, Exports, _, Path, Reexport), 1787 assert_xmodule_callable(Exports, M, Src, Path), 1788 assert_xmodule_callable(Public, M, Src, Path), 1789 maplist(process_meta_head(Src), Meta), 1790 ( File = library(chr) % hacky 1791 -> assert(mode(chr, Src)) 1792 ; true 1793 ) 1794 ; assert(uses_file(File, Src, '<not_found>')) 1795 ). 1796 1797process_pce_import(Name/Arity, Src, Path, Reexport) :- 1798 atom(Name), 1799 integer(Arity), 1800 !, 1801 functor(Term, Name, Arity), 1802 ( \+ system_predicate(Term), 1803 \+ Term = pce_error(_) % hack!? 1804 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1805 ; true 1806 ). 1807process_pce_import(op(P,T,N), Src, _, _) :- 1808 xref_push_op(Src, P, T, N).
1814process_use_module2(File, Import, Src, Reexport) :-
1815 load_module_if_needed(File),
1816 ( xref_source_file(File, Path, Src)
1817 -> assert(uses_file(File, Src, Path)),
1818 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1819 -> assert_import(Src, Import, Export, Path, Reexport),
1820 forall(( member(Head, Meta),
1821 imported(Head, _, Path)
1822 ),
1823 process_meta_head(Src, Head))
1824 ; true
1825 )
1826 ; assert(uses_file(File, Src, '<not_found>'))
1827 ).1836load_module_if_needed(File) :- 1837 prolog:no_autoload_module(File), 1838 !, 1839 use_module(File, []). 1840load_module_if_needed(_). 1841 1842prologno_autoload_module(library(apply_macros)). 1843prologno_autoload_module(library(arithmetic)). 1844prologno_autoload_module(library(record)). 1845prologno_autoload_module(library(persistency)). 1846prologno_autoload_module(library(pldoc)). 1847prologno_autoload_module(library(settings)).
1852process_requires(Import, Src) :- 1853 is_list(Import), 1854 !, 1855 require_list(Import, Src). 1856process_requires(Var, _Src) :- 1857 var(Var), 1858 !. 1859process_requires((A,B), Src) :- 1860 !, 1861 process_requires(A, Src), 1862 process_requires(B, Src). 1863process_requires(PI, Src) :- 1864 requires(PI, Src). 1865 1866require_list([], _). 1867require_list([H|T], Src) :- 1868 requires(H, Src), 1869 require_list(T, Src). 1870 1871requires(PI, _Src) :- 1872 '$pi_head'(PI, Head), 1873 '$get_predicate_attribute'(system:Head, defined, 1), 1874 !. 1875requires(PI, Src) :- 1876 '$pi_head'(PI, Head), 1877 '$pi_head'(Name/Arity, Head), 1878 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 1879 ( imported(Head, Src, Library) 1880 -> true 1881 ; assertz(imported(Head, Src, Library)) 1882 ).
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.
1913xref_public_list(File, Src, Options) :-
1914 option(path(Path), Options, _),
1915 option(module(Module), Options, _),
1916 option(exports(Exports), Options, _),
1917 option(public(Public), Options, _),
1918 option(meta(Meta), Options, _),
1919 xref_source_file(File, Path, Src, Options),
1920 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
1942xref_public_list(File, Path, Export, Src) :- 1943 xref_source_file(File, Path, Src), 1944 public_list(Path, _, _, Export, _, []). 1945xref_public_list(File, Path, Module, Export, Meta, Src) :- 1946 xref_source_file(File, Path, Src), 1947 public_list(Path, Module, Meta, Export, _, []). 1948xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 1949 xref_source_file(File, Path, Src), 1950 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.1960:- dynamic public_list_cache/6. 1961:- volatile public_list_cache/6. 1962 1963public_list(Path, Module, Meta, Export, Public, _Options) :- 1964 public_list_cache(Path, Modified, 1965 Module0, Meta0, Export0, Public0), 1966 time_file(Path, ModifiedNow), 1967 ( abs(Modified-ModifiedNow) < 0.0001 1968 -> !, 1969 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 1970 ; retractall(public_list_cache(Path, _, _, _, _, _)), 1971 fail 1972 ). 1973public_list(Path, Module, Meta, Export, Public, Options) :- 1974 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 1975 ( Error = error(_,_), 1976 catch(time_file(Path, Modified), Error, fail) 1977 -> asserta(public_list_cache(Path, Modified, 1978 Module0, Meta0, Export0, Public0)) 1979 ; true 1980 ), 1981 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 1982 1983public_list_nc(Path, Module, Meta, Export, Public, Options) :- 1984 in_temporary_module( 1985 TempModule, 1986 true, 1987 public_list_diff(TempModule, Path, Module, 1988 Meta, [], Export, [], Public, [], Options)). 1989 1990 1991public_list_diff(TempModule, 1992 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 1993 setup_call_cleanup( 1994 public_list_setup(TempModule, Path, In, State), 1995 phrase(read_directives(In, Options, [true]), Directives), 1996 public_list_cleanup(In, State)), 1997 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 1998 1999public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2000 prolog_open_source(Path, In), 2001 '$set_source_module'(OldM, TempModule), 2002 set_xref(OldXref). 2003 2004public_list_cleanup(In, state(OldM, OldXref)) :- 2005 '$set_source_module'(OldM), 2006 set_prolog_flag(xref, OldXref), 2007 prolog_close_source(In). 2008 2009 2010read_directives(In, Options, State) --> 2011 { repeat, 2012 catch(prolog_read_source_term(In, Term, Expanded, 2013 [ process_comment(true), 2014 syntax_errors(error) 2015 ]), 2016 E, report_syntax_error(E, -, Options)) 2017 -> nonvar(Term), 2018 Term = (:-_) 2019 }, 2020 !, 2021 terms(Expanded, State, State1), 2022 read_directives(In, Options, State1). 2023read_directives(_, _, _) --> []. 2024 2025terms(Var, State, State) --> { var(Var) }, !. 2026terms([H|T], State0, State) --> 2027 !, 2028 terms(H, State0, State1), 2029 terms(T, State1, State). 2030terms((:-if(Cond)), State0, [True|State0]) --> 2031 !, 2032 { eval_cond(Cond, True) }. 2033terms((:-elif(Cond)), [True0|State], [True|State]) --> 2034 !, 2035 { eval_cond(Cond, True1), 2036 elif(True0, True1, True) 2037 }. 2038terms((:-else), [True0|State], [True|State]) --> 2039 !, 2040 { negate(True0, True) }. 2041terms((:-endif), [_|State], State) --> !. 2042terms(H, State, State) --> 2043 ( {State = [true|_]} 2044 -> [H] 2045 ; [] 2046 ). 2047 2048eval_cond(Cond, true) :- 2049 catch(Cond, _, fail), 2050 !. 2051eval_cond(_, false). 2052 2053elif(true, _, else_false) :- !. 2054elif(false, true, true) :- !. 2055elif(True, _, True). 2056 2057negate(true, false). 2058negate(false, true). 2059negate(else_false, else_false). 2060 2061public_list([(:- module(Module, Export0))|Decls], Path, 2062 Module, Meta, MT, Export, Rest, Public, PT) :- 2063 !, 2064 append(Export0, Reexport, Export), 2065 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2066public_list([(:- encoding(_))|Decls], Path, 2067 Module, Meta, MT, Export, Rest, Public, PT) :- 2068 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2069 2070public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2071public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2072 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2073 !, 2074 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2075public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2076 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2077 2078public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2079 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2080public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2081 public_from_import(Import, Spec, Path, Reexport, Rest). 2082public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2083 phrase(meta_decls(Decl), Meta, MT). 2084public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2085 phrase(public_decls(Decl), Public, PT).
2091reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2092reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2093 !, 2094 xref_source_file(H, Path, Src), 2095 public_list(Path, _Module, Meta0, Export0, Public0, []), 2096 append(Meta0, MT1, Meta), 2097 append(Export0, ET1, Export), 2098 append(Public0, PT1, Public), 2099 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2100reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2101 xref_source_file(Spec, Path, Src), 2102 public_list(Path, _Module, Meta0, Export0, Public0, []), 2103 append(Meta0, MT, Meta), 2104 append(Export0, ET, Export), 2105 append(Public0, PT, Public). 2106 2107public_from_import(except(Map), Path, Src, Export, Rest) :- 2108 !, 2109 xref_public_list(Path, _, AllExports, Src), 2110 except(Map, AllExports, NewExports), 2111 append(NewExports, Rest, Export). 2112public_from_import(Import, _, _, Export, Rest) :- 2113 import_name_map(Import, Export, Rest).
2118except([], Exports, Exports). 2119except([PI0 as NewName|Map], Exports0, Exports) :- 2120 !, 2121 canonical_pi(PI0, PI), 2122 map_as(Exports0, PI, NewName, Exports1), 2123 except(Map, Exports1, Exports). 2124except([PI0|Map], Exports0, Exports) :- 2125 canonical_pi(PI0, PI), 2126 select(PI2, Exports0, Exports1), 2127 same_pi(PI, PI2), 2128 !, 2129 except(Map, Exports1, Exports). 2130 2131 2132map_as([PI|T], Repl, As, [PI2|T]) :- 2133 same_pi(Repl, PI), 2134 !, 2135 pi_as(PI, As, PI2). 2136map_as([H|T0], Repl, As, [H|T]) :- 2137 map_as(T0, Repl, As, T). 2138 2139pi_as(_/Arity, Name, Name/Arity). 2140pi_as(_//Arity, Name, Name//Arity). 2141 2142import_name_map([], L, L). 2143import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2144 !, 2145 import_name_map(T0, T, Tail). 2146import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2147 !, 2148 import_name_map(T0, T, Tail). 2149import_name_map([H|T0], [H|T], Tail) :- 2150 import_name_map(T0, T, Tail). 2151 2152canonical_pi(Name//Arity0, PI) :- 2153 integer(Arity0), 2154 !, 2155 PI = Name/Arity, 2156 Arity is Arity0 + 2. 2157canonical_pi(PI, PI). 2158 2159same_pi(Canonical, PI2) :- 2160 canonical_pi(PI2, Canonical). 2161 2162meta_decls(Var) --> 2163 { var(Var) }, 2164 !. 2165meta_decls((A,B)) --> 2166 !, 2167 meta_decls(A), 2168 meta_decls(B). 2169meta_decls(A) --> 2170 [A]. 2171 2172public_decls(Var) --> 2173 { var(Var) }, 2174 !. 2175public_decls((A,B)) --> 2176 !, 2177 public_decls(A), 2178 public_decls(B). 2179public_decls(A) --> 2180 [A]. 2181 2182 /******************************* 2183 * INCLUDE * 2184 *******************************/ 2185 2186process_include([], _) :- !. 2187process_include([H|T], Src) :- 2188 !, 2189 process_include(H, Src), 2190 process_include(T, Src). 2191process_include(File, Src) :- 2192 callable(File), 2193 !, 2194 ( once(xref_input(ParentSrc, _)), 2195 xref_source_file(File, Path, ParentSrc) 2196 -> ( ( uses_file(_, Src, Path) 2197 ; Path == Src 2198 ) 2199 -> true 2200 ; assert(uses_file(File, Src, Path)), 2201 ( xoption(Src, process_include(true)) 2202 -> findall(O, xoption(Src, O), Options), 2203 setup_call_cleanup( 2204 open_include_file(Path, In, Refs), 2205 collect(Src, Path, In, Options), 2206 close_include(In, Refs)) 2207 ; true 2208 ) 2209 ) 2210 ; assert(uses_file(File, Src, '<not_found>')) 2211 ). 2212process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2220open_include_file(Path, In, [Ref]) :- 2221 once(xref_input(_, Parent)), 2222 stream_property(Parent, encoding(Enc)), 2223 '$push_input_context'(xref_include), 2224 catch(( prolog:xref_open_source(Path, In) 2225 -> set_stream(In, encoding(Enc)) 2226 ; include_encoding(Enc, Options), 2227 open(Path, read, In, Options) 2228 ), E, 2229 ( '$pop_input_context', throw(E))), 2230 catch(( peek_char(In, #) % Deal with #! script 2231 -> skip(In, 10) 2232 ; true 2233 ), E, 2234 ( close_include(In, []), throw(E))), 2235 asserta(xref_input(Path, In), Ref). 2236 2237include_encoding(wchar_t, []) :- !. 2238include_encoding(Enc, [encoding(Enc)]). 2239 2240 2241close_include(In, Refs) :- 2242 maplist(erase, Refs), 2243 close(In, [force(true)]), 2244 '$pop_input_context'.
2250process_foreign(Spec, Src) :- 2251 ground(Spec), 2252 current_foreign_library(Spec, Defined), 2253 !, 2254 ( xmodule(Module, Src) 2255 -> true 2256 ; Module = user 2257 ), 2258 process_foreign_defined(Defined, Module, Src). 2259process_foreign(_, _). 2260 2261process_foreign_defined([], _, _). 2262process_foreign_defined([H|T], M, Src) :- 2263 ( H = M:Head 2264 -> assert_foreign(Src, Head) 2265 ; assert_foreign(Src, H) 2266 ), 2267 process_foreign_defined(T, M, Src). 2268 2269 2270 /******************************* 2271 * CHR SUPPORT * 2272 *******************************/ 2273 2274/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2275This part of the file supports CHR. Our choice is between making special 2276hooks to make CHR expansion work and then handle the (complex) expanded 2277code or process the CHR source directly. The latter looks simpler, 2278though I don't like the idea of adding support for libraries to this 2279module. A file is supposed to be a CHR file if it uses a 2280use_module(library(chr) or contains a :- constraint/1 directive. As an 2281extra bonus we get the source-locations right :-) 2282- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2283 2284process_chr(@(_Name, Rule), Src) :- 2285 mode(chr, Src), 2286 process_chr(Rule, Src). 2287process_chr(pragma(Rule, _Pragma), Src) :- 2288 mode(chr, Src), 2289 process_chr(Rule, Src). 2290process_chr(<=>(Head, Body), Src) :- 2291 mode(chr, Src), 2292 chr_head(Head, Src, H), 2293 chr_body(Body, H, Src). 2294process_chr(==>(Head, Body), Src) :- 2295 mode(chr, Src), 2296 chr_head(Head, H, Src), 2297 chr_body(Body, H, Src). 2298process_chr((:- chr_constraint(_)), Src) :- 2299 ( mode(chr, Src) 2300 -> true 2301 ; assert(mode(chr, Src)) 2302 ). 2303 2304chr_head(X, _, _) :- 2305 var(X), 2306 !. % Illegal. Warn? 2307chr_head(\(A,B), Src, H) :- 2308 chr_head(A, Src, H), 2309 process_body(B, H, Src). 2310chr_head((H0,B), Src, H) :- 2311 chr_defined(H0, Src, H), 2312 process_body(B, H, Src). 2313chr_head(H0, Src, H) :- 2314 chr_defined(H0, Src, H). 2315 2316chr_defined(X, _, _) :- 2317 var(X), 2318 !. 2319chr_defined(#(C,_Id), Src, C) :- 2320 !, 2321 assert_constraint(Src, C). 2322chr_defined(A, Src, A) :- 2323 assert_constraint(Src, A). 2324 2325chr_body(X, From, Src) :- 2326 var(X), 2327 !, 2328 process_body(X, From, Src). 2329chr_body('|'(Guard, Goals), H, Src) :- 2330 !, 2331 chr_body(Guard, H, Src), 2332 chr_body(Goals, H, Src). 2333chr_body(G, From, Src) :- 2334 process_body(G, From, Src). 2335 2336assert_constraint(_, Head) :- 2337 var(Head), 2338 !. 2339assert_constraint(Src, Head) :- 2340 constraint(Head, Src, _), 2341 !. 2342assert_constraint(Src, Head) :- 2343 generalise_term(Head, Term), 2344 current_source_line(Line), 2345 assert(constraint(Term, Src, Line)). 2346 2347 2348 /******************************** 2349 * PHASE 1 ASSERTIONS * 2350 ********************************/
2357assert_called(_, _, Var, _) :- 2358 var(Var), 2359 !. 2360assert_called(Src, From, Goal, Line) :- 2361 var(From), 2362 !, 2363 assert_called(Src, '<unknown>', Goal, Line). 2364assert_called(_, _, Goal, _) :- 2365 expand_hide_called(Goal), 2366 !. 2367assert_called(Src, Origin, M:G, Line) :- 2368 !, 2369 ( atom(M), 2370 callable(G) 2371 -> current_condition(Cond), 2372 ( xmodule(M, Src) % explicit call to own module 2373 -> assert_called(Src, Origin, G, Line) 2374 ; called(M:G, Src, Origin, Cond, Line) % already registered 2375 -> true 2376 ; hide_called(M:G, Src) % not interesting (now) 2377 -> true 2378 ; generalise(Origin, OTerm), 2379 generalise(G, GTerm) 2380 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2381 ; true 2382 ) 2383 ; true % call to variable module 2384 ). 2385assert_called(Src, _, Goal, _) :- 2386 ( xmodule(M, Src) 2387 -> M \== system 2388 ; M = user 2389 ), 2390 hide_called(M:Goal, Src), 2391 !. 2392assert_called(Src, Origin, Goal, Line) :- 2393 current_condition(Cond), 2394 ( called(Goal, Src, Origin, Cond, Line) 2395 -> true 2396 ; generalise(Origin, OTerm), 2397 generalise(Goal, Term) 2398 -> assert(called(Term, Src, OTerm, Cond, Line)) 2399 ; true 2400 ).
2408expand_hide_called(pce_principal:send_implementation(_, _, _)). 2409expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2410expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2411expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2412 2413assert_defined(Src, Goal) :- 2414 defined(Goal, Src, _), 2415 !. 2416assert_defined(Src, Goal) :- 2417 generalise(Goal, Term), 2418 current_source_line(Line), 2419 assert(defined(Term, Src, Line)). 2420 2421assert_foreign(Src, Goal) :- 2422 foreign(Goal, Src, _), 2423 !. 2424assert_foreign(Src, Goal) :- 2425 generalise(Goal, Term), 2426 current_source_line(Line), 2427 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2439assert_import(_, [], _, _, _) :- !. 2440assert_import(Src, [H|T], Export, From, Reexport) :- 2441 !, 2442 assert_import(Src, H, Export, From, Reexport), 2443 assert_import(Src, T, Export, From, Reexport). 2444assert_import(Src, except(Except), Export, From, Reexport) :- 2445 !, 2446 is_list(Export), 2447 !, 2448 except(Except, Export, Import), 2449 assert_import(Src, Import, _All, From, Reexport). 2450assert_import(Src, Import as Name, Export, From, Reexport) :- 2451 !, 2452 pi_to_head(Import, Term0), 2453 rename_goal(Term0, Name, Term), 2454 ( in_export_list(Term0, Export) 2455 -> assert(imported(Term, Src, From)), 2456 assert_reexport(Reexport, Src, Term) 2457 ; current_source_line(Line), 2458 assert_called(Src, '<directive>'(Line), Term0, Line) 2459 ). 2460assert_import(Src, Import, Export, From, Reexport) :- 2461 pi_to_head(Import, Term), 2462 !, 2463 ( in_export_list(Term, Export) 2464 -> assert(imported(Term, Src, From)), 2465 assert_reexport(Reexport, Src, Term) 2466 ; current_source_line(Line), 2467 assert_called(Src, '<directive>'(Line), Term, Line) 2468 ). 2469assert_import(Src, op(P,T,N), _, _, _) :- 2470 xref_push_op(Src, P,T,N). 2471 2472in_export_list(_Head, Export) :- 2473 var(Export), 2474 !. 2475in_export_list(Head, Export) :- 2476 member(PI, Export), 2477 pi_to_head(PI, Head). 2478 2479assert_reexport(false, _, _) :- !. 2480assert_reexport(true, Src, Term) :- 2481 assert(exported(Term, Src)).
2487process_import(M:PI, Src) :- 2488 pi_to_head(PI, Head), 2489 !, 2490 ( atom(M), 2491 current_module(M), 2492 module_property(M, file(From)) 2493 -> true 2494 ; From = '<unknown>' 2495 ), 2496 assert(imported(Head, Src, From)). 2497process_import(_, _).
2506assert_xmodule_callable([], _, _, _). 2507assert_xmodule_callable([PI|T], M, Src, From) :- 2508 ( pi_to_head(M:PI, Head) 2509 -> assert(imported(Head, Src, From)) 2510 ; true 2511 ), 2512 assert_xmodule_callable(T, M, Src, From).
2519assert_op(Src, op(P,T,M:N)) :-
2520 ( '$current_source_module'(M)
2521 -> Name = N
2522 ; Name = M:N
2523 ),
2524 ( xop(Src, op(P,T,Name))
2525 -> true
2526 ; assert(xop(Src, op(P,T,Name)))
2527 ).2534assert_module(Src, Module) :- 2535 xmodule(Module, Src), 2536 !. 2537assert_module(Src, Module) :- 2538 '$set_source_module'(Module), 2539 assert(xmodule(Module, Src)), 2540 ( module_property(Module, class(system)) 2541 -> retractall(xoption(Src, register_called(_))), 2542 assert(xoption(Src, register_called(all))) 2543 ; true 2544 ). 2545 2546assert_module_export(_, []) :- !. 2547assert_module_export(Src, [H|T]) :- 2548 !, 2549 assert_module_export(Src, H), 2550 assert_module_export(Src, T). 2551assert_module_export(Src, PI) :- 2552 pi_to_head(PI, Term), 2553 !, 2554 assert(exported(Term, Src)). 2555assert_module_export(Src, op(P, A, N)) :- 2556 xref_push_op(Src, P, A, N).
2562assert_module3([], _) :- !. 2563assert_module3([H|T], Src) :- 2564 !, 2565 assert_module3(H, Src), 2566 assert_module3(T, Src). 2567assert_module3(Option, Src) :- 2568 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2577process_predicates(Closure, Preds, Src) :- 2578 is_list(Preds), 2579 !, 2580 process_predicate_list(Preds, Closure, Src). 2581process_predicates(Closure, as(Preds, _Options), Src) :- 2582 !, 2583 process_predicates(Closure, Preds, Src). 2584process_predicates(Closure, Preds, Src) :- 2585 process_predicate_comma(Preds, Closure, Src). 2586 2587process_predicate_list([], _, _). 2588process_predicate_list([H|T], Closure, Src) :- 2589 ( nonvar(H) 2590 -> call(Closure, H, Src) 2591 ; true 2592 ), 2593 process_predicate_list(T, Closure, Src). 2594 2595process_predicate_comma(Var, _, _) :- 2596 var(Var), 2597 !. 2598process_predicate_comma(M:(A,B), Closure, Src) :- 2599 !, 2600 process_predicate_comma(M:A, Closure, Src), 2601 process_predicate_comma(M:B, Closure, Src). 2602process_predicate_comma((A,B), Closure, Src) :- 2603 !, 2604 process_predicate_comma(A, Closure, Src), 2605 process_predicate_comma(B, Closure, Src). 2606process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2607 !, 2608 process_predicate_comma(Spec, Closure, Src). 2609process_predicate_comma(A, Closure, Src) :- 2610 call(Closure, A, Src). 2611 2612 2613assert_dynamic(PI, Src) :- 2614 pi_to_head(PI, Term), 2615 ( thread_local(Term, Src, _) % dynamic after thread_local has 2616 -> true % no effect 2617 ; current_source_line(Line), 2618 assert(dynamic(Term, Src, Line)) 2619 ). 2620 2621assert_thread_local(PI, Src) :- 2622 pi_to_head(PI, Term), 2623 current_source_line(Line), 2624 assert(thread_local(Term, Src, Line)). 2625 2626assert_multifile(PI, Src) :- % :- multifile(Spec) 2627 pi_to_head(PI, Term), 2628 current_source_line(Line), 2629 assert(multifile(Term, Src, Line)). 2630 2631assert_public(PI, Src) :- % :- public(Spec) 2632 pi_to_head(PI, Term), 2633 current_source_line(Line), 2634 assert_called(Src, '<public>'(Line), Term, Line), 2635 assert(public(Term, Src, Line)). 2636 2637assert_export(PI, Src) :- % :- export(Spec) 2638 pi_to_head(PI, Term), 2639 !, 2640 assert(exported(Term, Src)).
2647pi_to_head(Var, _) :- 2648 var(Var), !, fail. 2649pi_to_head(M:PI, M:Term) :- 2650 !, 2651 pi_to_head(PI, Term). 2652pi_to_head(Name/Arity, Term) :- 2653 functor(Term, Name, Arity). 2654pi_to_head(Name//DCGArity, Term) :- 2655 Arity is DCGArity+2, 2656 functor(Term, Name, Arity). 2657 2658 2659assert_used_class(Src, Name) :- 2660 used_class(Name, Src), 2661 !. 2662assert_used_class(Src, Name) :- 2663 assert(used_class(Name, Src)). 2664 2665assert_defined_class(Src, Name, _Meta, _Super, _) :- 2666 defined_class(Name, _, _, Src, _), 2667 !. 2668assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2669assert_defined_class(Src, Name, Meta, Super, Summary) :- 2670 current_source_line(Line), 2671 ( Summary == @(default) 2672 -> Atom = '' 2673 ; is_list(Summary) 2674 -> atom_codes(Atom, Summary) 2675 ; string(Summary) 2676 -> atom_concat(Summary, '', Atom) 2677 ), 2678 assert(defined_class(Name, Super, Atom, Src, Line)), 2679 ( Meta = @(_) 2680 -> true 2681 ; assert_used_class(Src, Meta) 2682 ), 2683 assert_used_class(Src, Super). 2684 2685assert_defined_class(Src, Name, imported_from(_File)) :- 2686 defined_class(Name, _, _, Src, _), 2687 !. 2688assert_defined_class(Src, Name, imported_from(File)) :- 2689 assert(defined_class(Name, _, '', Src, file(File))). 2690 2691 2692 /******************************** 2693 * UTILITIES * 2694 ********************************/
2700generalise(Var, Var) :- 2701 var(Var), 2702 !. % error? 2703generalise(pce_principal:send_implementation(Id, _, _), 2704 pce_principal:send_implementation(Id, _, _)) :- 2705 atom(Id), 2706 !. 2707generalise(pce_principal:get_implementation(Id, _, _, _), 2708 pce_principal:get_implementation(Id, _, _, _)) :- 2709 atom(Id), 2710 !. 2711generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2712generalise(Module:Goal0, Module:Goal) :- 2713 atom(Module), 2714 !, 2715 generalise(Goal0, Goal). 2716generalise(Term0, Term) :- 2717 callable(Term0), 2718 generalise_term(Term0, Term). 2719 2720 2721 /******************************* 2722 * SOURCE MANAGEMENT * 2723 *******************************/ 2724 2725/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2726This section of the file contains hookable predicates to reason about 2727sources. The built-in code here can only deal with files. The XPCE 2728library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2729can do cross-referencing on PceEmacs edit buffers. Other examples for 2730hooking can be databases, (HTTP) URIs, etc. 2731- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2732 2733:- multifile 2734 prolog:xref_source_directory/2, % +Source, -Dir 2735 prolog:xref_source_file/3. % +Spec, -Path, +Options
2743xref_source_file(Plain, File, Source) :- 2744 xref_source_file(Plain, File, Source, []). 2745 2746xref_source_file(QSpec, File, Source, Options) :- 2747 nonvar(QSpec), QSpec = _:Spec, 2748 !, 2749 must_be(acyclic, Spec), 2750 xref_source_file(Spec, File, Source, Options). 2751xref_source_file(Spec, File, Source, Options) :- 2752 nonvar(Spec), 2753 prolog:xref_source_file(Spec, File, 2754 [ relative_to(Source) 2755 | Options 2756 ]), 2757 !. 2758xref_source_file(Plain, File, Source, Options) :- 2759 atom(Plain), 2760 \+ is_absolute_file_name(Plain), 2761 ( prolog:xref_source_directory(Source, Dir) 2762 -> true 2763 ; atom(Source), 2764 file_directory_name(Source, Dir) 2765 ), 2766 atomic_list_concat([Dir, /, Plain], Spec0), 2767 absolute_file_name(Spec0, Spec), 2768 do_xref_source_file(Spec, File, Options), 2769 !. 2770xref_source_file(Spec, File, Source, Options) :- 2771 do_xref_source_file(Spec, File, 2772 [ relative_to(Source) 2773 | Options 2774 ]), 2775 !. 2776xref_source_file(_, _, _, Options) :- 2777 option(silent(true), Options), 2778 !, 2779 fail. 2780xref_source_file(Spec, _, Src, _Options) :- 2781 verbose(Src), 2782 print_message(warning, error(existence_error(file, Spec), _)), 2783 fail. 2784 2785do_xref_source_file(Spec, File, Options) :- 2786 nonvar(Spec), 2787 option(file_type(Type), Options, prolog), 2788 absolute_file_name(Spec, File, 2789 [ file_type(Type), 2790 access(read), 2791 file_errors(fail) 2792 ]), 2793 !.
2799canonical_source(Source, Src) :-
2800 ( ground(Source)
2801 -> prolog_canonical_source(Source, Src)
2802 ; Source = Src
2803 ).name()
goals.2810goal_name_arity(Goal, Name, Arity) :- 2811 ( compound(Goal) 2812 -> compound_name_arity(Goal, Name, Arity) 2813 ; atom(Goal) 2814 -> Name = Goal, Arity = 0 2815 ). 2816 2817generalise_term(Specific, General) :- 2818 ( compound(Specific) 2819 -> compound_name_arity(Specific, Name, Arity), 2820 compound_name_arity(General, Name, Arity) 2821 ; General = Specific 2822 ). 2823 2824functor_name(Term, Name) :- 2825 ( compound(Term) 2826 -> compound_name_arity(Term, Name, _) 2827 ; atom(Term) 2828 -> Name = Term 2829 ). 2830 2831rename_goal(Goal0, Name, Goal) :- 2832 ( compound(Goal0) 2833 -> compound_name_arity(Goal0, _, Arity), 2834 compound_name_arity(Goal, Name, Arity) 2835 ; Goal = Name 2836 )
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.